xor

1 files changed, 88 insertions, 45 deletions

diff --git a/tests/run.scm b/tests/run.scm
index 365fa29..03248f5 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -68,7 +68,7 @@
 ;;; Test node creation
 ;;; ;;;;;;;;;;;;;;;;;;;;;;
 
-(test-group "vector->node is correct"
+(test-group "in-order-vector->node and node->in-order-list round-trip"
   (define (vector->node->list? vec)
     (let* ((node (in-order-vector->node vec))
            (lst (node->in-order-list node)))
@@ -79,7 +79,7 @@
   (test-property vector->node->list?
                  (list (in-order-vector-generator (max-vector-length)))))
 
-(test-group "vector->node balanced?"
+(test-group "in-order-vector->node is balanced?"
   (test-assert (balanced? '()))
   (test-property balanced? (list (vector->node-generator))))
 
@@ -225,65 +225,59 @@
                                 (lambda () #f)))
        procedure))))
 
-(define split-finds
-  (call/split
-   call/inserted
-   (lambda (new-left found? new-right)
-     found?)))
-
 (test-group "split finds"
+  (define split-finds
+    (call/split
+     call/inserted
+     (lambda (new-left found? new-right)
+       found?)))
   (test-property split-finds (list (split-vector-generator))))
 
-(define split-left-balanced
-  (call/split
-   call/inserted
-   (lambda (new-found found? new-right)
-     (balanced? new-found))))
-
-(test-group "split left balanced"
+(test-group "left tree from split with found element is balanced"
+  (define split-left-balanced
+    (call/split
+     call/inserted
+     (lambda (new-found found? new-right)
+       (balanced? new-found))))
   (test-property split-left-balanced (list (split-vector-generator))))
 
-(define split-right-balanced
-  (call/split
-   call/inserted
-   (lambda (new-found found? new-right)
-     (balanced? new-right))))
-
-(test-group "split right balanced"
+(test-group "right tree from split with found element is balanced"
+  (define split-right-balanced
+    (call/split
+     call/inserted
+     (lambda (new-found found? new-right)
+       (balanced? new-right))))
   (test-property split-right-balanced (list (split-vector-generator))))
 
-(define split-does-not-find
-  (call/split
-   call-w/o-inserted
-   (lambda (new-left found? new-right)
-     (not found?))))
-
-(test-group "split does not find"
+(test-group "split should not find element not in left or right"
+  (define split-does-not-find
+    (call/split
+     call-w/o-inserted
+     (lambda (new-left found? new-right)
+       (not found?))))
   (test-property split-does-not-find (list (split-vector-generator))))
 
-(define split-left-balanced-w/o-inserted
-  (call/split
-   call-w/o-inserted
-   (lambda (new-left found? new-right)
-     (balanced? new-left))))
-
-(test-group "split left balanced without insertion"
+(test-group "left tree from split without found element is balanced"
+  (define split-left-balanced-w/o-inserted
+    (call/split
+     call-w/o-inserted
+     (lambda (new-left found? new-right)
+       (balanced? new-left))))
   (test-property split-left-balanced-w/o-inserted (list (split-vector-generator))))
 
-(define split-right-balanced-w/o-inserted
-  (call/split
-   call-w/o-inserted
-   (lambda (new-left found? new-right)
-     (balanced? new-right))))
-
-(test-group "split right balanced without insertion"
+(test-group "right tree from split without found element is balanced"
+  (define split-right-balanced-w/o-inserted
+    (call/split
+     call-w/o-inserted
+     (lambda (new-left found? new-right)
+       (balanced? new-right))))
   (test-property split-right-balanced-w/o-inserted (list (split-vector-generator))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Union
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(test-group "union balanced"
+(test-group "union is balanced"
   (define (union-balanced node1 node2)
     (balanced? (union number-comparator node1 node2)))
   (test-property union-balanced
@@ -395,6 +389,13 @@
 ;;; Difference
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(test-group "difference balanced?"
+  (define (difference-balanced? node1 node2)
+    (balanced? (difference number-comparator node1 node2)))
+  (test-property difference-balanced?
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
 (test-group "difference subset of lset"
   (define (difference-subset-of-lset node1 node2)
     (let ((node (difference number-comparator node1 node2))
@@ -433,7 +434,6 @@
   (define (insert-unordered lst)
     (let ((set (fold insert '() lst)))
       (balanced? set)))
-
   (test-property insert-unordered
                  (list (list-generator-of
                         (exact-integer-generator)))))
@@ -476,6 +476,18 @@
                           lst2)))
       (procedure lst1 lst2 diff deleted))))
 
+(test-group "delete of elements unordered list is balanced"
+  (define (delete-balanced? lst1 lst2)
+    (let* ((set (fold insert '() lst1))
+           (deleted (fold (lambda (elem set)
+                            (delete number-comparator elem set))
+                          set
+                          lst2)))
+      (balanced? deleted)))
+  (test-property delete-balanced?
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))
+
 (test-group "delete of two sets is subset of difference"
   (define (delete-and-difference lst1 lst2 diff deleted)
     (node-every (cut search number-comparator <> diff) deleted))
@@ -491,3 +503,34 @@
                  (list (list-generator-of (exact-integer-generator))
                        (list-generator-of (exact-integer-generator)))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;;;
+;;; xor
+;;; ;;;;;;;;;;;;;;;;;;;;;;;
+
+(test-group "xor balanced?"
+  (define (xor-balanced? node1 node2)
+    (balanced? (xor number-comparator node1 node2)))
+  (test-property xor-balanced?
+                 (list (vector->node-generator) (vector->node-generator))))
+
+(test-group "lset subset of xor"
+  (define (lset-subset-of-xor lst1 lst2)
+    (let* ((node1 (fold insert '() lst1))
+           (node2 (fold insert '() lst2))
+           (set-xor (xor number-comparator node1 node2))
+           (list-xor (lset-xor = lst1 lst2)))
+      (every (cut search number-comparator <> set-xor) list-xor)))
+  (test-property lset-subset-of-xor
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))
+
+(test-group "xor subset of lset"
+  (define (xor-subset-of-lset lst1 lst2)
+    (let* ((node1 (fold insert '() lst1))
+           (node2 (fold insert '() lst2))
+           (set-xor (xor number-comparator node1 node2))
+           (list-xor (lset-xor = lst1 lst2)))
+      (node-every (cut member <> list-xor) set-xor)))
+  (test-property xor-subset-of-lset
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))