split and search

1 files changed, 124 insertions, 106 deletions

diff --git a/tests/run.scm b/tests/run.scm
index 1aea3b0..c2e06ec 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -13,7 +13,14 @@
  | limitations under the License.
  |#
 
+(import r7rs)
+
+(load "random-number-vector.sld")
+(load "util.sld")
+
 (import (mcgoron weight-balanced-trees internal)
+        (mcgoron weight-balanced-trees test util)
+        (mcgoron weight-balanced-trees test random-number-vector)
         (prefix (only (mcgoron srfi 64) factory) mcgoron-test-)
         (except (mcgoron srfi 64) factory)
         (srfi 1) (srfi 26) (srfi 64) (srfi 128) (srfi 132) (srfi 133)
@@ -32,57 +39,13 @@
 (test-runner-factory mcgoron-test-factory)
 (test-runner-current (test-runner-create))
 
-;;; ;;;;;;;;;;;
-;;; Utils
-;;; ;;;;;;;;;;;
-
-(define (vector-copy-exclusive vec start end)
-  ;; Copy `[start,end)` from `vec`.
-  (if (= start end)
-      #()
-      (vector-copy vec start (- end 1))))
-
 ;;; ;;;;;;;;;;;;;;;;;;;
 ;;; Random in-order vector generator
 ;;; ;;;;;;;;;;;;;;;;;;;
 
-(define (random-number-vector of)
-  ;; Generate a random vector of exact integers with at most `of` number
-  ;; of elements.
-  (vector-generator-of (exact-integer-generator) of))
-
-(define (filter-non-empty-vectors gen)
-  ;; Filter out the empty vector.
-  (gremove (lambda (vec) (zero? (vector-length vec))) gen))
-
-(define (remove-duplicates gen)
-  ;; Filter out vectors with duplicate entries.
-  (define (filter vec)
-    (call/cc
-     (lambda (return)
-       (vector-fold (lambda (prev elem)
-                      (cond
-                        ((null? prev) elem)
-                        ((= elem prev) (return #f))
-                        (else elem)))
-                    '()
-                    vec)
-       #t)))
-  (gfilter filter gen))
-
-(define (make-in-order gen)
-  ;; Sort all vectors to be in-order.
-  (gmap (cut vector-sort < <>) gen))
-
-(define (in-order-vector-generator of)
-  (chain (random-number-vector of)
-         (filter-non-empty-vectors _)
-         (make-in-order _)
-         (remove-duplicates _)))
-
-(define (vector->node-generator of)
-  (chain (in-order-vector-generator of)
-         (gmap in-order-vector->node _)))
+(define (vector->node-generator)
+  (gmap in-order-vector->node (in-order-vector-generator
+                               (max-vector-length))))
 
 (define number-comparator
   (make-comparator
@@ -108,8 +71,7 @@
 
 (test-group "vector->node balanced?"
   (test-assert (balanced? '()))
-  (test-property balanced? (list (vector->node-generator
-                                  (max-vector-length)))))
+  (test-property balanced? (list (vector->node-generator))))
 
 ;;; ;;;;;;;;;
 ;;; Make a "split" vector. A "split" vector is two sorted vectors and a 
@@ -129,82 +91,138 @@
             (vector-ref vec pivot)
             (vector-copy-exclusive vec (+ pivot 1) len))))
 
-(define (split-vector-generator of)
-  (chain (random-number-vector of)
-         (filter-non-empty-vectors _)
-         (remove-duplicates _)
-         (make-in-order _)
+(define (split-vector-generator)
+  (chain (in-order-vector-generator (max-vector-length))
          (gmap split-in-order-vector _)))
 
+(define (call/split-vecs procedure)
+  (lambda (vec)
+    (let ((left (vector-ref vec 0))
+          (middle (vector-ref vec 1))
+          (right (vector-ref vec 2)))
+      (procedure left middle right))))
+
+(define (join-vectors left middle right)
+  (join middle (in-order-vector->node left) (in-order-vector->node right)))
+
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; join
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (join-preserves-order-of vec)
-  ;; Test if joining two in-order vectors with a node in between will
-  ;; preserve order in the tree.
-  (let ((left (vector-ref vec 0))
-        (middle (vector-ref vec 1))
-        (right (vector-ref vec 2)))
-    ;; Log the left, middle, and right vectors.
-    (when (verbose)
-      (dynamic-property-set! 'right right)
-      (dynamic-property-set! 'middle middle)
-      (dynamic-property-set! 'left left))
-    (let ((ret (node->in-order-list
-                (join middle
-                      (in-order-vector->node left)
-                      (in-order-vector->node right))))
-          (orig (append (vector->list left)
-                        (list middle)
-                        (vector->list right))))
-      (when (verbose)
-        (dynamic-property-set! 'ret ret))
-      (equal? ret orig))))
-
-(test-group "join-preserves-order-of"
+(define join-preserves-order-of
+  (call/split-vecs
+   (lambda (left middle right)
+     ;; Test if joining two in-order vectors with a node in between will
+     ;; preserve order in the tree.
+     ;; Log the left, middle, and right vectors.
+     (when (verbose)
+       (dynamic-property-set! 'right right)
+       (dynamic-property-set! 'middle middle)
+       (dynamic-property-set! 'left left))
+     (let ((ret (node->in-order-list
+                 (join-vectors left middle right)))
+           (orig (append (vector->list left)
+                         (list middle)
+                         (vector->list right))))
+       (when (verbose)
+         (dynamic-property-set! 'ret ret))
+       (equal? ret orig)))))
+
+(test-group "join of in-order vectors preserves order"
   (parameterize ((verbose #f))
-    (test-property join-preserves-order-of (list (split-vector-generator
-                                                  (max-vector-length))))))
+    (test-property join-preserves-order-of
+                   (list (split-vector-generator)))))
 
-(test-group "join balanced?"
-  (define (join-split-vectors vec)
-    (let ((left (vector-ref vec 0))
-          (middle (vector-ref vec 1))
-          (right (vector-ref vec 2)))
-      (join middle
-            (in-order-vector->node left)
-            (in-order-vector->node right))))
-  (define (joined-vector-generator of)
-    (gmap join-split-vectors (split-vector-generator of)))
-  (test-property balanced? (list (joined-vector-generator (max-vector-length)))))
+(test-group "join of in-order vectors is balanced"
+  (define (joined-vector-generator)
+    (gmap (call/split-vecs join-vectors)
+          (split-vector-generator)))
+  (test-property balanced? (list (joined-vector-generator))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; join2
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (join2-preserves-order-of vec)
-  (let* ((left (vector-ref vec 0))
-         (right (vector-ref vec 2))
-         (ret (node->in-order-list
-               (join2 (in-order-vector->node left)
-                      (in-order-vector->node right))))
-         (orig (append (vector->list left)
-                       (vector->list right))))
-    (equal? ret orig)))
-
-(test-group "join2 preserves order"
+(define join2-preserves-order-of
+  (call/split-vecs
+   (lambda (left _ right)
+     (let ((ret (node->in-order-list
+                 (join2 (in-order-vector->node left)
+                        (in-order-vector->node right))))
+           (orig (append (vector->list left)
+                         (vector->list right))))
+       (equal? ret orig)))))
+
+(test-group "join2 of in-order vectors preserves order"
   (test-property join2-preserves-order-of
-                 (list (split-vector-generator
-                        (max-vector-length)))))
+                 (list (split-vector-generator))))
 
-(test-group "join2 is balanced"
+(test-group "join2 of in-order vectors is balanced"
   (define (join2-split-vector-generator)
     (define (join2-of-split vec)
       (join2 (in-order-vector->node (vector-ref vec 0))
              (in-order-vector->node (vector-ref vec 2))))
-    (gmap join2-of-split (split-vector-generator
-                          (max-vector-length))))
+    (gmap join2-of-split (split-vector-generator)))
   (test-property balanced?
                  (list (join2-split-vector-generator))))
 
+;;; ;;;;;;
+;;; search
+;;; ;;;;;;
+
+(define (call/inserted procedure)
+  (call/split-vecs
+   (lambda (left middle right)
+     (let ((node (join-vectors left middle right)))
+       (procedure left middle right node)))))
+
+(define (call-w/o-inserted procedure)
+  (call/split-vecs
+   (lambda (left middle right)
+     (let ((node (join2 (in-order-vector->node left)
+                        (in-order-vector->node right))))
+       (procedure left middle right node)))))
+
+(test-group "search with inserted node"
+  (define search-finds
+    (call/inserted
+     (lambda (left middle right node)
+       (when (verbose)
+         (dynamic-property-set! 'expected middle)
+         (dynamic-property-set! 'right right)
+         (dynamic-property-set! 'left left)
+         (dynamic-property-set! 'node (node->in-order-list node)))
+       (search node number-comparator middle))))
+  (parameterize ((verbose #f))
+    (test-property search-finds (list (split-vector-generator)))))
+
+(test-group "search without inserted node"
+  (define search-does-not-find
+    (call-w/o-inserted
+     (lambda (left middle right node)
+       (not (search node number-comparator middle)))))
+  (test-property search-does-not-find (list (split-vector-generator))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+;;; split
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define split-finds
+  (call/inserted
+   (lambda (left middle right node)
+     (let-values (((new-left found? new-right)
+                   (split number-comparator node middle)))
+       found?))))
+
+(test-group "split finds"
+  (test-property split-finds (list (split-vector-generator))))
+
+(define split-does-not-find
+  (call-w/o-inserted
+   (lambda (left middle right node)
+     (let-values (((new-left found? new-right)
+                   (split number-comparator node middle)))
+       (not found?)))))
+
+(test-group "split does not find"
+  (test-property split-does-not-find (list (split-vector-generator))))