takatoh's blog – Learning programming languages.
Scheme には左から畳み込む関数が2つある。fold と fold-left だ。違いは引数の関数に渡される引数の順序。次の例がわかり易い。
gosh> (fold list 0 '(1 2 3 4 5)) (5 (4 (3 (2 (1 0)))))
gosh> (fold-left list 0 '(1 2 3 4 5)) (((((0 1) 2) 3) 4) 5)
Haskell の foldl にあたるのが fold-left だな。
fold を使うと昨日書いた reverse がもっと簡単になる。
gosh> (define reverse
(lambda (lis)
(fold cons '() lis)))
reverse
gosh> (reverse '(1 2 3 4))
(4 3 2 1)
fold-right は右から畳み込む。
gosh> (fold-right list 0 '(1 2 3 4 5)) (1 (2 (3 (4 (5 0)))))
これも東大の Scheme演習のページから。
cf. Scheme演習 第３回
の問2。
リストlistの要素一つ一つに対して一引数関数procを適用し、結果をリストにして返す関数。
実行例> (map (lambda (x) (+ x 1)) (list 1 2 3 4)) (2 3 4 5)
(define map
(lambda (proc lis)
(if (null? lis)
(quote ())
(cons (proc (car lis)) (map proc (cdr lis))))))
(print (map (lambda (x) (+ x 1)) (list 1 2 3 4)))
^o^ > gosh map.scm (2 3 4 5)
数のリストlistの要素の平方の和を返す関数。
実行例> (add-squares (list 1 10 100)) 10101
(define add-squares
(lambda (lis)
(if (null? lis)
0
(+ (* (car lis) (car lis)) (add-squares (cdr lis))))))
(print (add-squares (list 1 10 100)))
cond じゃなくて if を使ってみた。
^o^ > gosh add-squares.scm 10101
リストlistを逆順にしたリストを返す関数。
実行例> (reverse (list 1 2 3 4)) (4 3 2 1)
(define reverse
(lambda (lis)
(define rev
(lambda (l1 l2)
(if (null? l1)
l2
(rev (cdr l1) (cons (car l1) l2)))))
(rev lis (quote ()))))
(print (reverse (list 1 2 3 4)))
^o^ > gosh reverse.scm (4 3 2 1)
ペアやリストを直接の要素とするリスト（連想リストという）alistを受け取り、その要素のうちcar部がobjと等しいような最左のものを返す関数
（ここで等しいとは、eq?による比較）
見つからない場合は#fを返す。> (define dic '((ami net) (ame rain) (ame candy))) > (assq 'ame dic) (ame rain) > (assq 'amedama dic) #f
(define assq
(lambda (obj alist)
(cond
((null? alist) #f)
((eq? (car (car alist)) obj) (car alist))
(else (assq obj (cdr alist))))))
(define dic '((ami net) (ame rain) (ame candy)))
(print (assq 'ame dic))
(print (assq 'amedama dic))
^o^ > gosh assq.scm (ame rain) #f
「Scheme手習い」10章に入る前に、少し離れて東大のScheme演習から。
cf. Scheme演習 第２回
次のような新しい if 文を関数として定義した。
(define (new-if test then-exp else-exp) (cond (test then-exp) (else else-exp)))例えば、(new-if (= 1 2) (+ 3 4) (+ 5 6)) などとすれば、正しく 11 を返す。（確かめてみよ。）
これを使って、fac4 を次のように定義した。
(define (fac4 n) (new-if (= n 0) 1 (* n (fac4 (- n 1)))))これを使って (fac4 3) としたら、無限ループにおちいってしまった。（確かめてみよ。）これはなぜか。
まずは前半がちゃんと動くのかを確かめてみよう。
gosh> (define (new-if test then-exp else-exp)
(cond (test then-exp)
(else else-exp)))
new-if
gosh> (new-if (= 1 2) (+ 3 4) (+ 5 6))
11
うん、動いてるね。
つぎは後半だ。本当に無限ループに陥るのか確かめてみよう。
gosh> (define (fac4 n)
(new-if (= n 0)
1
(* n (fac4 (- n 1)))))
fac4
gosh> (fac4 3)
out of memory (32). aborting...
うーん、無限ループなのかどうかはよくわからないけど、時間がかかった上にメモリが足りなくなって Gauche ごと落ちてしまった。とにかく、期待どおりに動かないのは確かなようだ。
で、なぜかといえば、if文が特殊形式（東大のScheme演習のページではシンタックス形式、Gauceh のユーザマニュアルでは Special Form と呼んでいる）なのにたいして、new-if は単なる関数適用だ。Scheme は正格評価なので、(new-if ...) の値を決める前に、その引数である (= n 0)、1、(* n (fac4 (- n 1))) のすべてを評価する。言い換えると (fac4 3) を評価する前に (fac4 2) を評価する必要があるわけだ。同様に、(fac4 2) の前に (fac4 1) を、(fac4 1) の前に (fac4 0)を、さらに (fac4 0) の前には (fac4 -1) を･･････といった具合で永遠に続くことになる。これが無限ループの正体だ。
関数 f(x) の導関数 f'(x) は、小さい数 dx を使って近似的に下のように表せる。
[math]f'(x)=\frac{f(x+dx)-f(x)}{dx}[/math]
1 引数関数 f と小さい数 dx を受けとったら、その導関数を返すような関数 deriv を作れ。すなわち、((deriv f dx) n) のように実行すると、結果として f'(n) の値を返す。
> (define (f1 x) (* x x)) > ((deriv f1 0.001) 5) 10.001000000002591
これは簡単。
(define deriv
(lambda (f dx)
(lambda (x)
(/ (- (f (+ x dx)) (f x)) dx))))
(define f1
(lambda (x) (* x x)))
(print ((deriv f1 0.001) 5))
^o^ > gosh deriv.scm 10.001000000002591
OK。つぎ、問3の後半部分。
Newton 法を使って、1 引数の関数 f が与えられた時にf(x) = 0 の実数解を１つ求めるプログラムを作れ。精度は、f(x) と 0 の差の絶対値が 0.001 以下とする。
- 用いる dx は0.001とする。
- 実際に、f(x) = x2 – 4 やその他の関数に対して適用してみよ。
これにはヒントが与えられている。
おさらいとヒント
一般の関数に対する Newton 法は、関数 f(x) とその導関数 f'(x) が与えられたとき、その零点の近似値を次の式で更新していく。
[math]a_{n+1}=a_n-\frac{f(a_n)}{f'(a_n)}[/math]
従って、f(an) と 0 との誤差が 0.001 以下になるまで、順に an を求めていく補助再帰関数を定義し、適当な初期値をその補助関数に与えてやればよい。
これでどうだ。
(define deriv
(lambda (f dx)
(lambda (x)
(/ (- (f (+ x dx)) (f x)) dx))))
(define newton
(lambda (f init)
(if (< (abs (- (f init) 0)) 0.001)
init
(newton f (- init (/ (f init) ((deriv f 0.001) init)))))))
(define f
(lambda (x)
(- (* x x) 4)))
(print (newton f 1.0))
^o^ > gosh newton.scm 2.0000002513546535
まあ、うまくいってるかな。
引き続き「Scheme手習い」の9章。またもや問答についていけなくなった。pp.162-175だ。
関数 length の話から始まって、(define ...) を使わずに length を実現する話をとおり、最後は「適用順Yコンビネータ」とやらに行き着く。
特にわからなくなるのは、p.168の次の問答以降：
どんな関数が mk-length に渡されるのか誰も気にしないので、最初に mk-length を渡すこともできますね。
良い考えです。そうすれば、eternity に対して mk-length を適用した結果を cdr に対して適用することで、連鎖をもう一段先に進めることができます。
ここから先ははっきり言ってさっぱりわからん。9章でわからなくなっていたら最後の10章はどうなるんだろう。
･･････表紙の折り返しに次のように書いてあるのに気がついた。
ある章が完全には理解できなければ、次の章はもっと理解できなくなる。
やれやれ。
今日は「Scheme手習い」の9章に戻ろう。
will-stop? という関数が出てきた。この関数は、ある関数 f がすべての引数に対して値を返すかどうかを教えてくれる（はず）の関数だ。概略はこんな感じ。
(define will-stop?
(lambda (f)
...))
f が値を返すなら、(will-stop? f) は #t を返し、そうでなければ #f を返す。will-stop?は全関数のはずだ。
じゃあ簡単なところで、引数が空リストの場合について、例を挙げてみてみよう。
まず、f が length のとき、(length (quote())) は0になる。ということは (will-stop? length) は #t を返すはずだ。
つぎに、f が eternity のときはどうだろう。eternity はこんな関数だった。
(define eternity
(lambda (x)
(eternity x)))
eternity はどんな引数に対しても値を返さない。もちろん空リストに対してもだ。ということは (will-stop? eternity) は #f を返すことになる。
さて、3つ目の例はすごく興味深い。
(define last-try
(lambda (x)
(and (will-stop? last-try)
(eternity x))))
この関数に対して (will-stop? last-try) は #t を返すだろうか、それとも #f を返すだろうか。
last-try の引数が空リストのとき、つまり (last-try (quote ())) の値は、(will-sto? last-try) の値に依存する。なぜなら (and …) は1つ目のS式の値が #f なら２つ目以降は評価しないからだ。そして1つ目のS式、つまり (will-sto? last-try) の値は #t か #f のどっちかしかありえない。
そこで、まずは (will-stop? last-try) の値が #f だと仮定してみよう。すると (and #f ...) は常に #f なので、(and #f (eternity (quote()))) の値は #f だということになり、(last-try (quote ())) は停止する。これは、(will-stop? last-try) を #f と仮定したことと矛盾する。
じゃあ、#t と仮定したらどうだろう。すると今度は (eternity (quote ())) の値に依存することになり、停止しない。つまり (will-stop? last-try) は #f のはずで、#t と仮定したことと矛盾してしまう。
結局これはどういうことかというと、ある関数 f が停止するかどうかを判定してくれるはずの will-stop? は実は定義できない、ってことだ。
問答では、「ありがとう Alan M. Turing (1912～1954) と Kurt Godel (1906～1978)」と書いてある。
これも東大の Scheme演習のページから。
cf. Scheme演習 第２回
フィボナッチ関数の定義（fib(0)=0、fib(1)=1 …）が載っていて、
この定義をそのまま使って関数 (fib1 n) を作れ。
(define fib1
(lambda (n)
(cond
((= n 0) 0)
((= n 1) 1)
(else (+ (fib1 (- n 1)) (fib1 (- n 2)))))))
gosh> (load "fib1") #t gosh> (fib1 30) 832040 gosh> (fib1 40) 102334155
末尾再帰を使って、n に対して線形の時間で求める関数 (fib2 n) を作れ。その際、ブロック構造を用いて、トップレベルに定義する関数は fib2 のみとせよ。
(define fib2
(lambda (n)
(define fib-iter
(lambda (m a b)
(if (zero? m)
a
(fib-iter (- m 1) b (+ a b)))))
(fib-iter n 0 1)))
gosh> (load "fib2") #t gosh> (fib2 40) 102334155
ふたつのプログラムを同じ引数で実行してみて、時間を比較せよ。さらにその時間の違いの理由について考察せよ。
厳密には時間を計っていないけど、引数が 40 の場合 fib1 は数十秒かかるのに対して、fib2 は一瞬で結果が得られる。理由は簡単、fib1 では再帰のたびに同じ引数に対する計算を何度も行っているのに対して、fib2 では同じ引数に対する計算は1度ですんでいるから。
「Scheme手習い」9章は問答についていくのが大変なので、今日はちょっとそこから離れて関数の練習。
東大のScheme演習のページから。
cf. Scheme演習 第１回
問２
5つの整数を引数として受け取り、そのうち偶数が奇数より多い場合は #t を返し、奇数が偶数より多い場合は #f を返す述語 even>odd? を定義せよ。当然、いろいろな定義の仕方がある。
いろいろな定義の仕方がある、っていうんだから3つくらいは挙げなきゃな。
最初に思いついたのがこれ。
(define even>odd?
(lambda (a b c d e)
(> (length (filter even? (list a b c d e))) 2)))
(print (even>odd? 1 2 3 4 5))
(print (even>odd? 2 -3 4 5 -6))
^o^ > gosh even_gt_odd1.scm #f #t
次にこれ。上のやつの (length (filter even? ...)) の代わりに再帰関数で偶数の数を数えている。
(define even>odd?
(lambda (a b c d e)
(define evens
(lambda (lis)
(cond
((null? lis) 0)
((even? (car lis)) (+ 1 (evens (cdr lis))))
(else (evens (cdr lis))))))
(> (evens (list a b c d e)) 2)))
(print (even>odd? 1 2 3 4 5))
(print (even>odd? 2 -3 4 5 -6))
^o^ > gosh even_gt_odd2.scm #f #t
3つ目、前に作った evens-and-odds を使う。
(define even>odd?
(lambda (a b c d e)
(define evens-and-odds
(lambda (lis co)
(cond
((null? lis) (co '() '()))
((even? (car lis))
(evens-and-odds (cdr lis) (lambda (e o) (co (cons (car lis) e) o))))
(else
(evens-and-odds (cdr lis) (lambda (e o) (co e (cons (car lis) o))))))))
(define friend
(lambda (e o)
(> (length e) (length o))))
(evens-and-odds (list a b c d e) friend)))
(print (even>odd? 1 2 3 4 5))
(print (even>odd? 2 -3 4 5 -6))
^o^ > gosh even_gt_odd3.scm #f #t
今度はアッカーマン関数だ。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 は引数によっては停止しない部分関数ということになる。