Path: utzoo!utgpu!news-server.csri.toronto.edu!bonnie.concordia.ca!uunet!stanford.edu!lucid.com!karoshi!fy
From: fy@lucid.com (Frank Yellin)
Newsgroups: comp.lang.lisp
Subject: Re: EQUAL on circular lists
Message-ID: <FY.91Jun7161531@hardwick.lucid.com>
Date: 7 Jun 91 20:15:31 GMT
References: <2849@prles2.prl.philips.nl>
Sender: usenet@lucid.com
Organization: Lucid, Inc., Menlo Park, CA
Lines: 107
In-Reply-To: kostelij@apolloway.prl.philips.nl's message of 5 Jun 91 14:08:48 GMT



> QUESTION:
> 
> Does anyone have an extended version of EQUAL which can determine in 
> finite time whether two trees of conses have the same printed
> (possibly infinite) representation?

I once asked the same question.

Jim Boyce, formerly of Lucid, now at Oracle, pointed out to me that this
problem is pretty much the same as determining whether two deterministic
finite state automata are equivalent.

Here's a rough implementation.  I haven't tested it thoroughly, but it
should give you an approximate idea of what you need to do.

The idea is objects "a" and "b" are super-equal if 
    1) If either a or b isn't a cons, then (eql a b). [or whatevever choice of
       base comparisons you want to use.
    2) If both "a" and "b" are cons cells, then it must be the case that
       (super-equal (car a) (car b)) and (super-equal (cdr a) (cdr b)).

We keep a queue of all the pairs (one a cell from a, one a cell from b) that we
still need to look at.  In addition, we keep a list of all the pairs that we
have every looked at, so that we don't try to look at them again.

The how field in the code is so that when the code returns nil, you'll know
why the two differ.  It can easily be purged.

The code is based on an algorithm I just stole from "Mathematical Theory of
Computation" by Zohar Manna.


(defstruct pair first second how)

(defun eq-pair (a b)
  (and (eq (pair-first a) (pair-first b))
       (eq (pair-second a) (pair-second b))))

(defun super-equal (a b)
  (let* ((initial-pair (make-pair :first a :second b))
	 (queue (list initial-pair))
	 (everything-seen (list initial-pair)))
    (loop
      (when (null queue) (return 't)) ; nothing more to look at.  Most be okay!
      (let* ((pair (pop queue))		; an item to look at
	     (pair-first (pair-first pair))
	     (pair-second (pair-second pair))
	     (pair-how (pair-how pair)))
	;; pair-first and pair-second must be super-equal.
	(if (and (consp pair-first) (consp pair-second))
	    ;; the cons cell is super equal if both the car and cdr are
	    (let ((car-pair (make-pair :first (car pair-first)
				       :second (car pair-second)
				       :how (cons 'car pair-how)
				       ))
		  (cdr-pair (make-pair :first (cdr pair-first)
				       :second (cdr pair-second)
				       :how (cons 'cdr pair-how)
				       )))
	      ;; If we've already seen the car pair, then don't bother.
	      ;; Otherwise put it on the queue.  Also add it to the list of
	      ;; things seen.
	      (unless (member car-pair everything-seen :test 'eq-pair)
		(push car-pair everything-seen) (push car-pair queue))
	      ;;; Ditto for the cdr pair.
	      (unless (member cdr-pair everything-seen :test 'eq-pair)
		(push cdr-pair everything-seen) (push cdr-pair queue)))
	    ;; One of the items isn't a cons cell.  Just see if they're eql.
	    (unless (eq pair-first pair-second)
	      (return (values nil pair-how))))))))


Here are the test cases you asked about.

> (setf p         (cons 'a nil) 
      (cdr p)   p
      q         (cons 'a nil)
      (cdr q)   q)
#1=(A . #1#)
> (setf r          (list 'a 'a 'a 'a)
      (cddddr r) (cdr r))
#1=(A A A . #1#)
> (setf v         '(a nil)
      (cadr v)  v
      w         '(a (a nil))
      (cdadr w) w)
#1=(A (A . #1#))
> (super-equal p q)
T
> (super-equal p r)
T
> (super-equal q r)
T
> (super-equal v w)
NIL
(CDR CDR CAR CDR)
> (cdr (cdr (car (cdr v))))
NIL
> (cdr (cdr (car (cdr w))))
#1=((A A . #1#))
> 


-- Frank Yellin
   fy@lucid.com