20 lines
638 B
Text
20 lines
638 B
Text
(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])]))
|