samefringe problem

Wilikiの shiroさんのところ でも、2005/11/15 に紹介されている。っていうか、そこで知った。

fringeや継続は使わないとして、与えられたリストをもぐもぐ下へ降りていきつつ、左から同値を検証していくのはどうだろう？　つまり、こんな感じ。

(define (deep-equal? list1 list2)
  (cond ((and (null? list1) (null? list2)) #t)
        ((equal? (deep-car list1) (deep-car list2))
         (deep-equal? (deep-rember (deep-car list1) list1) 
                      (deep-rember (deep-car list2) list2)))
        (else #f)))

deep-car と deep-rember は、勢いで定義すれば、例えば以下のように実現できる。もとのリストたちの構造を破壊しながらたどっていくのはご愛嬌。

(define (deep-car list)
  (cond ((null? list) '())
        ((not (pair? (car list))) (car list))
        ((null? (car list)) (deep-car (cdr list)))
        (else (deep-car (car list)))))

(define (deep-rember item list)
  (cond ((null? list) '())
        ((not (pair? (car list)))
         (if (equal? item (car list))
             (cdr list)
             (cons (car list) (deep-rember item (cdr list)))))
        ((null? (car list))
         (list (car list) (deep-rember item (cdr list))))
        (else 
         (if (equal? (deep-rember item (car list)) (car list))
             (append (car list) (deep-rember item (cdr list)))
             (append (deep-rember item (car list)) (cdr list))))))

（せめて(car list)くらいはローカルにバインドしようと思った……）

追記（2005/11/25）
間違っていたので、上記の deep-rember は修正。