月: 2014年1月

eqlist?

eqlist? はS式のリスト l1 と l2 が等しければ #t を返し、そうでなければ #f を返す。
今度はちょっと、いやだいぶややこしい。少しずついこう。
まず、本文で質問が9つあるといっているのは、l1、l2 とも次の3つの状態が考えられて、その組み合わせが9つある、ということだ。

• 空リスト
• アトムがリストに cons されたもの
• リストが別のリストに cons されたもの

これにしたがってスクリプトを書く（というか写経する）と：

(use mymodule)

(define eqlist?
  (lambda (l1 l2)
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((and (null? l1) (atom? (car l2))) #f)
      ((null? l1) #f)
      ((and (atom? (car l1)) (null? l2)) #f)
      ((and (atom? (car l1)) (atom? (car l2)))
      (and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))))
      ((atom? (car l1)) #f)
      ((null? l2) #f)
      ((atom? (car l2)) #f)
      (else
        (and (eqlist? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2)))))))

(print (eqlist? '(strawberry ice cream) '(strawberry cream ice)))
(print (eqlist? '(banana ((split))) '((banana) (split))))
(print (eqlist? '(beef ((sausage)) (and (soda))) '(beef ((sausage)) (and (soda)))))

ファイル名は eqlist.scm とした。
9つの条件をひとつずつ cond の質問に置き換えている。最初の3つの質問（1～3番目）は l1 が空リストの場合、次の3つの質問（4～6番目）が l1 がアトムがリストに cons されたものの場合、else を含む最後の3つの質問（7～9番目）が l1 がリストが別のリストに cons された場合だ。

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

ここまではOK、難しくない。ところがこのあとの本文のやり取りはちょっと腑に落ちない。p.94には「式 (and (null? l1) (null? l2) と (or (null? l1) (null? l2)) が、最初の3つの場合にきちんと答を出すという意味ですか。」「はい。」とある。腑に落ちないのは「最初の3つの場合」の部分だ。これは質問の1~3をさしているのだろけど、この3つは l1 が空リストの場合だ。だけど、(or (null? l1) (null? l2)) は l1 が空リストじゃなくても l2 が空リストなら真となる。つまり、この部分は質問の2～3だけじゃなくて、質問4（(and (atom? (car l1)) (null? l2))）と質問7（(null? l2)）も含んでいるわけだ。そしてそのすべての場合に #f になる。これで l1 か l2 と少なくとも一方が空リストの場合を網羅したことになる。

ここで、書き直した eqlist? が出てくる（p.94）。ファイル名は eqlist2.scm としよう。

(use mymodule)

(define eqlist?
  (lambda (l1 l2)
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((or (null? l1) (null? l2)) #f)
      ((and (atom? (car l1)) (atom? (car l2)))
        (and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))))
      ((or (atom? (car l1)) (atom? (car l2))) #f)
      (else
        (and (eqlist? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2)))))))

(print (eqlist? '(strawberry ice cream) '(strawberry cream ice)))
(print (eqlist? '(banana ((split))) '((banana) (split))))
(print (eqlist? '(beef ((sausage)) (and (soda))) '(beef ((sausage)) (and (soda)))))

見るとわかるように最初の eqlist? では9つあった質問が5つになっている。
もう一点、or を使った質問が2つある。1つ目は上に書いたとおり、l1 と l2 のどちらか一方だけが空リストの場合、2つ目の or は (car l1) と (car l2) のどちらか一方だけがアトムの場合だ。これは最初の eqlist? の質問6と8に相当する。
1つ目の or で質問が3つ、2つ目の or で質問が1つ減って、質問は9つから5つになったわけだな。
正しく動くか試してみよう。

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

OKのようだ。

equal?

equal? はアトムかリスト（すなわちS式）2つを引数にとって、等しければ #t、そうでなければ #f を返す。

(use mymodule)

(define equal?
  (lambda (s1 s2)
    (cond
      ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
      ((atom? s1) #f)
      ((atom? s2) #f)
      (else (eqlist? s1 s2)))))

ここで、2番目と3番目の質問は冗長だ。1番目の質問が真にならなければ、s1 と s2 のどちらかはアトムではないのがわかっているんだから、2つをまとめて (or …) とできる。

(use mymodule)

(define equal?
  (lambda (s1 s2)
    (cond
      ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
      ((or (atom? s1) (atom? s2)) #f)
      (else (eqlist? s1 s2)))))

もう一度、eqlist?

equal? があれば eqlist? をもっと簡単にできる。equal? は引数がアトムかリストかを気にせずに比較できるのだから、eqlist2.scm の9～11行目を省略できるわけだ。equal? を使って書き直した eqlist? は次のようになる（ファイル名は eqlist3.scm）。

(use mymodule)

(define equal?
  (lambda (s1 s2)
    (cond
      ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
      ((or (atom? s1) (atom? s2)) #f)
      (else (eqlist? s1 s2)))))

(define eqlist?
  (lambda (l1 l2)
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((or (null? l1) (null? l2)) #f)
      (else
        (and (equal? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2)))))))

(print (eqlist? '(strawberry ice cream) '(strawberry cream ice)))
(print (eqlist? '(banana ((split))) '((banana) (split))))
(print (eqlist? '(beef ((sausage)) (and (soda))) '(beef ((sausage)) (and (soda)))))

うまく動くか試してみよう。

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

大丈夫のようだ。

第6の戒律
関数が正しいときのみ簡単化せよ。

leftmost は空リストを含まない空リストの中で最も左にあるアトムを返す。
この関数は今までの関数とはちょっと違う。最も左のアトムを返すのだから (car l) でだけ再帰する。もう一つ、「空リストを含まない空リスト」という条件がついているから、必ずアトムが見つかるはず、言い換えると atom? が最終条件となる。
それじゃ書いてみよう。

(use mymodule)

(define leftmost
  (lambda (l)
    (cond
      ((atom? (car l)) (car l))
      (else (leftmost (car l))))))

(print (leftmost '((potato) (chips ((with) fish) (chips)))))
(print (leftmost '(((hot) (tuna (and))) cheese)))

実行：

^o^ > gosh -I. leftmost.scm
potato
hot

どんどんいこう。

occure*

occure* はS式のリスト l の中にアトム a がいくつあるかを返す。

(use mymodule)

(define occur*
  (lambda (a l)
    (cond
      ((null? l) 0)
      ((atom? (car l))
        (cond
          ((eqan? (car l) a) (add1 (occur* a (cdr l))))
          (else (occur* a (cdr l)))))
      (else (o+ (occur* a (car l)) (occur* a (cdr l)))))))

(print (occur* 'banana
               '((banana)
               (split ((((banana ice)))
               (cream (banana))
               sherbe))
  (banana)
  (bread)
  (banana brandy))))

^o^ > gosh -I. occur_star.scm
5

subst*

subst* は、S式のリスト l の中のアトム old すべてを new に置き換える。

(use mymodule)

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

(print (subst* 'orange
               'banana
               '((banana)
                 (split ((((banana ice)))
                 (ceam (banana))
                 sherbet))
  (banana)
  (bread)
  (banana brandy))))

^o^ > gosh -I. subst_star.scm
((orange) (split ((((orange ice))) (ceam (orange)) sherbet)) (orange) (bread) (o
range brandy))

insertL*

insertL* はS式のリストの中のアトム old すべての左に new を挿入する。

(use mymodule)

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

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

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

member*

member* は、S式のリストの中にアトム a があれば #t を返し、そうでなければ #f を返す。

(use mymodule)

(define member*
  (lambda (a l)
    (cond
      ((null? l) #f)
      ((atom? (car l))
      (cond
        ((eqan? (car l) a) #t)
        (else (member* a (cdr l)))))
      (else (or (member* a (car l)) (member* a (cdr l)))))))

(print (member* 'chips '((potato) (chips ((with) fish) (chips)))))

^o^ > gosh -I. member_star.scm
#t

ここからは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 でもそうか。