more tests for set-delete, more efficient implementation

2 files changed, 54 insertions, 16 deletions

diff --git a/mcgoron/weight-balanced-trees/srfi/113/sets.scm b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
index 03f5045..964ff87 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/sets.scm
+++ b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
@@ -104,13 +104,15 @@
 (define set-replace! set-replace)
 
 (define (set-delete-all set elements)
-  (let ((cmp (set-element-comparator set)))
-    (raw-set
-     cmp
-     (fold (lambda (element node)
-             (delete cmp node element))
-           (get-node set)
-           elements))))
+  (define cmp (set-element-comparator set))
+  (define (delete node)
+    (if (null? node)
+        '()
+        (with-node (node data ("<" left) (">" right))
+          (if (member data elements (cute =? cmp <> <>))
+              (join2 (delete left) (delete right))
+              (join data (delete left) (delete right))))))
+  (raw-set cmp (delete (get-node set))))
 (define set-delete-all! set-delete-all)
 
 (define (set-delete set . elements)
@@ -357,19 +359,21 @@
 ;;; ;;;;;;;;;;;;
 
 (define (set-adjoin-all set elements)
+  ;; TODO: replace with version that only crawls the tree once.
   (let ((cmp (set-element-comparator set)))
     (raw-set
      cmp
      (fold (lambda (new set)
-        (update cmp
-                set
-                new
-                (lambda (old) old)
-                (lambda () (wb-tree-node new '() '()))))
+             (update cmp
+                     set
+                     new
+                     (lambda (old) old)
+                     (lambda () (wb-tree-node new '() '()))))
            (get-node set)
            elements))))
 
 (define (set-replace-all set elements)
+  ;; TODO: replace with version that only crawls the tree once.
   (let ((cmp (set-element-comparator set)))
     (fold (lambda (new set)
             (update cmp
diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 6db4b24..90c3212 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -19,10 +19,10 @@
 (define test-set-adjoin #f)
 (define test-set-find #f)
 (define test-set-disjoint #f)
-(define test-set-every #t)
+(define test-set-every #f)
 (define test-set-delete #t)
-(define test-set= #t)
-(define test-set-intersection #t)
+(define test-set= #f)
+(define test-set-intersection #f)
 
 (define cmp (make-default-comparator))
 
@@ -119,8 +119,17 @@
         (split-unique-vectors)))
 
 (define (find-some-element s1)
+  ;; Get some arbitrary element from the set.
+  ;; 
+  ;; Note that despite being arbitrary, this procedure is deterministic:
+  ;; when applied to the same set it will return the same results.
   (set-find (lambda (x) #t) s1 (lambda () (error "s1 is empty" s1))))
 
+(define (delete-some-element s1)
+  ;; Delete an arbitrary element from the set.
+  (let ((element (find-some-element s1)))
+    (values (set-delete s1 element) element)))
+
 (define (split-non-disjoint-sets)
   (gmap (call/split
          (lambda (s1 s2)
@@ -374,7 +383,32 @@
              (set-every? (cut set-contains? set <>) set*))))
     (test-property delete-some-element
                    (list (filter-non-empty-sets
-                          (random-sets))))))
+                          (random-sets)))))
+  (test-group "separate deletes are idempotent"
+    (define (delete-idempotent set)
+      (let-values (((new-set el) (delete-some-element set)))
+        (set=? (set-delete new-set el) new-set)))
+    (test-property delete-idempotent
+                   (list (filter-non-empty-sets
+                          (random-sets)))))
+  (test-group "deletes in the same line are idempotent"
+    (define (delete-same-idem set)
+      (let ((el (find-some-element set)))
+        (set=? (set-delete set el)
+               (set-delete set el el el el el el))))
+    (test-property delete-same-idem
+                   (list (filter-non-empty-sets
+                          (random-sets)))))
+  (test-group "delete of multiple elements from set"
+    (define (delete-multiple set)
+      (let*-values (((set1 el1) (delete-some-element set))
+                    ((set2 el2) (delete-some-element set1))
+                    ((set3 el3) (delete-some-element set2)))
+        (set=? set3 (set-delete set el1 el2 el3))))
+    (test-property delete-multiple
+                   (list (gfilter (lambda (set)
+                                    (> (set-size set) 3))
+                                  (random-sets))))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; set=?