!97 take and take-right for case-vector in (liii vector)

Merge pull request !97 from 沈达/da/take
LiiiLabs · Jan 10, 2025 · c21fc09 · c21fc09
1 parent 22c2080
commit c21fc09
Show file tree

Hide file tree

Showing 3 changed files with 152 additions and 2 deletions.
diff --git a/GoldfishScheme.tmu b/GoldfishScheme.tmu
@@ -13627,7 +13627,111 @@
     \;
   </scm-chunk>
 
-  <subparagraph|fold>
+  <paragraph|case-vector%take>
+
+  <\scm-chunk|goldfish/liii/vector.scm|true|true>
+    \ \ (define (%take x . xs)
+
+    \ \ \ \ (typed-define (scala-take (data vector?) (n integer?))
+
+    \ \ \ \ \ \ (cond
+
+    \ \ \ \ \ \ \ \ ((\<less\> n 0) (vector))
+
+    \ \ \ \ \ \ \ \ ((\<gtr\>= n (vector-length data)) data)
+
+    \ \ \ \ \ \ \ \ (else
+
+    \ \ \ \ \ \ \ \ \ \ (let ((new-vec (make-vector n)))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ (do ((i 0 (+ i 1)))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= i n) new-vec)
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! new-vec i (vector-ref data i)))))))
+
+    \;
+
+    \ \ \ \ (let1 r (case-vector (scala-take data x))
+
+    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))
+
+    \;
+  </scm-chunk>
+
+  <\goldfish-chunk|tests/goldfish/liii/vector-test.scm|true|true>
+    (let ((vec (case-vector #(1 2 3 4 5))))
+
+    \ \ (check (vec :take -1 :collect) =\<gtr\> #())
+
+    \ \ (check (vec :take 0 :collect) =\<gtr\> #())
+
+    \ \ (check (vec :take 3 :collect) =\<gtr\> #(1 2 3))
+
+    \ \ (check (vec :take 5 :collect) =\<gtr\> #(1 2 3 4 5))
+
+    \ \ (check (vec :take 10 :collect) =\<gtr\> #(1 2 3 4 5))
+
+    )
+
+    \;
+  </goldfish-chunk>
+
+  <paragraph|case-vector%take-right>
+
+  <\scm-chunk|goldfish/liii/vector.scm|true|true>
+    \ \ (define (%take-right x . xs)
+
+    \ \ \ \ (typed-define (scala-take-right (data vector?) (n integer?))
+
+    \ \ \ \ \ \ (let ((len (vector-length data)))
+
+    \ \ \ \ \ \ \ \ (cond
+
+    \ \ \ \ \ \ \ \ \ \ ((\<less\> n 0) (vector))
+
+    \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= n len) data)
+
+    \ \ \ \ \ \ \ \ \ \ (else
+
+    \ \ \ \ \ \ \ \ \ \ \ \ (let ((new-vec (make-vector n)))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (do ((i (- len n) (+ i 1))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (j 0 (+ j 1)))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((\<gtr\>= j n) new-vec)
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! new-vec j (vector-ref data i))))))))
+
+    \;
+
+    \ \ \ \ (let1 r (case-vector (scala-take-right data x))
+
+    \ \ \ \ \ \ (if (null? xs) r (apply r xs))))
+
+    \;
+  </scm-chunk>
+
+  <\goldfish-chunk|tests/goldfish/liii/vector-test.scm|true|true>
+    (let ((vec (case-vector #(1 2 3 4 5))))
+
+    \ \ (check (vec :take-right -1 :collect) =\<gtr\> #())
+
+    \ \ (check (vec :take-right 0 :collect) =\<gtr\> #())
+
+    \ \ (check (vec :take-right 3 :collect) =\<gtr\> #(3 4 5))
+
+    \ \ (check (vec :take-right 5 :collect) =\<gtr\> #(1 2 3 4 5))
+
+    \ \ (check (vec :take-right 10 :collect) =\<gtr\> #(1 2 3 4 5))
+
+    )
+
+    \;
+  </goldfish-chunk>
+
+  <paragraph|case-vector%fold>
 
   <\scm-chunk|goldfish/liii/vector.scm|true|true>
     \ \ (define (%fold initial f)
@@ -13661,7 +13765,7 @@
     \;
   </goldfish-chunk>
 
-  <subparagraph|make-string>
+  <paragraph|case-vector%make-string>
 
   <\scm-chunk|goldfish/liii/vector.scm|true|true>
     \ \ (define (%make-string . xs)

diff --git a/goldfish/liii/vector.scm b/goldfish/liii/vector.scm
@@ -72,6 +72,36 @@
           ((length=? 1 xs) (vector-count (car xs) data))
           (else (error 'wrong-number-of-args "case-vector%count" xs))))
 
+  (define (%take x . xs)
+    (typed-define (scala-take (data vector?) (n integer?))
+      (cond
+        ((< n 0) (vector))
+        ((>= n (vector-length data)) data)
+        (else
+          (let ((new-vec (make-vector n)))
+            (do ((i 0 (+ i 1)))
+                ((>= i n) new-vec)
+              (vector-set! new-vec i (vector-ref data i)))))))
+
+    (let1 r (case-vector (scala-take data x))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%take-right x . xs)
+    (typed-define (scala-take-right (data vector?) (n integer?))
+      (let ((len (vector-length data)))
+        (cond
+          ((< n 0) (vector))
+          ((>= n len) data)
+          (else
+            (let ((new-vec (make-vector n)))
+              (do ((i (- len n) (+ i 1))
+                   (j 0 (+ j 1)))
+                  ((>= j n) new-vec)
+                (vector-set! new-vec j (vector-ref data i))))))))
+
+    (let1 r (case-vector (scala-take-right data x))
+      (if (null? xs) r (apply r xs))))
+
   (define (%fold initial f)
     (vector-fold f initial data))
 

diff --git a/tests/goldfish/liii/vector-test.scm b/tests/goldfish/liii/vector-test.scm
@@ -312,6 +312,22 @@
 (check (vector-filter (lambda (x) #t) #()) => #())
 (check (vector-filter (lambda (x) #f) #(1 2 3)) => #())
 
+(let ((vec (case-vector #(1 2 3 4 5))))
+  (check (vec :take -1 :collect) => #())
+  (check (vec :take 0 :collect) => #())
+  (check (vec :take 3 :collect) => #(1 2 3))
+  (check (vec :take 5 :collect) => #(1 2 3 4 5))
+  (check (vec :take 10 :collect) => #(1 2 3 4 5))
+)
+
+(let ((vec (case-vector #(1 2 3 4 5))))
+  (check (vec :take-right -1 :collect) => #())
+  (check (vec :take-right 0 :collect) => #())
+  (check (vec :take-right 3 :collect) => #(3 4 5))
+  (check (vec :take-right 5 :collect) => #(1 2 3 4 5))
+  (check (vec :take-right 10 :collect) => #(1 2 3 4 5))
+)
+
 (let ((vec (case-vector #(1 2 3 4 5))))
   (check (vec :fold 0 +) => 15)
   (check (vec :fold '() (lambda (x acc) (cons x acc))) => '(5 4 3 2 1))