S式を取り除くrember

5章もこれで最後だ。
つい先日、ラット lat の中からアトム a を取り除く関数 rember を書いた。今度は、この rember をS式のリスト l からS式 s を取り除くように書き直すと次のようになる。
(おっと、その前に equal? と eqlist? を mymodule.scm に加えておこう)

(use mymodule)

(define rember
  (lambda (s l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
      (cond
        ((equal? (car l) s) (cdr l))
        (else (cons (car l) (rember s (cdr l))))))
      (else
        (cond
          ((equal? (car l) s) (cdr l))
          (else (cons (car l) (rember s (cdr l)))))))))

(print (rember '(cup) '((coffee (cup)) tea (cup) and ((hick) cup))))
^o^ > gosh -I. rember2.scm
((coffee (cup)) tea and ((hick) cup))

これを簡単化せよ、と。まあ、難しくはない。equal? は任意のS式を比較できるんだから、(atom? (car l)) の条件は必要ない。というわけでこうなる。

(use mymodule)

(define rember
  (lambda (s l)
    (cond
      ((null? l) (quote ()))
      (else
        (cond
          ((equal? (car l) s) (cdr l))
          (else (cons (car l) (rember s (cdr l)))))))))

(print (rember '(cup) '((coffee (cup)) tea (cup) and ((hick) cup))))
^o^ > gosh -I. rember3.scm
((coffee (cup)) tea and ((hick) cup))

さて、まだ簡単化できる。cond が二重になっているのが冗長だから、ひとつにしてしまえばいい。

(use mymodule)

(define rember
  (lambda (s l)
    (cond
      ((null? l) (quote ()))
      ((equal? (car l) s) (cdr l))
      (else (cons (car l) (rember s (cdr l)))))))

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

だいぶ簡単になった。うまく動くか試してみよう。

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

OK!これで5章は終わり。

eqlist?

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

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

occur*、subst*、insertL*、member*

どんどんいこう。

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

rember*とinsertR*

ここからは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? でテストすべし。