create disjoint set generator of exact number of sets

1 files changed, 70 insertions, 36 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 251107f..5a9da18 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -15,14 +15,14 @@
 
 (define test-constructor #f)
 (define test-set-generator-of #f)
-(define test-intersecting-set-generator-of #t)
-(define test-disjoint-set-generator-of #t)
-(define test-set-contains #f)
+(define test-intersecting-set-generator-of #f)
+(define test-disjoint-set-generator-of #f)
+(define test-set-every #t)
+(define test-set-contains #t)
 (define test-set-member #f)
 (define test-set-adjoin #f)
 (define test-set-find #f)
 (define test-set-disjoint #f)
-(define test-set-every #f)
 (define test-set-delete #f)
 (define test-set= #f)
 (define test-set<= #f)
@@ -203,7 +203,41 @@
                                              (orderable-generator)
                                              10))))))
 
+(define (set-generator)
+  ;; Generate a set with the global comparator.
+  (set-generator-of cmp (orderable-generator)))
+
+(define (mutually-non-disjoint sets)
+  (every (lambda (set1)
+           (every (lambda (set2)
+                    (not (set-disjoint? set1 set2)))
+                  sets))
+         sets))
+
+(define (mutually-disjoint sets)
+  (every (lambda (set1)
+           (every (lambda (set2)
+                    (if (eq? set1 set2)
+                        #t
+                        (set-disjoint? set1 set2)))
+                  sets))
+         sets))
+
 (when test-intersecting-set-generator-of
+  (test-group "intersecting-set-generator-of-exactly"
+    (test-group "generates a list of sets of a certain length"
+      (define (test list-of-sets)
+        (and (= (length list-of-sets) 2)
+             (every set? list-of-sets)))
+      (test-property test
+                     (list (intersecting-set-generator-of-exactly
+                            (set-generator)
+                            2))))
+    (test-group "generates non-disjoint sets"
+      (test-property mutually-non-disjoint
+                     (list (intersecting-set-generator-of-exactly
+                            (set-generator)
+                            2)))))
   (test-group "intersecting-set-generator-of"
     (test-group "generates lists of sets"
       (define (test list-of-sets)
@@ -211,47 +245,43 @@
              (every set? list-of-sets)))
       (test-property test
                      (list (intersecting-set-generator-of
-                            (set-generator-of (orderable-generator))
+                            (set-generator)
                             10))))
     (test-group "generates non-disjoint sets"
-      (define (mutually-non-disjoint sets)
-        (every (lambda (set1)
-                 (every (lambda (set2)
-                          (not (set-disjoint? set1 set2)))
-                        sets))
-               sets))
       (test-property mutually-non-disjoint
                      (list (intersecting-set-generator-of
-                            (set-generator-of (orderable-generator))
+                            (set-generator)
                             10))))))
 
 (when test-disjoint-set-generator-of
+  (test-group "disjoint-set-generator-of-exactly"
+    (test-group "generates a list of sets of a certain length"
+      (define (test list-of-sets)
+        (and (= (length list-of-sets) 2)
+             (every set? list-of-sets)))
+      (test-property test
+                     (list (disjoint-set-generator-of-exactly
+                            (set-generator)
+                            2))))
+    (test-group "generates -disjoint sets"
+      (test-property mutually-disjoint
+                     (list (disjoint-set-generator-of-exactly
+                            (set-generator)
+                            2)))))
   (test-group "disjoint-set-generator-of generates lists of sets"
     (define (test list-of-sets)
       (and (<= (length list-of-sets) 10)
            (every set? list-of-sets)))
     (test-property test
                    (list (disjoint-set-generator-of
-                          (set-generator-of (orderable-generator))
+                          (set-generator)
                           10))))
   (test-group "disjoint-set-generator-of generates mutually disjoint sets"
-    (define (mutually-disjoint sets)
-      (every (lambda (set1)
-               (every (lambda (set2)
-                        (if (eq? set1 set2)
-                            #t
-                            (set-disjoint? set1 set2)))
-                      sets))
-             sets))
     (test-property mutually-disjoint
                    (list (disjoint-set-generator-of
-                          (set-generator-of (orderable-generator))
+                          (set-generator)
                           10)))))
 
-(define (set-generator)
-  ;; Generate a set with the global comparator.
-  (set-generator-of cmp (orderable-generator)))
-
 ;;; ;;;;;;;;;;;;;;;;;;;;;
 ;;; set-every
 ;;; ;;;;;;;;;;;;;;;;;;;;;
@@ -277,30 +307,34 @@
                                        (exact-integer-generator))
                                       20)))))
 
-#|
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-contains
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (when test-set-contains
   (test-group "set-contains every element from list->set"
-    (define (set-contains-from vec)
-      (let ((set (vector->set vec)))
-        (vector-every (cut set-contains? set <>) vec)))
-    (test-property set-contains-from (list (unique-vector))))
+    (define (set-contains-from lst)
+      (let ((set (list->set cmp lst)))
+        (every (cut set-contains? set <>) lst)))
+    (test-property set-contains-from (list (list-generator-of
+                                            (orderable-generator)))))
   (test-group "set-contains every element from set-every?"
     (define (set-contains-every set)
       (set-every? (cut set-contains? set <>) set))
     (test-property set-contains-every (list (set-generator))))
   (test-group "set-contains? is false for elements in disjoint set"
-    (define (set-does-not-contain vecs)
+    (define (set-does-not-contain sets)
       (define (set-does-not-contain? set value)
         (not (set-contains? set value)))
-      (let ((set (list->set cmp (vector->list (list-ref vecs 0))))
-            (not-in (list-ref vecs 1)))
-        (vector-every (cut set-does-not-contain? set <>) not-in)))
-    (test-property set-does-not-contain (list (split-unique-vectors)))))
+      (set-every? (cute set-does-not-contain?
+                        (list-ref sets 1)
+                        <>)
+                  (list-ref sets 0)))
+    (test-property set-does-not-contain (list (disjoint-set-generator-of-exactly
+                                               (set-generator)
+                                               2)))))
 
+#|
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-member
 ;;;