std/misc/vector

src/std/build-spec.ss

@@ -323,6 +323,7 @@
     "misc/atom"
     "misc/dag"
     "misc/decimal"
+    "misc/vector"
     "misc/evector"
     "misc/prime"
     "misc/concurrent-plan"

src/std/misc/vector-test.ss

@@ -0,0 +1,41 @@
+(export vector-test)
+
+(import
+  (only-in :std/misc/list-builder with-list-builder)
+  :std/test
+  ./vector)
+
+(def vector-test
+  (test-suite "test suite for std/misc/vector"
+    (test-case "vector"
+      (def foo (vector 1 2 3))
+      (set! (vector-ref foo 1) 4)
+      (check foo => #(1 4 3))
+      (check (vector-least-index (cut < 10) #(35 21 16 11 10 9 7 4 1)) => 5)
+      (check (vector-most-index (cut < 10) #(2 3 5 7 11 13 17 19 23)) => 4)
+      (check (maybe-subvector #(1 3 5 7) 2) => #(5 7))
+      (check (eq? foo (maybe-subvector foo 0 3)) => #t)
+      (check (with-list-builder (c)
+               (subvector-for-each
+                c #(a b c d e f g h) start: 2 end: 5))
+             => '(c d e))
+      (check (with-list-builder (c)
+               (subvector-for-each/index
+                (lambda (x y) (c [x y])) #(a b c d e f g h) start: 5))
+             => '((f 5) (g 6) (h 7)))
+      (check (with-list-builder (c)
+               (subvector-reverse-for-each c #(a b c d e f g h) start: 2 end: 5))
+             => '(e d c))
+      (check (with-list-builder (c)
+               (subvector-reverse-for-each/index
+                (lambda (x y) (c [x y])) #(a b c d e f g h) start: 5))
+             => '((h 7) (g 6) (f 5)))
+      (check (subvector->list #(a b c d e f g h) start: 5)
+             => '(c d e))
+      (check (cons->vector '(a . b))
+             => #(a b))
+      (check (cons->vector 'foo)
+             => #f)
+      (check (vector-filter odd? #(1 2 3 4 5 6 7 8 9) start: 1 end: 7)
+             => #(3 5 7))
+    ))

src/std/misc/vector.ss

@@ -0,0 +1,86 @@
+;; -*- Gerbil -*-
+;;;; Utilities pertaining to using Vectors
+
+(export #t
+        (rename: srfi43-vector-map vector-map/index)
+        (rename: srfi43-vector-for-each vector-for-each/index)
+        (rename: srfi43-vector-map! vector-map!/index)
+        (rename: srfi43-vector-fold vector-fold/index)
+        (rename: srfi43-vector-fold-right vector-fold-right/index)
+        (rename: srfi43-vector-count vector-count/index))
+
+(import
+  (prefix-in (only-in :std/srfi/43
+                      vector-map
+                      vector-for-each
+                      vector-map!
+                      vector-fold
+                      vector-fold-right
+                      vector-count) srfi43-)
+  (only-in :std/iter for in-range in-iota)
+  (only-in :std/misc/list-builder with-list-builder)
+  (only-in :std/misc/number least-integer)
+  (only-in :std/sugar while))
+
+;; Enable (set! (vector-ref v i) x)
+(defalias vector-ref-set! vector-set!)
+
+;;; Assuming a sorted vector, a predicate on vector elements that is "increasing",
+;;; i.e. if true, true on all subsequent elements, and optionally
+;;; a start (inclusive, defaults to 0) and an end (exclusive, defaults to vector length),
+;;; return the least index of a vector element in the interval [start, env)
+;;; that satisfies the predicate, or the end if none does.
+(def (vector-least-index pred? vector start: (start 0) end: (end (vector-length vector)))
+  (least-integer (lambda (i) (pred? (vector-ref vector i))) start end))
+
+;;; Assuming a sorted vector, a predicate on vector elements that is "decreasing",
+;;; i.e. if true, true on all preceding elements, and optionally
+;;; a start (inclusive, defaults to 0) and an end (exclusive, defaults to vector length),
+;;; return the most index such that all previous vector elements in the interval [start, env)
+;;; satisfy the predicate, or the start if none does.
+(def (vector-most-index pred? vector start: (start 0) end: (end (vector-length vector)))
+  (most-integer (lambda (i) (pred? (vector-ref vector i))) start end))
+
+;;; Copy a vector if necessary: return the same if no change in start and end requested.
+(def (maybe-subvector vector (start 0) (end #f))
+  (let* ((len (vector-length vector))
+         (end (or end len)))
+    (if (and (eqv? start 0) (eqv? end len))
+      vector
+      (subvector vector start end))))
+
+(def (subvector-for-each function vector start: (start 0) end: (end #f))
+  (for ((i (in-iota (- (or end (vector-length vector)) start) start)))
+    (function (vector-ref vector i))))
+
+(def (subvector-for-each/index function vector start: (start 0) end: (end #f))
+  (for ((i (in-iota (- (or end (vector-length vector)) start) start)))
+    (function i (vector-ref vector i))))
+
+(def (subvector-reverse-for-each function vector start: (start 0) end: (end #f))
+  (let ((end (or end (vector-length vector))))
+    (for ((i (in-iota (- end start) (- end 1) -1)))
+      (function (vector-ref vector i)))))
+
+(def (subvector-reverse-for-each/index function vector start: (start 0) end: (end #f))
+  (def end (or end (vector-length vector)))
+    (for ((i (in-iota (- end start) (- end 1) -1)))
+      (function i (vector-ref vector i))))
+
+(def (subvector->list vector start: (start 0) end: (end #f))
+  (with-list-builder (c!) (subvector-for-each c! vector start: start end: end)))
+
+(def cons->vector (match <> ([car . cdr] (vector car cdr)) (_ #f)))
+
+;;;; Given a vector, an index and a function, update the element of the vector at given index
+;;;; by invoking the function on its previous value
+;;(def (vector-update! vector index fun)
+;;  (vector-set! vector index (fun (vector-ref vector index))))
+
+;; Filter entries of a vector to those that satisfy the predicate
+(def (vector-filter pred? v start: (start 0) end: (end (vector-length v)))
+  (list->vector
+   (with-list-builder (c)
+     (for (i (in-range start end))
+       (def e (vector-ref v i))
+       (when (pred? e) (c e))))))