two-in-a-row*? 写経、つれづれ
two-in-a-row*? 関数を写経したり他の実装を考えたりしてみたいと思います。
(define (atom? x) (and (not (pair? x)) (not (null? x))))
準備で、 “The Little Schemer” でも使う atom? 関数です。
まずは写経から。最終的な実装は以下のもの。木を辿って隣り合っている要素があるかどうかをテストする関数です。
(define two-in-a-row*? (letrec ((T? (lambda (a) (let ((n (get-next 'go))) (and (atom? n) (or (eq? n a) (T? n)))))) (get-next (lambda (x) (let/cc here-again (set! leave here-again) (fill 'go)))) (fill values) (waddle (lambda (l) (cond ((null? l) '()) ((atom? (car l)) (let () (let/cc rest (set! fill rest) (leave (car l))) (waddle (cdr l)))) (else (let () (waddle (car l)) (waddle (cdr l))))))) (leave values)) (lambda (l) (let ((fst (let/cc here (set! leave here) (waddle l) (leave '())))) (and (atom? fst) (T? fst)))))) (values (two-in-a-row*? '(((food) ()) (((food))))) (two-in-a-row*? '(((food) (a)) (((food))))) (two-in-a-row*? '(((food) (a b (c) c)) (((food)))))) ;=> #t, #f, #t
木を car から辿り続けて、今注目している要素の値を渡して行く、末尾再帰で書きたくなります。
(define (my-two-in-a-row*? tree) (define (loop v tree k) (cond ((null? tree) (k v)) ((atom? (car tree)) (or (eq? (car tree) v) (loop (car tree) (cdr tree) k))) (else (loop v (car tree) (lambda (v) (loop v (cdr tree) k)))))) (loop '() tree (lambda _ #f)))
隣り合っていた要素があった場合に or でショートカットして、今注目している要素の値を木の cdr へ渡して行く所に手続きを使っています。見つかると or で #t が返されるのに対して、見つからなかったら #f を常に返す手続きを最初に渡して、最終的にそれが呼び出されます。
コレクターなのだけれども何も集めていかないもので、また or でショートカットするという所も “The {Little,Seasoned} Schemer”からすると変則的な形になっています。今注目している要素の値を受け取り続ける、というのがコレクターの役割です。
別の実装も考えてみます。
やっていることは今注目している要素の値を保持して、木を辿っていくことなので、破壊的に書くとしたらこんな具合と思って書いてみます。
(define (my-two-in-a-row*? tree) (let1 a '() (let recur ((tree tree)) (cond ((null? tree) #f) ((atom? (car tree)) (or (eq? (car tree) a) (begin (set! a (car tree)) (recur (cdr tree))))) (else (or (recur (car tree)) (recur (cdr tree))))))))
Scheme のリスト操作関数を組み合わせられる気がする、という感触はあります。ただ、思い付かない…
さらに次。
今注目している要素の値に加えて、 car 部と cdr 部も渡してしまえ、というので考えてみたもの。
(define (my-two-in-a-row*? tree) (define (iter v l r) (cond ((and (null? l) (null? r)) #f) ((null? l) (iter v (car r) (cdr r))) ((atom? l) (or (eq? l v) (iter l r '()))) (else (iter v (car l) (cons (cdr l) r))))) (and (not (null? tree)) (iter '() (car tree) (cdr tree))))
さて。
普通に再帰で書こうとすると、どんなものが自然なのだろうか考えてみます。(個人的な感覚として、末尾再帰で書くということがセミ(準)破壊的、みたいなイメージを持ってます)
木を辿るんだけれども、今注目している要素の値を cdr を辿る節に受け渡す良い方法が思い付かない。たいがいこんな風なコードが else 節には来ると思う:
;; v を今注目している要素の値だとして (or (recur v (car tree)) (recur ??? (cdr tree))) ;; 上をちょっと変えて、そして `#t` の時、見つかったということとすれば。 (let1 r (recur v (car tree)) (or (eq? #t r) (recur r (cdr tree))))
このパターンは、まず、見つかったかどうかというのと、今注目している要素の値を一緒くたにしているのはよくないと思います。二つの値が必要だからコレクターを使う？
(define (my-two-in-a-row*? tree) (define (loop v tree k) (cond ((null? tree) (k v #f)) ((atom? (car tree)) (or (eq? (car tree) v) (loop (car tree) (cdr tree) (lambda (v _found?) (k v #f))))) (else (loop v (car tree) (lambda (v _found?) (loop v (cdr tree) (lambda (v _found?) (k v #f)))))))) (loop '() tree (lambda (_v _found?) #f)))
末尾再帰版と同じですね。コレクターは二つの引数を取るのだけれども、 or でショートカットされるので、見つかったかどうかは意味が無くなる、という。これをちょっともじったやつが最初に挙げたやつです。
二つの値の受け渡しに多値を使ったもの。
(define (my-two-in-a-row*? tree) (define (recur v tree) (cond ((null? tree) (values v #f)) ((atom? (car tree)) (if (eq? (car tree) v) (values v #t) (recur (car tree) (cdr tree)))) (else (receive (newv found?) (recur v (car tree)) (if found? (values newv #t) (recur newv (cdr tree))))))) (values-ref (recur '() tree) 1))
ここまで書いてきたものをみていると、後々見返した時にどうなのだろう？という気もしてきます。
比較すると、一番上の、 two-in-a-row*? の T? 関数と、本体とを取り出すと、
...(T?
(lambda (a)
(let ((n (get-next 'go)))
(and (atom? n)
(or (eq? n a)
(T? n))))))
...
(lambda (l)
(let ((fst (let/cc here
(set! leave here)
(waddle l)
(leave '()))))
(and (atom? fst)
(T? fst))))
...「 get-next で次に注目するべき値を取ってきて、それが今注目している要素の値と同じだったら」。言ってみれば、次を取ってくる部分と、本体部分がある、ということが言えるのかなと思います。他は両方が同居している感じがあるような気がして、どちらも一長一短。
次を取ってきて、というのを次に注目するべき値と部分木を返すようにしてみます。
(define (my-two-in-a-row*? tree) (define (next tree) (cond ((null? tree) (values '() '())) ((atom? (car tree)) (values (car tree) (cdr tree))) (else (receive (v r) (next (car tree)) (if (null? v) (next (cdr tree)) (values v (cons r (cdr tree)))))))) (receive (fst newtree) (next tree) (and (atom? fst) (let T? ((a fst) (newtree newtree)) (receive (n r) (next newtree) (and (atom? n) (or (eq? n a) (T? n r))))))))