test bulk set generators

2 files changed, 28 insertions, 4 deletions

diff --git a/mcgoron/weight-balanced-trees/srfi/113/252.scm b/mcgoron/weight-balanced-trees/srfi/113/252.scm
index 2a9eeab..db8f267 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/252.scm
+++ b/mcgoron/weight-balanced-trees/srfi/113/252.scm
@@ -13,6 +13,18 @@
  | limitations under the License.
  |#
 
+(define (unique-vector-of cmp element-generator max-vector-length)
+  (define vector-length-generator
+    (make-random-integer-generator 0 max-vector-length))
+  (lambda ()
+    (generator->vector
+     (gstate-filter (lambda (element set)
+                      (if (set-contains? set element)
+                          (values #f set)
+                          (values #t (set-adjoin set element))))
+                    element-generator)
+     (vector-length-generator))))
+
 (define default-max-set-size
   (make-parameter 100))
 
@@ -26,6 +38,9 @@
                        element-generator
                        (default-max-set-size)))
     ((comparator element-generator max-set-size)
+     (define set-size-generator
+       (make-random-integer-generator 0 max-set-size))
+     (define the-set (set comparator))
      (gmap (cut list->set comparator <>)
            (list-generator-of element-generator max-set-size)))))
 
@@ -50,9 +65,19 @@
          (map (cut set-union i-set <>) sets)))
      (gmap do-intersection
            (gremove null?
-                    (list-generator-of set-generator
+                    (list-generator-of (gremove set-empty? set-generator)
                                        max-num-of-sets))))))
 
+(define (make-set-disjoint-from-all set other-sets)
+  ;; Make `set` disjoint from all sets in `other-sets`, except for a set
+  ;; that is exactly itself (i.e. `eq?`).
+  (fold (lambda (other-set set)
+          (if (eq? other-set set)
+              set
+              (set-difference set other-set)))
+        set
+        other-sets))
+
 (define disjoint-set-generator-of
   (case-lambda
     ((set-generator)
@@ -60,8 +85,7 @@
                                 (default-max-number-of-sets)))
     ((set-generator max-num-of-sets)
      (gmap (lambda (sets)
-             (let ((i (apply set-intersection sets)))
-               (map (cut set-difference <> i) sets)))
+             (map (cut make-set-disjoint-from-all <> sets) sets))
            (gremove null?
                     (list-generator-of set-generator
                                        max-num-of-sets))))))
diff --git a/mcgoron/weight-balanced-trees/srfi/113/252.sld b/mcgoron/weight-balanced-trees/srfi/113/252.sld
index 07a60f0..7e34a84 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/252.sld
+++ b/mcgoron/weight-balanced-trees/srfi/113/252.sld
@@ -16,7 +16,7 @@
 (define-library (mcgoron weight-balanced-trees srfi 113 252)
   (import (scheme base) (scheme case-lambda)
           (mcgoron weight-balanced-trees srfi 113 sets)
-          (srfi 26) (srfi 128) (srfi 158) (srfi 252))
+          (srfi 1) (srfi 26) (srfi 128) (srfi 158) (srfi 194) (srfi 252))
   (export default-max-set-size set-generator-of
           default-max-number-of-sets
           intersecting-set-generator-of