takatoh's blog – Learning programming languages.
今度はアッカーマン関数だ。Wikipedia の解説を読んでもよくわからないんだけど、引数が大きくなると爆発的に計算量が大きくなるらしい。
(use mymodule)
(define A
(lambda (n m)
(cond
((zero? n) (add1 m))
((zero? m) (A (sub1 n) 1))
(else (A (sub1 n) (A n (sub1 m)))))))
(print (A 1 0))
(print (A 1 1))
(print (A 2 2))
^o^ > gosh -I. A.scm 2 3 7
といっても、上の例ではすぐに計算が終わって値が返ってくる。ところが (A 4 3) を計算させてみたところ、一晩かかっても終わらなかった。問答では「現実的な問題として、答は得られないでしょう。」と書いてある。
それでもこれは全関数らしい。
こんな関数 C が出てきた。
(define C
(lambda (n)
(cond
((one? n) 1)
(else
((even? n) (C (o/ n 2)))
(else (C (add1 (o* 3 n))))))))
これはコラッツの問題だ。
問答の答には「0に対しては値を持ちませんが、それ以外の引数に対して全関数であるかどうかは誰も知りません。ありがとう、Lother Collatz（1910～1990）。」と書いてある。もしコラッツの予想が正しければ全関数だということになるけど、まだ証明されていない。Wikipedia によれば、3 × 2 の53乗までは反例がないことが確かめられているとのこと。
今度はわかるぞ。
shuffle は align と似ているけど、7章で出てきた revpair を使う。
(use mymodule)
(define revpair
(lambda (pair)
(build (second pair) (first pair))))
(define shuffle
(lambda (pora)
(cond
((atom? pora) pora)
((a-pair? (first pora)) (shuffle (revpair pora)))
(else (build (first pora) (shuffle (second pora)))))))
(print (shuffle '(a (b c))))
(print (shuffle '(a b)))
^o^ > gosh -I. shuffle.scm (a (b c)) (a b)
うまく動いているようだ。ということは全関数なんだろうか。
ここで、(shuffle '((a b) (c d))) の値を求めてみる。引数の第1要素がペアなので、cond の2番目に当たる。すると (shuffle (revpair '((a b) (c d)))) と再帰してこれは (shuffle '((c d) (a b))) に同じ。さらに進めるとまた cond の2番目にあたり、(shuffle (revpair '((c d) (a b)))) となり、これは (shuffle '((a b) (c d))) と同じになる。つまり、最初と同じになってしまう。
というわけで、shuffle は引数によっては停止しない部分関数ということになる。
うーん、問答についていけなくなった。
順を追っていこう。
まずは関数 shift。これは、ペアのペアを引数にとって、ペアの第1要素の第2要素を、ペアの第2要素に移し変える（ややこしいな）。
(use mymodule)
(define shift
(lambda (pair)
(build (first (first pair)) (build (second (first pair)) (second pair)))))
(print (shift '((a b) c)))
(print (shift '((a b) (c d))))
^o^ > gosh -I. shift.scm (a (b c)) (a (b (c d)))
うん、ここまではOK。
次、align。この関数は、
(use mymodule)
(define shift
(lambda (pair)
(build (first (first pair)) (build (second (first pair)) (second pair)))))
(define align
(lambda (para)
(cond
((atom? para) para)
((a-pair? (first para))
(align (shift para)))
(else
(build (first para) (align (second para)))))))
(print (align 'a))
(print (align '(a (b c d))))
(print (align '((a b) (c d))))
(print (align '((a b c) (d e f))))
^o^ > gosh -I. align.scm a (a (b c)) (a (b (c d))) ((a b c) (d e))
まだ大丈夫、これもわかる。
この align は前回のエントリに出てきた keep-looking と共通するところがあって、それはどちらの関数も引数を変更して再帰するけど、その変更によってゴールに近づいている保証がないことだそう。
ここで問答は aling の cond の2つ目の行に注目する。(arign (shift para)) というふうに再帰しているけど、その引数はもとの引数の一部ではなく、第7の戒律に反しているという。確かに shift はペアの要素を並べ替えるだけなので、一部ではない。言い換えると新たな引数にはもとの引数と同じ数のアトムが含まれている。
(use mymodule)
(define shift
(lambda (pair)
(build (first (first pair)) (build (second (first pair)) (second pair)))))
(define length*
(lambda (para)
(cond
((atom? para) 1)
(else (o+ (length* (first para)) (length* (second para)))))))
(print (length* '((a b) c)))
(print (length* (shift '((a b) c))))
^o^ > gosh -I. length_star.scm 3 3
まあ、確かめるまでもなく同じになる。
さて、わからなくなるのはここからだ。align を再帰する際に、ペアの第1要素はより簡単になっているけど第2要素はより複雑になっているという。確かに shift によってそうなっている。だけど、「引数の長さを決めるのに length* は間違った関数ではないでしょうか。」「もっとよい関数では、第1要素にもっと注意を払わなければいけません。」とはどういうことだろう。「少なくとも２ばいは必要です。」とは？
もっとよい関数として weight* が出てくる。
(use mymodule)
(define shift
(lambda (pair)
(build (first (first pair)) (build (second (first pair)) (second pair)))))
(define weight*
(lambda (pora)
(cond
((atom? pora) 1)
(else (o+ (o* (weight* (first pora)) 2) (weight* (second pora)))))))
(print (weight* '((a b) c)))
(print (weight* (shift '((a b) c))))
^o^ > gosh -I. weight_star.scm 7 5
weight* の動作自体はわかる。第1要素の数に2を書けることによって重み付けをしている。結果、shift するとアトムが第1要素から第2要素に移動する分だけ値が小さくなるわけだ。
で、これがなぜ次の問答につながるのかがわからない。
「align は部分関数ですか。」「いいえ。すべての引数に対して値を持ちます。」
うーん、誰か解説してほしい･･････
今日から9章。
次のような関数 looking が出てきた。
(use mymodule)
(define pick
(lambda (n lat)
(cond
((zero? (sub1 n)) (car lat))
(else (pick (sub1 n) (cdr lat))))))
(define keep-looking
(lambda (a sorn lat)
(cond
((number? sorn) (keep-looking a (pick sorn lat) lat))
(else (eq? sorn a)))))
(define looking
(lambda (a lat)
(keep-looking a (pick 1 lat) lat)))
(print (looking 'caviar '(6 2 4 caviar 5 7 3)))
(print (looking 'caviar '(6 2 grits caviar 5 7 3)))
この関数 looking は次のように動作する。まず、引数 lat の1番目の要素を見て、それが数 n なら今度はn番目の要素を見る。そしてそれが数ならまた同じように繰り返す。最終的に数でないアトムに行き当たったとき、それが引数 a と eq? なら #t、そうでないなら #f を返す。
実行してみよう。
^o^ > gosh -I. looking.scm #t #f
最初の例では、6 → 7 → 3 → 4 → caviar となって無事 caviar が見つかるので #t が返っている。一方、2つ目の例では、6 → 7 → 3 → grits となって caviar が見つからないので #f が返っている。
動作そのもの以外に注目するところがある。今まで出てきた関数はすべて lat の部分に対して再帰してきた。ところが looking は lat そのものに対して再帰している。これを不自然な再帰というらしい。
さて、この looking はどんなときにも答を返すだろうか。上の2つの例ではどちらも答が返っているが、たとえば、(looking 'caviar '(7 1 2 caviar 5 6 3)) がどうやって動くか見てみると、
7 → 3 → 2 → 1 → 7 → 3 → 2 → 1 → 7 → … となって数でないアトムにたどり着かない。言い換えると looking は停止しない。これはプログラムの停止性の問題だ。どうやら9章のテーマはこれらしい。
さて、この looking のような関数を「部分関数」、今まで出てきたような関数を「全関数」というらしい。
次に eternity という関数が出てきた。
(define eternity
(lambda (x)
(eternity x)))
この関数はどんな引数が与えられても停止しない。eternity は最も部分的な関数だと書いてある。
うーん、9章にはいって難しげになってきた。
8章では収集子関数といっていたけど、「継続（continuation）」というほうが一般的みたいだ。この、継続を関数として再帰するスタイルを「継続渡しスタイル（Continuation Passing Style、CPS）と呼ぶみたい。
で、簡単な例で練習。この関数 evens-and-odds は、与えられた数のリストから、偶数だけのリストと奇数だけのリストを作る。最後に friend がリストのペアにして返している。
(define evens-and-odds
(lambda (l co)
(cond
((null? l) (co (quote ()) (quote ())))
((even? (car l)) (evens-and-odds (cdr l)
(lambda (e o) (co (cons (car l) e) o))))
(else (evens-and-odds (cdr l) (lambda (e o) (co e (cons (car l) o))))))))
(define friend
(lambda (x y)
(cons x (cons y (quote ())))))
(print (evens-and-odds '(1 2 3 4 5 6 7 8 9 10) friend))
^o^ > gosh evens-and-odds.scm ((2 4 6 8 10) (1 3 5 7 9))
うん、うまくいった。
関数 evens-only* は入れ子になった数のリストからすべての奇数を削除する。「簡単な練習でしょう」なんて書いてあるので、今度も答を見ないで書いてみる。ちなみに、偶数であることを判定する even? の定義は質問の中で提示されている。
(use mymodule)
(define even?
(lambda (n)
(o= (o* (o/ n 2) 2) n)))
(define evens-only*
(lambda (l)
(cond
((null? l) (quote ()))
((atom? (car l))
(cond
((even? (car l)) (cons (car l) (evens-only* (cdr l))))
(else (evens-only* (cdr l)))))
(else
(cons (evens-only* (car l)) (evens-only* (cdr l)))))))
(print (evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2)))
^o^ > gosh -I. evens-only_star.scm ((2 8) 10 (() 6) 2)
うん、簡単。
こっちが本題。関数 evens-only*&co は、引数から奇数を削除して偶数だけの入れ子のリストを作る一方、同時に引数中の偶数の積と奇数の和を計算する関数。概要が示されているので、それをもとに書いてみよう･･････と思ったけど、最後の else の再帰をどうすればわからなくて、結局答を見て写経した。
(use mymodule)
(define even?
(lambda (n)
(o= (o* (o/ n 2) 2) n)))
(define evens-only*&co
(lambda (l col)
(cond
((null? l) (col (quote ()) 1 0))
((atom? (car l))
(cond
((even? (car l)) (evens-only*&co (cdr l)
(lambda (newl p s) (col (cons (car l) newl) (o* (car l) p) s))))
(else (evens-only*&co (cdr l)
(lambda (newl p s) (col newl p (o+ (car l) s)))))))
(else
(evens-only*&co (car l)
(lambda (al ap as)
(evens-only*&co (cdr l)
(lambda (dl dp ds)
(col (cons al dl) (o* ap dp) (o+ as ds))))))))))
(define the-last-friend
(lambda (newl product sum)
(cons sum (cons product newl))))
(print (evens-only*&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2) the-last-friend))
最後の else の再帰は、まず (car l) について evens-only*&co を再帰してその収集子の中でさらに (cdr l) について再帰している。(car l) についての収集子の引数 al、ap、ps は (car l) のなかの偶数のリスト、偶数の積、奇数の和。それから (cdr l) についての収集子の引数 dl、dp、ds は (cdr l) のなかの偶数のリスト、偶数の積、奇数の和だ。そして最後にリストは cons、積は o*、和は o+ をそれぞれ適用しているわけだ。ああ、なんてややこしいんだ。
実行結果：
^o^ > gosh -I. evens-only_star_and_co.scm (38 1920 (2 8) 10 (() 6) 2)
はあ、なんとかできた。
これで8章も終わり。
関数 multiinsertLR は lat の中の oldL の左と oldR の右に new を挿入する。
(define multiinsertLR
(lambda (new oldL oldR lat)
(cond
((null? lat) (quote ()))
((eq? (car lat) oldL)
(cons new (cons oldL (multiinsertLR new oldL oldR (cdr lat)))))
((eq? (car lat) oldR)
(cons oldR (cons new (multiinsertLR new oldL oldR (cdr lat)))))
(else
(cons (car lat) (multiinsertLR new oldL oldR (cdr lat)))))))
(print (multiinsertLR 'salty 'fish 'chips '(chips and fish or fish and chips)))
^o^ > gosh multiinsertLR.scm (chips salty and salty fish or salty fish and chips salty)
うん、うまくいってる。
さて、ここからが本題。multirember に対応する multirember&co のように、multiinsertLR に対応する multiinsertLR&co を書け、ときた。ようするに、引数を1つ多くとり、それは収集子（関数）だってことだ。で、multiinsertLR&co が実行されると、新たなラット、左挿入の回数、右挿入の回数を引数として収集子 col を呼び出す。
よし、挑戦してみよう。
(use mymodule)
(define multiinsertLR&co
(lambda (new oldL oldR lat col)
(cond
((null? lat) (col (quote ()) 0 0))
((eq? (car lat) oldL)
(multiinsertLR&co new oldL oldR (cdr lat)
(lambda (newlat l r) (col (cons new (cons oldL newlat)) (add1 l) r))))
((eq? (car lat) oldR)
(multiinsertLR&co new oldL oldR (cdr lat)
(lambda (newlat l r) (col (cons oldR (cons new newlat)) l (add1 r)))))
(else
(multiinsertLR&co new oldL oldR (cdr lat)
(lambda (newlat l r) (col (cons (car lat) newlat) l r)))))))
(define result
(lambda (lat l r)
(list lat l r)))
(print (multiinsertLR&co 'salty 'fish 'chips '(chips and fish or fish and chips) result))
今回、col の具体的な実装は出てこないので、収集した結果（新しいラット、左挿入の回数、右挿入の回数）をリストにして返す result を収集子にしてみた。
^o^ > gosh -I. multiinsertLR_and_co.scm ((chips salty and salty fish or salty fish and chips salty) 2 2)
うまくいった！
こんな関数が出てきた。
(define multirember&co
(lambda (a lat col)
(cond
((null? lat) (col (quote ()) (quote ())))
((eq? (car lat) a)
(multirember&co a (cdr lat)
(lambda (newlat seen) (col newlat (cons (car lat) seen)))))
(else
(multirember&co a (cdr lat)
(lambda (newlat seen) (col (cons (car lat) newlat) seen)))))))
これはかなり複雑だ。
基本的には multirember と同じような形をしているけど、引数がひとつ多い。 a はアトム、lat はラット、で、col は何かの関数らしい。
それから、(eq? (car lat) a) のときも else のときも (cdr lat) で再帰している。しかもそれぞれ新しい関数を作っている。
じっくりいこう。
col の簡単な例が出てきた。
(define a-friend
(lambda (x y)
(null? y)))
2つの引数をとり、1つ目は単に無視して2つ目が null? かどうかを返している。
で、この関数を使ってまずは簡単な例、(multirember&co 'tuna '() a-friend) の値を求めてみよう。この場合、lat が空リストなので、cond の最初の条件に当てはまる。ということはその値は (col (quote ()) (quote ())) で、いま col は a-friend なので値は #t になる。
次は、もうちょっと難しい例、(multirember&co 'tuna '(tuna) a-friend) の値を求めてみよう。今度は、(eq? (car lat) a) （ここで a は tuna、lat は (tuna)）なので、cond の2番目の値になる。そして (cdr lat) と新しい関数 (lambda (newlat seen) (col newlat (cons (car lat) seen))) に対して再帰している。この関数は multirember&co の引数 col に当たるもので、col とは collector （収集子）の短縮形だそうだ（収集子は「continuation（継続）」とも呼ばれる）。
この新しい関数（収集子）に名前をつけてやったほうがわかり易い。new-friend としよう。このとき col は a-friend、(car lat) は tuna なので、new-friend は次のようになる。
(define new-friend
(lambda (newlat seen)
(a-frined newlat (cons 'tuna seen))))
この関数を使って、multirember&co の再帰部分を書くと、(multirember&co 'tuna '() new-friend) となる。
そうすると今度は (null? lat) （ここで lat は ‘()）なので、値は (new-friend (quote ()) (quote ())) となり、new-friend の定義より (a-friend (quote ()) (cons 'tuna (quote ())))、つまり #f だ（2番目の引数が空リストじゃないから）。
さらに難しい例、(multirember&co 'tuna '(and tuna) a-friend) の値を求めてみよう。今度は、cond の3番目の条件に当てはまり、また別の収集子で再帰する。この収集子の名前を latest-friend とすれば次のようになる。
(define latest-friend
(lambda (newlat seen)
(a-friend (cons 'and newlat) seen))))
すると、再帰は (multirember&co 'tuna '(tuna) latest-friend) となり、cond の2番目の条件でさらに (multirember&co 'tuna '() (lambda (newlat seen) (latest-friend newlat (cons 'tuna seen)))) で再帰する。
最後は cond の最初の条件の値 ((lambda (newlat seen) (latest-friend newlat (cons 'tuna seen))) (quote ()) (quote ())) に行き当たる。
さあ、今度は逆にさかのぼろう。最後の関数適用の値は (latest-friend (quote ()) ‘(tuna)) だ。さらにさかのぼると (a-friend ‘(and) ‘(tuna)) となり、最終的な値は #f になる。
結局、(multirember&co a lat col) がどんな関数かというと、lat をすべて検索して、a と eq? であるアトムを最初のリスト l1 に、eq? でないアトムを2番目のリスト l2 に収集子、最後に (col l1 l2) の値を返す関数、ということができる。
試してみよう。
(define multirember&co
(lambda (a lat col)
(cond
((null? lat) (col (quote ()) (quote ())))
((eq? (car lat) a)
(multirember&co a (cdr lat)
(lambda (newlat seen) (col newlat (cons (car lat) seen)))))
(else
(multirember&co a (cdr lat)
(lambda (newlat seen) (col (cons (car lat) newlat) seen)))))))
(define a-friend
(lambda (x y)
(null? y)))
(print (multirember&co 'tuna '() a-friend))
(print (multirember&co 'tuna '(tuna) a-friend))
(print (multirember&co 'tuna '(and tuna) a-friend))
^o^ > gosh multirember_and_co.scm #t #f #f
OKのようだ。
最後に、次の関数 last-friend を col とした場合を求めてみよう。
(define multirember&co
(lambda (a lat col)
(cond
((null? lat) (col (quote ()) (quote ())))
((eq? (car lat) a)
(multirember&co a (cdr lat)
(lambda (newlat seen) (col newlat (cons (car lat) seen)))))
(else
(multirember&co a (cdr lat)
(lambda (newlat seen) (col (cons (car lat) newlat) seen)))))))
(define last-friend
(lambda (x y)
(length x)))
(print (multirember&co 'tuna '(strawberries tuna and swordfish) last-friend))
^o^ > gosh multirember_and_co2.scm 3
last-friend は tuna 以外のアトムを集めたリストの長さを求めている。だから答は3になるわけだ。
第10の戒律
同時に2つ以上の値を集める際には関数を作るべし。
multiremver の定義は次のとおりだった。
(define multirember
(lambda (a lat)
(cond
((null? lat) (quote ()))
((eq? (car lat) a) (multirember a (cdr lat)))
(else (cons (car lat) (multirember a (cdr lat)))))))
今度は multirember-f を書いてください、ときた。簡単だ。test? を引数にとって、上の定義の中の eq? を test? に、multirember を (multirember test?) に置き換えたものを返してやればいい。
(define multirember-f
(lambda (test?)
(lambda (a lat)
(cond
((null? lat) (quote ()))
((test? (car lat) a) ((multirember-f test?) a (cdr lat)))
(else (cons (car lat) ((multirember-f test?) a (cdr lat))))))))
(print ((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna)))
^o^ > gosh multirember-f.scm (shrimp salad salad and)
ここで eq?-c が再登場する。この関数はアトム a を引数にとって「アトム x を引数にとって a 比較する関数」を返す関数だった。x を tuna と比較する関数 eq?-tuna は次のように書ける。
(define eq?-tuna (eq?-c 'tuna))
さて、今度は、この eq?-tuna のような関数とラットを引数にとって multirember と同じように動作する multiremberT を書け、ときた。大丈夫、たぶん書けるだろう。
(define eq?-c
(lambda (a)
(lambda (x)
(eq? x a))))
(define eq?-tuna (eq?-c 'tuna))
(define multiremberT
(lambda (test? lat)
(cond
((null? lat) (quote ()))
((test? (car lat)) (multiremberT test? (cdr lat)))
(else (cons (car lat) (multiremberT test? (cdr lat)))))))
(print (multiremberT eq?-tuna '(shrimp salad tuna salad and tuna)))
実行結果：
^o^ > gosh multiremberT.scm (shrimp salad salad and)
よかった、OKのようだ。