rather simple list/set operation

[Drew Krause]

Maybe someone can help me with this?

I start with a list, e.g.

((0) (1 3) (1 2) (4 6) (5 7) (7 8))


and want all members of intersecting lists to appear in the same sublist:

=> ((0) (1 2 3) (4 6) (5 7 8))


.. any help appreciated! DK

[sidney]

Drew Krause wrote, On 4/01/12 2:01 PM:

> Maybe someone can help me with this?
>
> I start with a list, e.g.
>
> ((0) (1 3) (1 2) (4 6) (5 7) (7 8))
>
>
> and want all members of intersecting lists to appear in the same sublist:
>
> => ((0) (1 2 3) (4 6) (5 7 8))

I don't have a good sense for when someone is asking for help with their
homework assignment, so I'll stop short of giving you actual code and just
mention an approach that occurs to me.

You can take each element of your input and give it to a function that is
building up the output starting from an empty list. That function would take
the input element and intersect it with each element of the output that is
being built. If the intersection is not empty, replace that element in the
output with the union. If you never find a non-empty intersection, insert that
input element in the output list you are building.

When you finish going through all the input elements the output list you have
built is the result.

How to do that in Lisp, whether to use a loop or a map function or recursion
or whatever is left as an exercise for the reader.

[Joshua Taylor]

On 2012.01.03 9:50 PM, sidney wrote:
> Drew Krause wrote, On 4/01/12 2:01 PM:
>> Maybe someone can help me with this?
>>
>> I start with a list, e.g.
>>
>> ((0) (1 3) (1 2) (4 6) (5 7) (7 8))
>>
>>
>> and want all members of intersecting lists to appear in the same sublist:
>>
>> => ((0) (1 2 3) (4 6) (5 7 8))
>
> I don't have a good sense for when someone is asking for help with their
> homework assignment, so I'll stop short of giving you actual code and just
> mention an approach that occurs to me.
>
> You can take each element of your input and give it to a function that is
> building up the output starting from an empty list. That function would take
> the input element and intersect it with each element of the output that is
> being built. If the intersection is not empty, replace that element in the
> output with the union. If you never find a non-empty intersection, insert that
> input element in the output list you are building.
>
> When you finish going through all the input elements the output list you have
> built is the result.

With this algorithm, given the input

((0 1) (2 3) (4 5) (0 4))

wouldn't the output be a permutation of one of (order within sublists
doesn't matter)

((0 1 4) (2 3) (0 4 5))

since (0 4) would be UNIONed with (0 1) and with (4 5), but (0 1 4) and
(0 4 5) wouldn't ever be combined. I'd think the output in such a case
should be (a permutation of):

((0 1 4 5) (2 3))

//JT

[Kaz Kylheku]

Here is something I just banged up:

If your prof asks, say that you realized this was a "disjoint sets" problem,
for which an algorithm was found on the Wikipedia, which could
be adapted to Lisp using hashes. :)

