Set consolidation: Difference between revisions

Content added Content deleted

Inline

@@ Line 1,450: / Line 1,450: @@
 <lang txr>@(do
-   (defun mkset (p x) (set [p x] (or [p x] x)))
+   (defun mkset (items) [group-by identity items])
-   (defun fnd (p x) (if (eq [p x] x) x (fnd p [p x])))
+   (defun empty-p (set) (zerop (hash-count set)))
-   (defun uni (p x y)
+   (defun consoli (ss)
-     (let ((xr (fnd p x)) (yr (fnd p y)))
+     (defun comb (cs s)
-       (set [p xr] yr)))
+       (cond ((empty-p s) cs)
+             ((null cs) (list s))
+             ((empty-p (hash-isec s (first cs)))
-   (defun consoli (sets)
-     (let ((p (hash)))
+              (cons (first cs) (comb (rest cs) s)))
-       (each ((s sets))
+             (t (consoli (cons (hash-uni s (first cs)) (rest cs))))))
-         (each ((e s))
+     [reduce-left comb ss nil])
-           (mkset p e)
-           (uni p e (car s))))
-       (hash-values
-         [group-by (op fnd p) (hash-keys
-                                [group-by identity (flatten sets)])])))
    ;; tests
    (each ((test '(((a b) (c d))
                   ((a b) (b d))
                   ((a b) (c d) (d b))
                   ((h i k) (a b) (c d) (d b) (f g h)))))
-     (format t "~s -> ~s\n" test (consoli test))))</lang>
+     (format t "~s -> ~s\n" test
+             [mapcar hash-keys (consoli [mapcar mkset test])])))</lang>
 Output: