kb84tkhrのブログ

何を書こうか考え中です

Scheme修行(12) 第19章 宝石泥棒(続きの続き)

前回のwaddleはもともと再帰がややこしいところにlet/ccが入ったので

なんだかよくわからないことになってましたが
leaveとfillだけの話ならこんな感じでぴょんぴょんさせることができます

(define A
  (lambda ()
    (let/cc here (set! leave here)
      (display "A1") (newline)
      (B))
    (let/cc here (set! leave here)
      (display "A2") (newline)
      (fill))
    (let/cc here (set! leave here)
      (display "A3") (newline)
      (fill))
    (display "A4") (newline)))

(define B
  (lambda ()
    (let/cc here (set! fill here)
      (display "B1") (newline)
      (leave))
    (let/cc here (set! fill here)
      (display "B2") (newline)
      (leave))
    (let/cc here (set! fill here)
      (display "B3") (newline)
      (leave))))

get-firstの最後のleaveに相当するものはどこへ行ってしまったのか少し心配ですが
思った通りには動いてくれます

> (A)
A1
B1
A2
B2
A3
B3
A4

こういうのをたぶんコルーチンって言うんですよね

もっとよく理解するために、収集子を使った形に直してみます
忘れない関数を覚えおくべし、って言ってましたしね(意味がよくわかってないけど)

(define get-first&co
  (lambda (l)
    (let ((here (lambda (x) x)))
      (set! leave here)
      (waddle&co l here))))

(define get-next&co
  (lambda ()
    (let ((here-again (lambda (x) x)))
      (set! leave here-again)
      (fill (quote go)))))

(define waddle&co
  (lambda (l col)
    (cond ((null? l) (col (quote ())))
          ((atom? (car l))
           (let ((rest (lambda (x) (waddle&co (cdr l) col))))
             (set! fill rest)
             (leave (car l))))
          (else (waddle&co
                 (car l)
                 (lambda (x) (waddle&co (cdr l) col)))))))

なんとなくこんな感じかな、と思って書いてみたら動いてしまって
なぜちゃんと動くのかちっともわかりません
もしかしたらたまたまかも

さらに削って、途中で脱出しない版を作ってみます
これはScheme手習いの復習ですね

(define waddle&co
  (lambda (l col)
    (cond ((null? l) (col (quote ())))
          ((atom? (car l))
           (display (car l)) (newline)
           (waddle&co (cdr l) col))
          (else (waddle&co (car l) (lambda (x) (waddle&co (cdr l) col)))))))

何もしないと途中何が起こっているのかわからないのでdisplayを入れました
(((a)) b)に適用してみます

(waddle&co '(((a)) b) (lambda (x) x))
(waddle&co '((a)) (lambda (x) (waddle&co '(b) (lambda (x) x))))
(waddle&co '(a) (lambda (x) (waddle&co '()
                  (lambda (x) (waddle&co '(b) (lambda (x) x))))))
; (display 'a) (newline)
(waddle&co '() (lambda (x) (waddle&co '()
                 (lambda (x) (waddle&co '(b) (lambda (x) x))))))
((lambda (x) (waddle&co '()
   (lambda (x) (waddle&co '(b) (lambda (x) x))))) (quote ()))
(waddle&co '() (lambda (x) (waddle&co '(b) (lambda (x) x))))
((lambda (x) (waddle&co '(b) (lambda (x) x))) (quote ()))
(waddle&co '(b) (lambda (x) x))
; (display 'b) (newline)
(waddle&co '() (lambda (x) x))
((lambda (x) x) (quote ()))
(quote ())

colの値は捨てられるだけなのであまり複雑にならず多少追いかけやすいです

もとの定義では、この流れがところどころでぶったぎられる形になっているはず

(get-first&co '(((a)) b))
; (set leave (lambda (x) x))
(waddle&co '(((a)) b) (lambda (x) x))
(waddle&co '((a)) (lambda (x) (waddle&co '(b) (lambda (x) x))))
(waddle&co '(a) (lambda (x) (waddle&co '()
                  (lambda (x) (waddle&co '(b) (lambda (x) x))))))
; (set fill (lambda (x) (waddle&co '()
;             (lambda (x) (waddle&co '(b) (lambda (x) x))))))
(leave 'a)
((lambda (x) x) 'a)
'a

(get-next&co)
; (set leave (lambda (x) x))
(fill (quote go))
((lambda (x) (waddle&co '()
   (lambda (x) (waddle&co '(b) (lambda (x) x))))) (quote go))
(waddle&co '() (lambda (x) (waddle&co '(b) (lambda (x) x))))
((lambda (x) (waddle&co '(b) (lambda (x) x))) (quote ()))
(waddle&co '(b) (lambda (x) x))
; (set fill (lambda (x) (waddle&co '() (lambda (x) x))))
(leave 'b)
((lambda (x) x) 'b)
'b

(get-next&co)
; (set leave (lambda (x) x))
(fill (quote go))
((lambda (x) (waddle&co '() (lambda (x) x))) (quote go))
(waddle&co '() (lambda (x) x))
((lambda (x) x) (quote ()))
(quote ())
'()

ふむ
そんな感じですね

脱出のためのしくみは何も使っていないのに、同じことができてるのが面白いです
収集子を使う形にしたとき、全体が末尾再帰の形になったから、かなあ?
lambdaすげえ

ちゃんと動くし変なコードを書いてたりするわけでもなさそうです
でもまだ収集子が育って評価される様子がぱっとイメージできるところまではいってないんですよねー
半分機械的に書きなおしてみたら意外とうまくいった、て感じは拭えない

さてここまでわかればもう(やっと)two-in-a-row*?は目前です
ついでに第13の戒律を適用します

(define two-in-a-row*?
  (letrec
      ((T? (lambda (a)
             (let ((n (get-next (quote ()))))
               (if (atom? n)
                   (or (eq? n a) (T? n))
                   #f))))
       (get-next (lambda (x)
                   (let/cc here-again
                     (set! leave here-again)
                     (fill (quote go)))))
       (fill (lambda (x) x))
       (waddle (lambda (l)
                 (cond ((null? l) (quote ()))
                       ((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 (lambda (x) x)))
    (lambda (l)
      (let ((fst (let/cc here
                   (set! leave here)
                   (waddle l)
                   (leave (quote ())))))
        (if (atom? fst) (T? fst) #f)))))

本には(get-next 0)というのが1箇所だけ出てきますがなんですかね
たぶん書き間違いじゃないかと

さてこれって継続使わなかったらどう書けばいいんでしょうか
考えてみます

あれ?
なんか難しい?

...

骨組みはこんな感じでしょうね

(define two-in-a-row*?
  (lambda (l)
    (letrec ((T (lambda (l)
                  (cond ((null? l) #f)
                        ((atom? (car l))
                         ...
                         (T (cdr l)))
                        (else
                         (or (T (car l)) (T (cdr l)))))))
             (T l)))))

あとは、直前の値さえ覚えておいて比較すればいいはず
set!を使うのであれば

(define two-in-a-row*?
  (lambda (l)
    (let ((prv (quote ())))
      (letrec ((T (lambda (l)
                    (cond ((null? l) #f)
                          ((atom? (car l))
                           (cond ((eq? (car l) prv) #t)
                                 (else
                                  (set! prv (car l))
                                  (T (cdr l)))))
                          (else
                           (or (T (car l)) (T (cdr l))))))))
        (T l)))))

これでとりあえず動かすことはできます

難しい?と思ったのは
set!も使わないで書こうとするとどうなるかって話
イミュータブルとか関数型プログラミングとか言われてるご時世ですから

直前の値を引数に入れて渡してやれば、と思ったんですが
(T (car l))の最後に見つけた値を
(T (cdr l))に渡してあげる簡単な方法が思いつきません

関数がふたつの値を返せればいいのかな
第10の戒律は「同時に2つ以上の値を集めるには関数を作るべし」でした
これってけっきょく収集子を作るって話だったと思うんですけどそれじゃ同じ話になっちゃうし
まあリストを返せばいいか(リストを返しても同じ話かも)

(define pair
  (lambda (a b)
    (cons a (cons b (quote ())))))
(define val car)
(define prv cadr)

(define two-in-a-row*?
  (lambda (l)
    (letrec ((T (lambda (p l)
                  (cond ((null? l) (pair #f (quote())))
                        ((atom? (car l))
                         (cond ((eq? (car l) p) (pair #t (quote ())))
                               (else (T (car l) (cdr l)))))
                        (else (let ((vp (T p (car l))))
                                (cond ((val vp) (pair #t (quote ())))
                                      (else (T (prv vp) (cdr l))))))))))
      (val (T (quote ()) l)))))

悪くはないんですけどなんかごちゃごちゃしてる感じがしますね
ふたつの値を返すあたりの構文しだいかもしれませんが

リストを渡り歩くという樹状の構造と、アトムを先頭から順番に探してくるという線形の構造が
いっしょくたになっているのがいけないように思います
つまり、やっぱりget-firstとget-nextがほしいってことかなあ
イミュータブルな世界だったらどうやって作るんだろう

といったところで、以前「そこまですんのかHaskell」と思ったことがあるのを思い出しました
たしか、木の中を渡り歩くために今いるところの左側と右側の木を
常に覚えているみたいな感じ
この関数では戻る必要が無いので右側だけ覚えておけばよさそうです
つまり、先頭のアトムと、先頭のアトムよりも右側の木を返して
次はその返されたリストを渡してやれば次のアトムが取れると
なんていうか力技ですね

とにかく書いてみましたがあんまりわかりやすくはないです
Haskellのライブラリではもっとスマートに書いてあるんじゃないでしょうか

(define 1st car)
(define rest cadr)

(define 1st-and-rest
  (lambda (l)
    (cond ((null? l) (pair (quote ()) (quote())))
          ((atom? (car l)) (pair (car l) (cdr l)))
          (else (let ((a1r (1st-and-rest (car l))))
                  (let ((a1 (1st a1r))
                        (ar (rest a1r)))
                    (cond ((null? a1) (1st-and-rest (cdr l)))
                          (else (pair a1 (cons ar (cdr l)))))))))))

とりあえず動いている模様ではあります
カバー率?知りません

ということはtwo-in-a-row*?はすぐ書けますね
値の受け取り方にちょっと注意して

(define two-in-a-row*?
  (lambda (l)
    (letrec ((T (lambda (p l)
                  (let ((1r (1st-and-rest l)))
                    (cond ((null? (1st 1r)) #f)
                          ((eq? (1st 1r) p) #t)
                          (else (T (1st 1r) (rest 1r))))))))
      (T (quote ()) l))))

構造を分けることはできましたけどよくなったのかというと微妙な気分
もし仕事で書くとしたらどれで書くかなあ
普通にset!で前回の値を覚えてそうな気がします