create disjoint set generator of exact number of sets

2 files changed, 34 insertions, 31 deletions

diff --git a/mcgoron/weight-balanced-trees/srfi/113/252.scm b/mcgoron/weight-balanced-trees/srfi/113/252.scm
index db8f267..d1d0a2b 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/252.scm
+++ b/mcgoron/weight-balanced-trees/srfi/113/252.scm
@@ -13,18 +13,6 @@
  | 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))
 
@@ -47,26 +35,31 @@
 (define default-max-number-of-sets
   (make-parameter 100))
 
+(define (intersecting-sets-of-exactly set-generator num)
+  (define (find-arbitrary-element set)
+    (set-find (lambda (x) #t)
+              set
+              (lambda ()
+                (error "empty set passed" set))))
+  (let* ((sets (generator->list
+                (gtake (gremove set-empty? set-generator) num)))
+         (i-set (list->set (set-element-comparator (car sets))
+                           (map find-arbitrary-element sets))))
+    (map (cut set-union i-set <>) sets)))
+
+(define (intersecting-set-generator-of-exactly set-generator num)
+  (cut intersecting-sets-of-exactly set-generator num))
+
 (define intersecting-set-generator-of
   (case-lambda
     ((set-generator)
      (intersecting-set-generator-of set-generator
                                     (default-max-number-of-sets)))
     ((set-generator max-num-of-sets)
-     (define (find-arbitrary-element set)
-       (set-find (lambda (x) #t)
-                 set
-                 (lambda ()
-                   (error "empty set passed" set))))
-     (define (do-intersection sets)
-       (let ((i-set (list->set (set-element-comparator
-                                (car sets))
-                               (map find-arbitrary-element sets))))
-         (map (cut set-union i-set <>) sets)))
-     (gmap do-intersection
-           (gremove null?
-                    (list-generator-of (gremove set-empty? set-generator)
-                                       max-num-of-sets))))))
+     (let ((list-size-generator (make-random-integer-generator 1 max-num-of-sets)))
+       (lambda ()
+         (intersecting-sets-of-exactly set-generator
+                                      (list-size-generator)))))))
 
 (define (make-set-disjoint-from-all set other-sets)
   ;; Make `set` disjoint from all sets in `other-sets`, except for a set
@@ -78,15 +71,23 @@
         set
         other-sets))
 
+(define (disjoint-sets-of-exactly set-generator num)
+  (let ((sets (generator->list
+               (gtake set-generator num))))
+    (map (cut make-set-disjoint-from-all <> sets) sets)))
+
+(define (disjoint-set-generator-of-exactly set-generator num)
+  (cut disjoint-sets-of-exactly set-generator num))
+
 (define disjoint-set-generator-of
   (case-lambda
     ((set-generator)
      (disjoint-set-generator-of set-generator
                                 (default-max-number-of-sets)))
     ((set-generator max-num-of-sets)
-     (gmap (lambda (sets)
-             (map (cut make-set-disjoint-from-all <> sets) sets))
-           (gremove null?
-                    (list-generator-of set-generator
-                                       max-num-of-sets))))))
+     (let ((list-size-generator
+            (make-random-integer-generator 1 max-num-of-sets)))
+       (lambda ()
+         (disjoint-sets-of-exactly set-generator
+                                  (list-size-generator)))))))
 
diff --git a/mcgoron/weight-balanced-trees/srfi/113/252.sld b/mcgoron/weight-balanced-trees/srfi/113/252.sld
index 7e34a84..94f5376 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/252.sld
+++ b/mcgoron/weight-balanced-trees/srfi/113/252.sld
@@ -19,6 +19,8 @@
           (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-exactly
           intersecting-set-generator-of
+          disjoint-set-generator-of-exactly
           disjoint-set-generator-of)
   (include "252.scm"))