|
Original solution:
<lang txrlisp>(defun mkset (p x) (set [p x] (or [p x] x))) ▼
<lang txr>@(do
▲ (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))))</lang>
{{out}}
<pre>((a b) (c d)) -> ((db ca) (bd ac))
((a b) (b d)) -> ((d b a d))
((a b) (c d) (d b)) -> ((d c b a d c))
((h i k) (a b) (c d) (d b) (f g h)) -> ((d c b a) (g f k i h) (b a d c)</pre>
{{trans|Racket}}
<lang txrlisp>(defun mkset (items) [group-by identity items]) ▼
<lang txr>@(do
▲ (defun mkset (items) [group-by identity items])
(defun empty-p (set) (zerop (hash-count set)))
(defun consoli (ss)
(defun combcombi (cs s)
(cond ((empty-p s) cs)
((null cs) (list s))
((empty-p (hash-isec s (first cs)))
(cons (first cs) (combcombi (rest cs) s)))
(t (consoli (cons (hash-uni s (first cs)) (rest cs))))))
[reduce-left combcombi 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])])))</lang>
{{out}}
<pre>((a b) (c d)) -> ((b a) (d c))
((a b) (b d)) -> ((d b a d))
((a b) (c d) (d b)) -> ((b a d c b a))
((h i k) (a b) (c d) (d b) (f g h)) -> ((g f k i h) (b a d c b a))</pre>
=={{header|VBScript}}==
| 