カテゴリー: Scheme

ここからは5章だ。
課題に入る前に、昨日作った o^、o/、eqan? を mymodule.scm に加えておこう。

rember*

rember* はアトム a とリスト l を引数に取り、l からすべての a を取り除いたリストを返す。これまでと違うのは、l が単純なリスト（ラットやタップ）じゃなくて、リストやリストのリストを含んだ、S式のリストだってことだ。
たとえば、(rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup)) は ((coffee) ((tea)) (and (hick))) になる。

(use mymodule)

(define rember*
  (lambda (a l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
        (cond
          ((eqan? (car l) a) (rember* a (cdr l)))
          (else (cons (car l) (rember* a (cdr l))))))
      (else (cons (rember* a (car l)) (rember* a (cdr l)))))))

(print (rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup)))

実行：

^o^ > gosh -I. rember_star.scm
((coffee) ((tea)) (and (hick)))

insertR*

insertR* は、rember* と同じくS式のリスト l のなかのアトム old すべての右側に new を挿入する。

(use mymodule)

(define insertR*
  (lambda (new old l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
        (cond
          ((eqan? (car l) old) (cons old (cons new (insertR* new old (cdr l)))))
          (else (cons (car l) (insertR* new old (cdr l))))))
      (else
        (cons (insertR* new old (car l)) (insertR* new old (cdr l)))))))

(print (insertR* 'roast 'chuck
                 '((hew much (wood))
                 could
                 ((a (wood) chuck))
                 (((chuck)))
  (if (a) ((wood chuck)))
    could chuck wood)))

実行：

^o^ > gosh -I. insertR_star.scm
((hew much (wood)) could ((a (wood) chuck roast)) (((chuck roast))) (if (a) ((wo
od chuck roast))) could chuck roast wood)

こっちもうまく動いているようだ。

両方の関数に共通すること

二つある。一つは、（外側の）cond の質問が三つ、(null? l)、(atom? (car l))、else だということだ。これは l が空でなければ、(car l) がアトムかリストかの両方の可能性があるから、それをチェックするためだ。(car l) がアトムでなければ（つまり else のときは）リストだ。

第1の戒律
（最終版）
アトムのリスト lat を再帰せしときは、2つの質問、(null? lat) と else を行うべし。
数 n を再帰せしときは、2つの質問、(zero? n) と else を行うべし。
S式のリスト l を再帰せしときは、3つの質問、(null? l)、(atom? (car l))、else を行うべし。

もう一つの共通点は、(car l) がリストのとき、(car l) と (cdr l) の両方で再帰している点だ。これまでは (cdr l) 出だけ再帰していたけど、(car l) もリストなんだから再帰しなければいけないってことだな。

第4の戒律
（最終版）
再帰のときは少なくとも1つの引数を変えるべし。
アトムのリスト lat を再帰せしときは、(cdr lat) を用いるべし。
数 n を再帰せしときは、(sub1 n) を用いるべし。
S式のリスト l を再帰せしときは、(null? l) も (atom? (car l)) も真でないならば、(car l) と (cdr l) を用いるべし。
必ず最終条件に向かって変化すべし。
変化せし引数は、必ず最終条件でテストすべし。すなわち、cdr を用いるときは、最後に null? で、sub1 を用いるときは、最後に zero? でテストすべし。

one?

関数 one? は、引数が 1 のとき真、そうでないとき偽を返す。
こんなの簡単だ。

(use mymodule)

(define one?
  (lambda (n)
    (o= n 1)))

(print (one? 1))
(print (one? 10))

実行：

^o^ > gosh -I. one.scm
#t
#f

ほらできた。

ふたたび rempick

今度は、rempick を one? を使って書け、と。これも簡単、前の定義で (zero? (sub1 n)) としていたところを (one? n) にすればいいだけだ。

(use mymodule)

(define one?
  (lambda (n)
    (o= n 1)))

(define rempick
  (lambda (n lat)
    (cond
      ((one? n) (cdr lat))
      (else (cons (car lat) (rempick (sub1 n) (cdr lat)))))))