(defun disjoint-sets (sets &key (test #'eql))
(let ((disj-sets-hash (make-hash-table :test test)))
(labels ((get-set (elem)
;; get the set/partition that the element belongs to
;; creating a new one if necessary
(let ((partition (gethash elem disj-sets-hash)))
(or partition (setf (gethash elem disj-sets-hash)
(cons (cons elem nil) nil)))))
(merge-set (from-set to-set)
;; migrate all members of from-set to to-set
;; and update their (get-set ...) pointer to the new set also.
(unless (eq from-set to-set)
(dolist (each-elem (car from-set))
(setf (gethash each-elem disj-sets-hash) to-set))
(setf (car to-set) (union (car from-set) (car to-set))))))
(dolist (set sets)
(let ((fs (get-set (first set))))
(dolist (elem (rest set))
(merge-set (get-set elem) fs))))
(loop for x being the hash-values of disj-sets-hash
collecting x into partitions
finally (return (mapcar #'car (remove-duplicates partitions)))))))

[Madhu]

* Joshua Taylor <je0jv4$3qp$1...@dont-email.me> :
Wrote on Tue, 03 Jan 2012 23:18:39 -0500:

| On 2012.01.03 9:50 PM, sidney wrote:
|> Drew Krause wrote, On 4/01/12 2:01 PM:
|>> Maybe someone can help me with this?
|>>
|>> I start with a list, e.g.
|>>
|>> ((0) (1 3) (1 2) (4 6) (5 7) (7 8))
|>>
|>> and want all members of intersecting lists to appear in the same
|>> sublist:
|>>
|>> => ((0) (1 2 3) (4 6) (5 7 8))
|>
|> I don't have a good sense for when someone is asking for help with their
|> homework assignment, so I'll stop short of giving you actual code and just
|> mention an approach that occurs to me.

I'd be interested in the instructor who gave this problem for homework:
if they expected the student to devise the Union-Find algorithm.

[snip: Sidney's algorithm]

| Wouldn't the output be a permutation of one of (order within sublists

| doesn't matter)
|
| ((0 1 4) (2 3) (0 4 5))
|
| since (0 4) would be UNIONed with (0 1) and with (4 5), but (0 1 4) and
| (0 4 5) wouldn't ever be combined. I'd think the output in such a case
| should be (a permutation of):
|
| ((0 1 4 5) (2 3))

Indeed Sidney's algorithm wouldn't cut it;

There have been a a few union-find algorithms posted on CLL but they all
suffer from some defect.

Using Marcoxa's union-find package, one could clumsily express the
solution as

(defparameter $PARTITION (cl:uf-make-partition :test #'eql))

(mapcar (lambda (l)
(reduce (lambda (a b) (cl-uf:union $PARTITION a b) b)
l
:key (lambda (x) (cl-uf:make-set $PARTITION x))))
LIST)

And then collect the disjoint sets as:

(let ((printed-sets (make-hash-table :test #'eq)))
(declare (dynamic-extent printed-sets))
(loop for v being each hash-key of
(cl-uf::partition-element-sets-map $PARTITION)
for s = (cl-uf:find-set $PARTITION v)
unless (gethash s printed-sets)
do (setf (gethash s printed-sets) t)
and collect (cl-uf:collect-set $PARTITION v)))

But the clumsiness indicates that this API to the UF algorithm is also
lacking, so I'm left looking for other interfaces to the algorithm.

--- Madhu

[sidney]

Madhu wrote, On 4/01/12 7:52 PM:

>
> * Joshua Taylor <je0jv4$3qp$1...@dont-email.me> :
> Wrote on Tue, 03 Jan 2012 23:18:39 -0500:

> [snip: Sidney's algorithm]
>
> | Wouldn't the output be a permutation of one of (order within sublists
> | doesn't matter)
> |
> | ((0 1 4) (2 3) (0 4 5))
> |
> | since (0 4) would be UNIONed with (0 1) and with (4 5), but (0 1 4) and
> | (0 4 5) wouldn't ever be combined. I'd think the output in such a case
> | should be (a permutation of):
> |
> | ((0 1 4 5) (2 3))
>
> Indeed Sidney's algorithm wouldn't cut it;

It just needs to be iterated on the result until there is no change. Off the
top of my head I don't think it ends up calculating intersections of pairs
more times than it has to when you do it that way.

;; check one element of the input against each element of
;; the results so far until we find an intersection or find none
;; When there is an intersection replace that elememt with the union
;; If there is none, push element on to the partial result
(defun merge-one-element (elem partial-results)
(unless (do* ((e partial-results (cdr e))
(a (car e) (car e)))
((null e) nil)
(when (intersection elem a)
(setf (car e) (union a elem))
(return partial-results)))
(push elem partial-results))
partial-results)

;; Starting with an empty partial result, merge in each input element
;; Call recursively on the final result until the length stops changing
(defun merge-sets (lists)
(let ((result nil))
(dolist (e lists
(if (= (length result) (length lists))
result
(merge-sets result)))
(setf result (merge-one-element e result)))))


CL-USER> (merge-sets '((0 1) (2 3) (4 5) (0 4)))
((4 5 0 1) (2 3))

CL-USER> (merge-sets '((0) (1 3) (1 2) (4 6) (5 7) (7 8)))
((0) (3 1 2) (4 6) (5 7 8))

[sidney]

sidney wrote, On 4/01/12 10:32 PM:

> (defun merge-one-element (elem partial-results)
> (unless (do* ((e partial-results (cdr e))
> (a (car e) (car e)))
> ((null e) nil)
> (when (intersection elem a)
> (setf (car e) (union a elem))
> (return partial-results)))
> (push elem partial-results))
> partial-results)

The (return partial-results) should have said (return t). It works both ways
because partial-results can't be nil there, but all I'm doing is returning t
or nil from the do* so t is less confusing.

The former was left over from a different version I was writing.

[Marco Antoniotti]

I agree, the (ancient) UF code just provides the bare bone API. Any ideas about how to improve it?

Cheers
--
MA

[WJ]

MatzLisp:

def coalesce( lists )
accum = [ ]
lists.each{|x|
i = accum.index{|y| not (x & y).empty? }
if i
accum[i] += x
else
accum << x
end
}
accum.map{|x| x.uniq}
end

coalesce( [[0], [1,3], [1,2], [4,6], [5,7], [7,8]] )

===> [[0], [1, 3, 2], [4, 6], [5, 7, 8]]

[WJ]

Shorter:

def coalesce( lists )
accum = [ ]
lists.each{|x|
i = accum.index{|y| not (x & y).empty? }
if i

accum[i] |= x

else
accum << x
end
}
accum

end

[Kaz Kylheku]

> Shorter:
>
> def coalesce( lists )
> accum = [ ]
> lists.each{|x|
> i = accum.index{|y| not (x & y).empty? }
> if i
> accum[i] |= x
> else
> accum << x
> end
> }
> accum
> end

The code you have here is short, but it's not the disjoint sets algorithm.

This is like offering a bubble sort in Ruby as a shorter, better version
of someone's Lisp quicksort.

Your accum.index{...} is a linear search whereby you're searching your
growing list of sets to see where each element belongs.

The Lisp code you quoted does not perform any such a search.

[Marco Antoniotti]

In other words, WJ's code is more boring and thus more conductive to sleep. Yawn :)

MA

[Wade]

Sure,

(defun merge-intersections (list &optional (test #'=) (sorter #'<)
&aux result intersection)
(dolist (member list (nreverse result))
(setf intersection nil)
(setf result (mapcar (lambda (result-member)
(if (and (not intersection) (setf intersection (intersection
member result-member :test test)))
(sort (union member result-member :test test) sorter)
result-member))
result))
(unless intersection (push member result))))

CL-USER> (merge-intersections `((0) (1 3) (1 2) (4 6) (5 7) (7 8)))

((0) (1 2 3) (4 6) (5 7 8))

CL-USER>

Wade

[Nicolas Neuss]

I wonder if this is really what the OP wants (if he knows it himself).
E.g., your function depends on the order of its arguments while his
(under)specification does not:

(merge-intersections '((1 2) (2 3) (3 4)))
=> ((1 2 3 4))
(merge-intersections '( (3 4) (1 2) (2 3)))
=> ((3 4) (1 2 3))

Nicolas

[Wade]

On Feb 22, 4:43 am, Nicolas Neuss <lastn...@scipolis.de> wrote:

But at least it will show that I (he) am fallible. Interesting that I
missed that.

Here is a modified version. Feels like it could be shorter, and I am
not
confident that its correct.

(defun merge-intersections (list &optional (test #'=) (sorter #'<)
&aux result intersection)

(dolist (member list (if (< (length result) (length list))
(merge-intersections (nreverse result))
(nreverse result)))

(setf intersection nil)
(setf result (mapcar (lambda (result-member)
(if (and (not intersection) (setf intersection (intersection
member result-member :test test)))
(sort (union member result-member :test test) sorter)
result-member))
result))
(unless intersection (push member result))))

CL-USER> (time (merge-intersections `((0) (1 3) (1 2) (4 6) (5 7) (7
8))))
(MERGE-INTERSECTIONS '((0) (1 2 3) (1 2) (4 6) (5 7 8) (7 8))) took 42
microseconds (0.000042 seconds) to run
with 2 available CPU cores.
During that period, 37 microseconds (0.000037 seconds) were spent in
user mode
16 microseconds (0.000016 seconds) were spent in
system mode
1,472 bytes of memory allocated.

((0) (1 2 3) (4 6) (5 7 8))

CL-USER> (merge-intersections `( (3 4) (1 2) (2 3)))
((1 2 3 4))
CL-USER>

[Nicolas Neuss]

Wade <wade.h...@gmail.com> writes:

> Here is a modified version. Feels like it could be shorter, and I am
> not
> confident that its correct.
>
> (defun merge-intersections (list &optional (test #'=) (sorter #'<)
> &aux result intersection)
> (dolist (member list (if (< (length result) (length list))
> (merge-intersections (nreverse result))
> (nreverse result)))
> (setf intersection nil)
> (setf result (mapcar (lambda (result-member)
> (if (and (not intersection) (setf intersection (intersection
> member result-member :test test)))
> (sort (union member result-member :test test) sorter)
> result-member))
> result))
> (unless intersection (push member result))))

Here is a shorter alternative:

(defun merge-intersections (lists)
(let* ((pivot (first lists))
(others (loop for l2 in (rest lists)
if (intersection pivot l2)
do (setq pivot (union pivot l2))
else collect l2)))
(if (= (length others) (1- (length lists)))
lists
(merge-intersections (list* pivot others)))))

Nicolas

[Nicolas Neuss]

Nicolas Neuss <last...@scipolis.de> writes:

> Here is a shorter alternative:
>
> (defun merge-intersections (lists)
> (let* ((pivot (first lists))
> (others (loop for l2 in (rest lists)
> if (intersection pivot l2)
> do (setq pivot (union pivot l2))
> else collect l2)))
> (if (= (length others) (1- (length lists)))
> lists
> (merge-intersections (list* pivot others)))))

"Fails" when lists is empty. Replacing = with >= is a quick hack fixing
that problem.

Nicolas

[Nicolas Neuss]

Unfortunately still incorrect. Here is my (hopefully) final version:

(defun merge-intersections (lists)
(when lists

(let* ((pivot (first lists))
(others (loop for l2 in (rest lists)
if (intersection pivot l2)
do (setq pivot (union pivot l2))
else collect l2)))
(if (= (length others) (1- (length lists)))

(cons pivot (merge-intersections others))
(merge-intersections (cons pivot others))))))

I think the problem would get more interesting when performance
considerations come into play.

Nicolas

[WJ]

NewLisp:

(define (coalesce lists)
(let (accum '())
(dolist (x lists)
(let (i (find x accum (fn (a b) (true? (intersect a b)))))
(if i
(setf (accum i) (unique (append (accum i) x)))
(push x accum -1))))
accum))


(coalesce '((0) (1 3) (1 2) (4 6) (5 7) (7 8)))

==> ((0) (1 3 2) (4 6) (5 7 8))

[Kaz Kylheku]

Good to see you coding in some kind of Lisp, but again, you're using a simple
O(N * N) algorithm, which allows the code to be glib. My code is more
complicated, but it gets the time down to O(N). That starts to get important
if you have only just several thousand items, and the operation is frequently
executed. Also, I had the impression that it was a homework problem. Glib
solutions to homework problems go straight to the prof for an A+ grade.

But anyway, here is how the above looks like in Common Lisp: it's not very
different from what you have there. Why don't you just use the real thing!

(defun coalesce (lists)
(let (accum)
(dolist (x lists (nreverse accum))
(let ((i (position x accum :test (lambda (a b) (intersection a b)))))
(if i
(setf (nth i accum) (union (nth i accum) x))
(push x accum))))))

At least we can compile this to get some speedup. NewLisp is interpreted only,
and its semantics are screwed up to make sure it stays that way forever.
Furthermore, NewLisp's "ORO" memory management means that it's copying linked
lists around instead of efficiently passing references.

How about we drill down on one particular suckiness in the CL version:

;; double evaluation of (nth i accum)
(setf (nth i accum) (union (nth i accum) x))

Lisp has a nice feature which lets us write it like this:

(unionf (nth i accum) x)

such that the (nth i accum) form is evaluated only once. The GET-SETF-EXPANSION
function gives us access to Lisp's setf-place analyzer that is uses to compile
the operators that modify place forms.

The naive definition of unionf still evaluates the place twice, giving us only
the syntactic convenience, with a hidden programmer pitfall.

(defmacro unionf (set-place set)
(setf ,set-place (union ,set-place ,set)))

The "pro" version is harder to write, but may be worth it---not only
for efficiency (which we may not get, depending on how good the setf expansion
material is) but for cleaner semantics. Forms can contain side effects that
get done multiple times if there are multiple evaluations, which is a
programmer pitfall. And thus:

(defmacro unionf (set-place set &environment env)
(multiple-value-bind (temp-vars vals new-vars store-form load-form)
(get-setf-expansion set-place env)
(when (rest new-vars)
(error "unionf: not usable with multiple value place ~s" set-place))
`(let (,@(mapcar #'list temp-vars vals)
(,(first new-vars) ,load-form))
(prog1
(setf ,(first new-vars) (union ,(first new-vars) ,set))
,store-form))))

A simple instance:

(macroexpand '(unionf a b))

-> (LET ((#:NEW-12734 A))
(PROG1 (SETF #:NEW-12734 (UNION #:NEW-12734 B)) (SETQ A #:NEW-12734)))

Very good; so how about an (nth ...) place:

(macroexpand '(unionf (nth x y) x))

-> (LET ((#:TEMP-12737 X) (#:TEMP-12736 Y)
(#:NEW-12735 (NTH #:TEMP-12737 #:TEMP-12736)))
(PROG1 (SETF #:NEW-12735 (UNION #:NEW-12735 X))
(SYSTEM::%SETNTH #:TEMP-12737 #:TEMP-12736 #:NEW-12735)))

(This could be better: we have the single evaluation of the place form,
but it still marches down the list twice. The above is from CLISP; clearly
they didn't see it fit to bother with the best possible setf expansion
for NTH.)

In NewLisp you could get single evaluation by using a fexpr. But fexprs evaluate
the source code at run time. With applications relying on that, good luck
making a compiled NewLisp one day.

[WJ]

Clojure (1.2):

(defn coalesce [sets]
(with-local-vars [accum '()]
(doseq [x sets]
(let [new-accum
(map #(if (empty? (clojure.set/intersection x %))
%
(clojure.set/union x %))
@accum)]
(var-set accum (if (= @accum new-accum)
(conj @accum x)
new-accum))))
(reverse @accum)))

(coalesce '(#{0} #{1 3} #{1 2} #{4 6} #{5 7} #{7 8}))

==> (#{0} #{1 2 3} #{4 6} #{5 7 8})

[Tim Bradshaw]

"WJ" <w_a_...@yahoo.com> wrote:

> (defn coalesce [sets]
> (with-local-vars [accum '()]
> (doseq [x sets]
> (let [new-accum
> (map #(if (empty? (clojure.set/intersection x %))
> %
> (clojure.set/union x %))
> @accum)]
> (var-set accum (if (= @accum new-accum)
> (conj @accum x)
> new-accum))))
> (reverse @accum)))

Clojure's kind of lime a dishonest version of perl, isn't it?

[Tim Bradshaw]

like. bloody tablet keyboard.

[WJ]

Another way:

(define (coalesce lists)
(let (accum (list (pop lists)))
(dolist (x lists)
(replace x accum (unique (append $it x))

(fn (a b) (true? (intersect a b))))

(if (zero? $0) (push x accum -1)))
accum))

[Pascal J. Bourguignon]

"WJ" <w_a_...@yahoo.com> writes:

> Clojure (1.2):
>
> (defn coalesce [sets]
> (with-local-vars [accum '()]
> (doseq [x sets]
> (let [new-accum
> (map #(if (empty? (clojure.set/intersection x %))
> %
> (clojure.set/union x %))
> @accum)]
> (var-set accum (if (= @accum new-accum)
> (conj @accum x)
> new-accum))))
> (reverse @accum)))
>
> (coalesce '(#{0} #{1 3} #{1 2} #{4 6} #{5 7} #{7 8}))
>
> ==> (#{0} #{1 2 3} #{4 6} #{5 7 8})

defn, with-local-vars, @var… Really!



You dont need so many different characters to write a program.

(defun coalesce (sets)
(let ((accum '()))
(dolist (x sets)
(let ((new-accum (mapcar (lambda (%) ; what a parameter name! But your call…
(if (null (intersection x %))
%
(union x %)))
accum)))
(setf accum (if (equal accum new-accum)
(cons x accum)
new-accum))))
(reverse accum)))

(coalesce '((0) (1 3) (1 2) (4 6) (5 7) (7 8)))
--> ((0) (2 1 3) (4 6) (8 5 7))



--
__Pascal Bourguignon__ http://www.informatimago.com/
A bad day in () is better than a good day in {}.

[WJ]

NewLisp:

(define (union a b) (sort (unique (append a b))))

(define (coalesce lists accum)
(dolist (x lists)
(dolist (y lists)
(unless (empty? (intersect x y)) (setf x (union x y))))
(push x accum -1))
(unique accum))

(coalesce '((0) (1 3) (1 2) (4 6) (5 7) (7 8)))

==> ((0) (1 2 3) (4 6) (5 7 8))


Yet another way:


(define (union a b) (sort (unique (append a b))))

(define (peers lists x)
(dolist (y lists)
(unless (empty? (intersect x y)) (setf x (union x y))))
x)

(define (coalesce lists)
(unique (map (curry peers lists) lists)))


(coalesce '((0) (1 3) (1 2) (4 6) (5 7) (7 8)))

==> ((0) (1 2 3) (4 6) (5 7 8))

[Nicolas Neuss]

Nicolas Neuss <last...@scipolis.de> writes:

> [unnecessary noise]

>
> I think the problem would get more interesting when performance
> considerations come into play.

And now I see that Kaz Kylheku has already offered a perfect answer
(disjoint sets algorithm) in this very thread almost two months ago.
Unfortunately, I didn't read his messages carefully enough and instead
swallowed the bait of someone resurrecting a rather old thread.

Nicolas

[WJ]

Xah Lee demands functional code! Must avoid electric shock!

(define (union a b) (sort (unique (append a b))))

(define (peers lists x)

; Invoked this way, apply is like reduce.
(apply
(fn (a b) (if (empty? (intersect a b)) a (union a b)))
(cons x lists) 2))

[Wade Humeniuk]

I did read Kaz Kylheku's answer, and it was one of the reasons that I posted. I did not think that it addressed the essence of the problem. It often seems that the push for a performant answer gives a non-expressive answer. The original poster would see the solution and say "what does a hash table have to do with a union of sets?". The underlying data structures and algorithms become more important than expressing a solution.

In the final implementation of the code, the grot of the details should be hid behind powerful functions and concepts (like common lisp's intersection, union, remove-duplicates). I think than when learning to program it is necessary to promote this way of thinking. Break the problem into its steps, express it in a "natural" way and leave the details for later. If one is lucky one may discover a new concept or higher level construct that makes the problem more understandable.

Wade

[Nicolas Neuss]

OK, fair enough. Then perhaps also my attempts were not completely
useless. At the very least, the resurrection of the thread had the good
effect that -having more time at hand than two months ago- I looked at
Kaz' posts more carefully.

Nicolas

[Wade Humeniuk]

On Sunday, March 4, 2012 10:05:26 AM UTC-7, Nicolas Neuss wrote:
>
> OK, fair enough. Then perhaps also my attempts were not completely
> useless. At the very least, the resurrection of the thread had the good
> effect that -having more time at hand than two months ago- I looked at
> Kaz' posts more carefully.
>
> Nicolas

Though the original problem looks simple enough I think the issues it brings up could keep one occupied for a good long while. You could probably write a whole chapter of what is programming, the relation to language, human thought. mathematics, computing and data structures. It is an awesome learning moment for the original poster and a teaching moment for the professor.

I do not think your attempts were useless, the code is simpler and it leads me to think that there may even simpler and more expressive solutions to the problem. In its core there may be the hints that there is additional structure yet to discovered in lisp and programming.

Wade

[Elias Mårtenson]

On Sunday, 4 March 2012 19:03:57 UTC+8, WJ wrote:

> Xah Lee demands functional code! Must avoid electric shock!
>
>
> (define (union a b) (sort (unique (append a b))))
>
> (define (peers lists x)
> ; Invoked this way, apply is like reduce.
> (apply
> (fn (a b) (if (empty? (intersect a b)) a (union a b)))
> (cons x lists) 2))
>
> (define (coalesce lists)
> (unique (map (curry peers lists) lists)))
>
>
> (coalesce '((0) (1 3) (1 2) (4 6) (5 7) (7 8)))
>
> ==> ((0) (1 2 3) (4 6) (5 7 8))

Sorry. He won't accept that. For some reason he doesn't consider CONS to be functional, so you have to replace it with (make-array 2 :initial-elements x lists)

[WJ]

Kaz Kylheku wrote:

> On 2012-01-04, Drew Krause <drkr...@mindspring.com> wrote:
> > Maybe someone can help me with this?
> >
> > I start with a list, e.g.
> >
> > ((0) (1 3) (1 2) (4 6) (5 7) (7 8))
> >
> >
> > and want all members of intersecting lists to appear in the same sublist:
> >

> >=> ((0) (1 2 3) (4 6) (5 7 8))
> >
> >

Racket:

(define (coalesce lists)
(define accum '())
(for ([x (map list->set lists)])
(define-values (miss hit)
(partition
(lambda (y) (set-empty? (set-intersect x y)))
accum))
(set! accum
(if (empty? hit)
(cons x accum)
(cons (set-union x (car hit)) miss))))
(reverse accum))

(coalesce '((0) (1 3) (1 2) (4 6) (5 7) (7 8)))

=> (list (set 0) (set 1 2 3) (set 4 6) (set 5 7 8))