2005/11/24

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 は修正。

No comments :