fy@lucid.com (Frank Yellin) (06/18/91)
Ton Kostelijk posts the following algorithm from Bernhard Pfahringer. > (defun equal-circle (cons1 cons2) > (or (eql cons1 cons2) > (and (consp cons1) > (consp cons2) > (let ((f2 (first cons2)) > (r2 (rest cons2))) > (unwind-protect > (progn (setf (first cons2) (first cons1) > (rest cons2) (rest cons1)) > (and (equal-circle (first cons1) f2) > (and (equal-circle (first cons1) f2) > (equal-circle (rest cons1) r2)))) > (setf (first cons2) f2 (rest cons2) r2)))))) I received mail from Jim Boyce (the originator of the idea for my original algorithm) this morning. He sent me an example for which the above algorithm goes into an infinite loop, even though it should return 't. Imagine four cons cells, which we'll call a, b, c, and d, in which the car and cdr of each of the four cells are themselves one of the four cons cells. Trivially, any two should be equal-circle to each other, since c {a|d}* r applied to any of the four cells gives you another of the cells. Here's what a, b, c, and d look like: a b c d (c . b) (a . c) (a . c) (d . d) Now try (equal-circle a d) a b c d (equal-circle a d) (c . b) (a . c) (a . c) (d . d) BASH d=d.d (c . b) (a . c) (a . c) (c . b) (equal-circle c d) (c . b) (a . c) (a . c) (c . b) BASH d=c.b (c . b) (a . c) (a . c) (a . c) (equal-circle a c) (c . b) (a . c) (a . c) (a . c) ** BASH c=a.c (c . b) (a . c) (c . b) (a . c) (equal-circle c a) => t (equal-circle b c) (c . b) (a . c) (c . b) (a . c) BASH c=c.b (c . b) (a . c) (a . c) (a . c) (equal-circle a c) (c . b) (a . c) (a . c) (a . c) ** The two lines marked ** are identical, but one is a subproblem of the other. So the result is infinite recursion. Here's the example in "standard" lisp notation: (equal-circle '#1=(#3=(#1# . #3#) . #2=(#1# . #3#)) '#4=(#4# . #4#)) Try it and watch your stack overflow. The moral: rplaca and rplacd are dangerous toys, even when they go by other names. -- Frank Yellin fy@lucid.com
donc@isi.edu (Don Cohen) (06/20/91)
It seems to me that the solution has to postulate a set of
equivalences. Whenever you come across a non-list you can
potentially determine that the structures are not equivalent.
Otherwise you simply have to postulate that they are, and
check their cars and cdrs. In order to avoid infinite
recursion, of course, any time that you come across a pair
that was already postulated equivalent, you don't recur.
The transitivity of equivalence can be used to reduce the
amount of checking. The <angle brackets> below indicate
code to be filled in.
(defun equal-circle (x y &aux <equivalence-data>)
(labels
((presume-equivalent (x y)
<merge the equivalence classes of x and y>)
(presumed-equivalent (x y)
<determine whether the equivalence classes of x and y are the same>)
(test-equivalent x y)
(if (or (eq x y) (presumed-equivalent x y)) t
(if (not (and (consp x) (consp y))) (return-from equal-circle nil)
(progn (presume-equivalent x y)
(test-equivalent (car x) (car y))
(test-equivalent (cdr x) (cdr y))))))
(test-equivalent x y)))
There are pretty efficient ways of finding and merging equivalence classes.