Data commit

Task/Set-consolidation/TXR/set-consolidation-1.txr

@@ -0,0 +1,25 @@
+(defun mkset (p x) (set [p x] (or [p x] x)))
+
+(defun fnd (p x) (if (eq [p x] x) x (fnd p [p x])))
+
+(defun uni (p x y)
+  (let ((xr (fnd p x)) (yr (fnd p y)))
+    (set [p xr] yr)))
+
+(defun consoli (sets)
+  (let ((p (hash)))
+    (each ((s sets))
+      (each ((e s))
+        (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)))

Task/Set-consolidation/TXR/set-consolidation-2.txr

@@ -0,0 +1,20 @@
+(defun mkset (items) [group-by identity items])
+
+(defun empty-p (set) (zerop (hash-count set)))
+
+(defun consoli (ss)
+  (defun combi (cs s)
+    (cond ((empty-p s) cs)
+          ((null cs) (list s))
+          ((empty-p (hash-isec s (first cs)))
+           (cons (first cs) (combi (rest cs) s)))
+          (t (consoli (cons (hash-uni s (first cs)) (rest cs))))))
+  [reduce-left combi ss nil])
+
+;; 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
+          [mapcar hash-keys (consoli [mapcar mkset test])]))