Set consolidation: Difference between revisions
Content added Content deleted
(→{{header|TXR}}: Slicker mkset function.) |
(→{{header|TXR}}: Add translation of Racket solution.) |
||
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 (items) [group-by identity items]) |
|||
(defun empty-p (set) (zerop (hash-count set))) |
|||
(defun consoli (ss) |
|||
(defun comb (cs s) |
|||
(cond ((empty-p s) cs) |
|||
((null cs) (list s)) |
|||
((empty-p (hash-isec s (first cs))) |
|||
(cons (first cs) (comb (rest cs) s))) |
|||
(t (consoli (cons (hash-uni s (first cs)) (rest cs)))))) |
|||
[reduce-left comb nil ss]) |
|||
;; 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> |
|||
Output: |
|||
<pre>((a b) (c d)) -> ((b a) (d c)) |
|||
((a b) (b d)) -> ((b a) (b d)) |
|||
((a b) (c d) (d b)) -> ((b a) (d c) (b d)) |
|||
((h i k) (a b) (c d) (d b) (f g h)) -> ((k i h) (b a) (d c) (b d) (g f h))</pre> |