| Bruce Lewis 2006-01-24, 9:58 pm |
| Pascal Bourguignon <spam@mouse-potato.com> writes:
> You'll need a big number of hares and tortoises. Everytime there's a
> fork, you'll need to fork them.
I don't think this is so different from regular equal?, where something
is retained on the stack or heap with each fork.
(define (naive-equal? o1 o2)
(cond ((eqv? o1 o2) #t)
((and (pair? o1) (pair? o2))
(and (naive-equal? (car o1) (car o2))
(naive-equal? (cdr o1) (cdr o2))))
(else #f)))
To illustrate, here's an implementation of cyclical-equal? that doesn't
work on vectors, but seems to work fine for pairs. (t1) returns true
and (t2) returns false, as it should.
I haven't proven to myself that there exist no two cyclical structures
such that a human would regard them as unequal, but cyclical-equal?
would return #t. In such a structure both tortoises would have to catch
up to both hares at the same time, with every traversed node along the
way being equal.
[The "unused" weirdness is me using a student language in drscheme where
the stepper works in v209, the release in Debian testing. The language
demanded that lambda have at least one argument.]
(define unused #f)
(define make-iteration list)
(define (traversal obj branches)
(make-iteration
obj
(if (pair? obj)
(lambda ( unused)
(traversal (car obj)
(cons (cdr obj) branches)))
(if (pair? branches)
(lambda ( unused)
(traversal (car branches) (cdr branches)))
#f))))
(define element car)
(define next-iteration cadr)
(define (follow-next-iteration iter)
((next-iteration iter) unused))
(define (cyclical-equal? o1 o2)
(if (eqv? o1 o2)
#t
(letrec
((helper
(lambda (hare1 hare2 tortoise1 tortoise2 advance-tortoise)
(cond
((and (not (next-iteration hare1))
(not (next-iteration hare2))
(eqv? (element hare1)
(element hare2)))
#t)
((or (and (not (next-iteration hare1))
(next-iteration hare2))
(and (not (next-iteration hare2))
(next-iteration hare1)))
#f)
((or (not (pair? (element hare1)))
(not (pair? (element hare2))))
(and (eqv? (element hare1)
(element hare2))
(helper-next
hare1 hare2 tortoise1 tortoise2 advance-tortoise)))
((and (eq? (element hare1) (element tortoise1))
(eq? (element hare2) (element tortoise2)))
#t)
(else
(helper-next
hare1 hare2 tortoise1 tortoise2 advance-tortoise)))))
(helper-next
(lambda (hare1 hare2 tortoise1 tortoise2 advance-tortoise)
(helper
(follow-next-iteration hare1)
(follow-next-iteration hare2)
(if advance-tortoise
(follow-next-iteration tortoise1)
tortoise1)
(if advance-tortoise
(follow-next-iteration tortoise2)
tortoise2)
(not advance-tortoise)))))
(helper
(traversal o1 '())
(traversal o2 '())
(traversal (list o1) '())
(traversal (list o2) '())
#t))))
(define (t1)
(let ((x (list 1 2 1 2)))
(set-cdr! (list-tail x 3) x)
(cyclical-equal? x (cddr x))))
(define (t2)
(let ((x (list 1 2 1 2)))
(set-cdr! (list-tail x 3) (cdr x))
(cyclical-equal? x (cddr x))))
--
http://ourdoings.com/ Easily organize and disseminate news and
photos for your family or group.
|