Set consolidation: Difference between revisions

Content added Content deleted
(Undo revision 176076 by Kazinator (talk): Wrong solution.)
(→‎{{header|TXR}}: Translation of Racket added.)
Line 1,410: Line 1,410:


=={{header|TXR}}==
=={{header|TXR}}==

Original solution:


<lang txr>@(do
<lang txr>@(do
Line 1,444: Line 1,446:
((a b) (c d) (d b)) -> ((d c b a))
((a b) (c d) (d b)) -> ((d c b a))
((h i k) (a b) (c d) (d b) (f g h)) -> ((d c b a) (g f k i h))</pre>
((h i k) (a b) (c d) (d b) (f g h)) -> ((d c b a) (g f k i h))</pre>

{{trans|Racket}}

<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>

Output:

<pre>((a b) (c d)) -> ((b a) (d c))
((a b) (b d)) -> ((b a d))
((a b) (c d) (d b)) -> ((b a d c))
((h i k) (a b) (c d) (d b) (f g h)) -> ((g f k i h) (b a d c))</pre>