(print (rempick 3 '(lemon meringue salty pie)))

実行：

^o^ > gosh -I. rempick2.scm
(lemon meringue pie)

OK！
これで4章は終わり。

eqan?

関数 eqan? は2つの引数が同じアトムのとき真となる関数。数に対しては＝を、それ以外のアトムに対しては eq? を使って書け、と。

(use mymodule)

(define eqan?
  (lambda (a1 a2)
    (cond
      ((and (number? a1) (number? a2)) (o= a1 a2))
      ((or (number? a1) (number? a2)) #f)
      (else (eq? a1 a2)))))

(print (eqan? 3 3))
(print (eqan? 3 7))
(print (eqan? 'a 'b))
(print (eqan? 'tomato 'tomato))
(print (eqan? 1 'tomato))

実行：

^o^ > gosh -I. eqan.scm
#t
#f
#f
#t
#f

うまくいったようだ。

occur

関数 occur は lat の中にアトム a が何回現れたかを数える関数。

(use mymodule)

(define eqan?
  (lambda (a1 a2)
    (cond
      ((and (number? a1) (number? a2)) (o= a1 a2))
      ((or (number? a1) (number? a2)) #f)
      (else (eq? a1 a2)))))

(define occur
  (lambda (a lat)
    (cond
      ((null? lat) 0)
      ((eqan? (car lat) a) (add1 (occur a (cdr lat))))
      (else (occur a (cdr lat))))))

(print (occur 'cup '(coffee cup tea cup and hick cup)))

実行：

^o^ > gosh -I. occur.scm
3

こっちもうまくいった。
と思って答えを見たら、eqan? じゃなくて eq? を使ってるじゃないか。話の流れからして eqan? を使うんじゃないの？

number?

関数 number? は引数が数のアトムなら真で、そうでなければ偽になる。number? は Scheme では書くことができない基本関数だと紹介されている。実際、Gahche には組み込みで存在する。

gosh> (number? 5)
#t
gosh> (number? 'a)
#f

さて、今回の課題はここから。まずは no-nums。

no-nums

no-nums はラットからすべての数を取り除いたものを返す。

(define no-nums
  (lambda (lat)
    (cond
      ((null? lat) (quote ()))
      ((number? (car lat)) (no-nums (cdr lat)))
      (else (cons (car lat) (no-nums (cdr lat)))))))

(print (no-nums '(5 pears 6 prunes 9 dates)))

(number? (car lat)) が真なら (car lat) を cons せずに再帰し、そうでなければ cons して再帰している。ま、そんなに難しくない。
実行：

^o^ > gosh no-nums.scm
(pears prunes dates)

all-nums

all-nums は no-nums とは逆に、ラットからすべての数を取り出してタップを作る。
no-nums ができているんだから簡単。cons する条件を逆にするだけだ。

(define all-nums
  (lambda (lat)
    (cond
      ((null? lat) (quote ()))
      ((number? (car lat)) (cons (car lat) (all-nums (cdr lat))))
      (else (all-nums (cdr lat))))))

(print (all-nums '(5 pears 6 prunes 9 dates)))

実行：

^o^ > gosh all-nums.scm
(5 6 9)

length

length はラットの長さを数える関数。

(use mymodule)

(define length
  (lambda (lat)
    (cond
      ((null? lat) 0)
      (else (add1 (length (cdr lat)))))))

(print (length '(hotdogs with musrard sauerkraut and pickles)))
(print (length '(ham and cheese on rye)))

実行：

^o^ > gosh -I. length.scm
6
5

pick

pick はラットの中の n 番目のアトムを返す。

(use mymodule)

(define pick
  (lambda (n lat)
    (cond
      ((zero? (sub1 n)) (car lat))
      (else (pick (sub1 n) (cdr lat))))))

(print (pick 4 '(lasagna spaghetti ravioli macaroni meatball)))

(cdr lat) で再帰するときに、同時に (sub1 n) をすることで何番目かを数えている。終了条件が (zero? (sub1 n)) なのは、インデックスが1から始まると考えているからだろう。

実行：

^o^ > gosh -I. pick.scm
macaroni

rempick

rempick は n 番目のアトムを取り除いたラットを返す。

(use mymodule)

(define rempick
  (lambda (n lat)
    (cond
      ((zero? (sub1 n)) (cdr lat))
      (else (cons (car lat) (rempick (sub1 n) (cdr lat)))))))

(print (rempick 3 '(hotdogs with hot mustard)))

実行：

^o^ > gosh -I. rempick.scm
(hotdogs with mustard)

変な記号の関数もこれで最後だ。

↑

↑は累乗だ。o^と書こう。(o^ n m) は m が0になるまで1ずつ減らしながら n をかけていけばいい。

(use mymodule)

(define o^
  (lambda (n m)
    (cond
      ((zero? m) 1)
      (else (o* n (o^ n (sub1 m)))))))

(print (o^ 2 3))
(print (o^ 2 8))

実行：

^o^ > gosh -I. exp.scm
8
256

÷

次は割り算。o/ と書こう。これは関数の定義がさき出てきてしまうので素直に写経。

(use mymodule)

(define o/
  (lambda (n m)
    (cond
      ((o< n m) 0)
      (else (add1 (o/ (o- n m) m))))))

(print (o/ 9 3)) (print (o/ 10 3))

実行：

^o^ > gosh -I. quo.scm
3
3

今までの関数と違って、終了条件が zero? じゃない。この定義だとあまりは捨てられてしまう。ま、整数の割り算って、Ruby や Python でもそうか。

さて、本を読み進めるうちに書くコードも長くなってきた。たとえば前のエントリで書いた関数 o= は32行ある。だけど、本質的な部分はテスト用コードと空行を含めても11行だ。残りは、o= を作るための補助的というか基本的な関数のコードで占められている。こういうコードは冗長なだけでなく、コードを見難くする。

というわけで、基本的な関数はモジュールにして外に追いやりたいと思ったので、Gauche でのやり方を調べてみた。

　cf. 4.11 モジュール ― Gauche ユーザリファレンス
　cf. 3.1 Gaucheを起動する ― Gauche ユーザリファレンス

簡単な作り方と使い方をまとめると、次のようになる。

1. define-module を使ってモジュールを定義し、中に関数の定義を書く。
2. 上記の中で export-all を使って、定義した関数をエクスポートしておく。
3. 適当なファイル名で保存する。
4. モジュールを使う側のファイルで、(use モジュール名) とする。
5. gosh を起動するときに -I. オプションをつける。”.” はモジュールがカレントディレクトリにある場合。

で、今まで書いた基本的な関数をまとめたモジュールがこれ。モジュール名は mymodule とした。

(define-module mymodule

(define atom?
  (lambda (x)
    (and (not (pair? x)) (not (null? x)))))

(define lat?
  (lambda (l)
    (cond
      ((null? l) #t)
      ((atom? (car l)) (lat? (cdr l)))
      (else #f))))

(define add1
  (lambda (n)
    (+ n 1)))

(define sub1
  (lambda (n)
    (- n 1)))

(define o+
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (add1 (o+ n (sub1 m)))))))

(define o-
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (sub1 (o- n (sub1 m)))))))

(define o*
  (lambda (n m)
    (cond
      ((zero? m) 0)
      (else (o+ n (o* n (sub1 m)))))))

(define o>
  (lambda (n m)
    (cond
      ((zero? n) #f)
      ((zero? m) #t)
      (else (o> (sub1 n) (sub1 m))))))

(define o<
  (lambda (n m)
    (cond
      ((zero? m) #f)
      ((zero? n) #t)
      (else (o< (sub1 n) (sub1 m))))))

(define o=
  (lambda (n m)
    (cond
      ((o> n m) #f)
      ((o< n m) #f)
      (else #t))))

(export-all))

テスト用スクリプト：

(use mymodule)

(print (atom? 'a))
(print (lat? '(my name is takatoh)))
(print (lat? '(my name (is) takatoh)))
(print (o+ 2 5))
(print (o- 10 4))
(print (o* 3 3))
(print (o> 12 8))
(print (o< 7 10))
(print (o= 6 6))

試してみよう。

^o^ > gosh -I. test_mymodule.scm
#t
#t
#f
7
6
9
#t
#t
#t

うまくいってるようだ。
このモジュールは、スクリプトモードだけでなくインタラクティブモードでも使える。

^o^ > gosh -I.
gosh> (use mymodule)
#
gosh> (atom? 'a)
#t
gosh> (lat? '(hello scheme))
#t
gosh> (o= 3 7)
#f

＞

大小を判定する関数だ。o> と書くことにしよう。(o> n m) は n＞m のときに真を返す。
これはちょっと難しかった、というかややこしくて答を見てもすぐにはわからなかった。まあ、とにかく書いてみた。

(define sub1
  (lambda (n)
    (- n 1)))

(define o>
  (lambda (n m)
    (cond
      ((zero? n) #f)
      ((zero? m) #t)
      (else (o> (sub1 n) (sub1 m))))))

(print (o> 12 123))
(print (o> 12 1))
(print (o> 12 12))

ポイントは9-10行目の順番だ。最初、((zero? m) #t) を先に書いてしまったら、n と m が同じときにも #t になってしまった。n のほうが m よりも大きいときだけ真になってほしいのだから、n が先に 0 になってしまってはいけない。これをチェックするには、((zero? n) #f) を先に書くべきなんだ。

ということで、実行：

^o^ > gosh gt.scm
#f
#t
#f

無事、うまくいった。

＜

これは、o< と書くことにしよう。で、＞ができれば＜は簡単。n と m を入れ替えればいいだけだ。

(define sub1
  (lambda (n)
    (- n 1)))

(define o<
  (lambda (n m)
    (cond
      ((zero? m) #f)
      ((zero? n) #t)
      (else (o< (sub1 n) (sub1 m))))))

(print (o< 12 123))
(print (o< 12 1))
(print (o< 12 12)) 

実行：

^o^ > gosh lt.scm
#t
#f
#f

OK！

＝

＝は n と m が等しいとき真を返す。o= と書くことにしよう。

(define sub1
  (lambda (n)
    (- n 1)))

(define o>
  (lambda (n m)
    (cond
      ((zero? n) #f)
      ((zero? m) #t)
      (else (o> (sub1 n) (sub1 m))))))

(define o<
  (lambda (n m)
    (cond
      ((zero? m) #f)
      ((zero? n) #t)
      (else (o< (sub1 n) (sub1 m))))))

(define o=
  (lambda (n m)
    (cond
      ((o> n m) #f)
      ((o< n m) #f)
      (else #t))))

(print (o= 12 123))
(print (o= 12 1))
(print (o= 12 12))

実行：

^o^ > gosh equal.scm
#f
#f
#t

tup+ は2つのタップを引数に取り、それぞれの1番目同士、2番目同士･･･を足し合わせたタップを返す。タップというのは、数のリストのことだ。「数のリストのことをタップ（あるいはタプル）と呼びましょう」と書いてあるから、Scheme の用語というよりこの本（「Scheme手習い」）での用語と考えていいのかな。

同じ長さのタップの場合

とにかく書いてみよう。ただし、まずは2つのタップの長さは同じとする。

(define add1
  (lambda (n)
    (+ n 1)))

(define sub1
  (lambda (n)
    (- n 1)))

(define o+
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (add1 (o+ n (sub1 m)))))))

(define tup+
  (lambda (tup1 tup2)
    (cond
      ((null? tup1) (quote ()))
      (else (cons (o+ (car tup1) (car tup2)) (tup+ (cdr tup1) (cdr tup2)))))))

(print (tup+ '(1 2 3) '(4 5 6)))

実行：

^o^ > gosh tupplus.scm
(5 7 9)

うまくいったようだ。
でも、答えを見たら、cond のひとつ目の条件（21行目）が (and (null? tup1) (null? tup2)) になっていた。2つのタップの長さが同じという前提なんだから片方だけチェックすればいいと思うんだけどな。

違う長さのタップの場合

(define add1
  (lambda (n)
    (+ n 1)))

(define sub1
  (lambda (n)
    (- n 1)))

(define o+
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (add1 (o+ n (sub1 m)))))))

(define tup+
  (lambda (tup1 tup2)
    (cond
      ((null? tup1) tup2)
      ((null? tup2) tup1)
      (else (cons (o+ (car tup1) (car tup2)) (tup+ (cdr tup1) (cdr tup2)))))))

(print (tup+ '(1 2 3) '(10 20 30)))
(print (tup+ '(1 2 3) '(10 20 30 40 50)))
(print (tup+ '(1 2 3 4 5) '(10 20 30)))

実行：

^o^ > gosh tupplus2.scm
(11 22 33)
(11 22 33 40 50)
(11 22 33 4 5)

うまくいった。ポイントは21行目と22行目だ。tup1 と tup2 のどちらかが先に 空になったら、もう一方のタップを返して終了する。もちろん、両方が同時に空になった場合（つまり同じ長さの場合）には (null? tup1) の値 tup2 も空だから、これでうまくいくわけだ。

×は掛け算だ。o* と書くことにしよう。n×m を言い換えると、nをm回足したものということができる。だから o* を定義するには、m を0になるまで1ずつ減らしながら、nを足していけばいい。1ずつ減らしていくのは (sub1 m) で、最終条件は (zero? m) だ。

第4の戒律
（改訂版）
再帰の間は少なくとも1つの引数を常に変化させるべし。引数は終わりに向けて変化させることを要す。変化する引数は最終条件にてテストすべし。すなわち、cdr を用いるときは、null? で最終テストし、sub1 を用いるときは、zero? で最終テストせよ。

それじゃ、関数 o* を書いてみよう。

(define add1
  (lambda (n)
    (+ n 1)))

(define sub1
  (lambda (n)
    (- n 1)))

(define o+
  (lambda (n m)
    (cond
      ((zero? m) n)
      (else (add1 (o+ n (sub1 m)))))))

(define o*
  (lambda (n m)
    (cond
      ((zero? m) 0)
      (else (o+ n (o* n (sub1 m)))))))

(print (o* 2 3))
(print (o* 10 5))

実行：

^o^ > gosh mul.scm
6
50

21行目、(zero? m) のときの値が 0 なのは、0 が足し算の答に影響しないからだ。もし再帰に掛け算を使うとすれば、0 の換わりに 1 を使えばいい。

第5の戒律
＋で値を作らんとせしときは、行を終えるときに常に値として 0 を用うべし。なんとなれば、0 を加うるは加算の値を変えぬからなり。
×で値を作らんとせしときは、行を終えるときに常に値として 1 を用うべし。なんとなれば、1 を掛けるは乗算の値を変えぬからなり。
cons で値を作らんとせしときは、行を終えるときに常に値として () を考えるべし。