Rosetta Code

Set consolidation: Difference between revisions

Page Discussion

Set consolidation (view source)

Revision as of 10:35, 6 February 2014

16 bytes removed ,  10 years ago
→‎{{header|TXR}}: Argh; pasted the wrong code. Fixed now.
(→‎{{header|TXR}}: Translation of Racket added.)
(→‎{{header|TXR}}: Argh; pasted the wrong code. Fixed now.)
Line 1,450:
 
<lang txr>@(do
(defun mkset (p xitems) (set [pgroup-by x]identity (or [p xitems] x)))
 
(defun fndempty-p (p xset) (ifzerop (eq [p x] x) x (fnd p [phash-count x]set)))
 
(defun uniconsoli (p x yss)
(letdefun ((xrcomb (fnd p x)) (yr (fnd pcs y))s)
(setcond [((empty-p xr]s) yr))cs)
(uni p e((null cs) (carlist s))))▼
 
((empty-p (hash-isec s (first cs)))
(defun consoli (sets)
(letcons (first cs) (pcomb (hashrest cs) s)))
(eacht (consoli (cons (hash-uni s sets(first cs)) (rest cs))))))
[reduce-left comb ss (each ((e s)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>
[mapcar hash-keys (consoli [mapcar mkset test])])))</lang>
 
Output:
Kazinator
543

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/214588"