2014年1月 – ページ 2 – blog.PanicBlanket.com

subst

リストの中の old を new に置き換える subst は次のような定義だった。

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

これもやっぱり、前回の insertL や insertR とよく似ている。違うのは cond の2行目、((eq? …) の行だけだ。というわけで、subst のための関数 seqS を作り、insert-g を使って subst を定義せよ、と。
こんなんでどうだ。（ちなみに insert-g の定義は本のとおり test? を引数にとらずに eq? を使うようにした）

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g seq) new old (cdr l))))))))

(define seqS
  (lambda (new old l)
    (cons new l)))

(define subst (insert-g seqS))

(print (subst 'topping 'fudge '(ice cream with fudge for dessert)))

^o^ > gosh subst2.scm
(ice cream with topping for dessert)

OKだ。

yyy

今度は次のような関数 yyy が出てきた。

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g seq) new old (cdr l))))))))

(define seqrem
  (lambda (new old l)
    l))

(define yyy
  (lambda (a l)
    ((insert-g seqrem) #f a l)))

(print (yyy 'sausage '(pizza with sausage and bacon)))

関数 yyy の定義で insert-g に渡している関数 seqrem は、new や old を cons せずに l だけを返している。ということは、(eq? (car l)) だったとき、new も old も cons されないわけで、つまり yyy は old を削除する関数 rember だってことだ。

^o^ > gosh yyy.scm
(pizza with and bacon)

本では、「#f はどんな役割を果たしていますか。」と書いてあるけど、#f は seqrem の引数 new に当たるので、関数の中では何の役目も果たしていない。実際、#f を #t やほかのアトムに変えても yyy の動作は変わらない。ただの数合わせのためだけにあるわけだ。

前回と今回のまとめ

前回と今回で insertL、insertR、subst、rember という4つの関数が、insert-g とそれぞれの補助関数で定義できることを見てきた。全体的によく似た関数は、同じ部分は共通の関数を使い、違う部分だけをそれぞれの補助関数にして定義できる。これが抽象化というものの力だそうだ。

第9の戒律
新しき関数においては共通のパターンを抽象化すべし。

insertL-f と insertR-f

rember を rember-f に変形したように、insertL を insertL-f に変形してください、ときた。といってもすぐに答が書いてあるので、ここは逆らわずに写経。

(define insertL-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (cons new (cons old (cdr l))))
        (else (cons (car l) ((insertL-f test?) new old (cdr l))))))))

同様に、insertR を insertR-f に。

(define insertR-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (cons old (cons new (cdr l))))
        (else (cons (car l) ((insertR-f test?) new old (cdr l))))))))

見比べればわかるように、insertL-f と insertR-f はよく似ている。実際、関数名を別にすれば違うのは6行目の new を old を cons する順番だけだ。
というわけで、次の課題はこの部分を関数として渡してやれるようにすることだ。

insert-g

まずは、上の6行目の部分だけを行う関数、seqL と seqR を書こう。といってもほとんど自明だ。

(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))

さあ、これで insert-g が書ける。全体を示そう。

(define insert-g
  (lambda (test? seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g test? seq) new old (cdr l))))))))

(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))

(define insertL (insert-g eq? seqL))

(define insertR (insert-g eq? seqR))

(print (insertL 'topping 'fudge '(ice cream with fudge for dessert)))
(print (insertR 'jalapeno 'and '(tacos tamales and salsa)))

実行結果：

^o^ > gosh insert-g.scm
(ice cream with topping fudge for dessert)
(tacos tamales and jalapeno salsa)

うまくいった！
と思って答を見たら、こんな定義になってるじゃないか。

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g seq) new old (cdr l))))))))

test? はどこへいったんだよ！
まあいい、このままいこう。最後に、seqL を使わずに insertL を定義してください、ときた。前のエントリで書いたように、lambda で作った関数には必ずしも名前をつけなくてもかまわない。ということは、seqL という関数名じゃなくてその定義を渡してやればいいわけだ。

(define insert-g
  (lambda (test? seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g test? seq) new old (cdr l))))))))

(define insertL
  (insert-g eq?
    (lambda (new old l)
      (cons new (cons old l)))))

(print (insertL 'topping 'fudge '(ice cream with fudge for dessert)))

^o^ > gosh insert-g2.scm
(ice cream with topping fudge for dessert)

OKのようだ。よかった。

関数を返す関数

前回のエントリでは関数を引数にとる関数が出てきたけど、今度は関数を返す関数（これも高階関数だ）が出てきた。

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))

この関数 eq?-c は a を引数にとり、「x を引数にとって a と比較する関数」を返す。
「これは『カリー化』（Curry-ing）と呼ばれています。」って、カリー化の説明これだけ？
カリー化とは、本来複数の引数を取る関数を引数の一部だけとって「残りの引数を取る関数」を返す関数に変更、というか変換すること、だと理解している。そう間違ってはいないはず。この例の場合では2引数の関数 eq? をカリー化した関数が eq?-c ってわけだ。

返ってくるのが関数だから、名前をつけてやれば普通の関数として使える。

gosh> (define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))
eq?-c
gosh> (define eq?-salad (eq?-c 'salad))
eq?-salad
gosh> (eq?-salad 'salad)
#t
gosh> (eq?-salad 'tuna)
#f

とはいえ、必要がなければ名前をつけてやることもない。こんなふうにも書ける。

gosh> ((eq?-c 'salad) 'salad)
#t

ふたたび rember-f

で、今度は、rember-f を比較関数 test? を引数にとって「a と l を引数にとる関数」を返す関数に書き直せ、ときた。うん、たぶん書けるだろう。

(define rember-f
  (lambda (test?)
    (lambda (a l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) a) (cdr l))
        (else (cons (car l) ((rember-f test?) a (cdr l))))))))

(print ((rember-f eq?) 'tuna '(shrimp salad and tuna salad)))

^o^ > gosh rember-f2.scm
(shrimp salad and salad)

うまくいった！

関数を引数にとる関数

今日から8章だ。
関数を引数にとる関数が出てきた（高階関数だ！）。rember-f は rember と同様に、リストからメンバーを削除するけど、削除するメンバーを探す（比較する）関数も引数として受け取る。たとえばリストが数のリストなら比較のために o= を、S式のリストなら equal? を引数として受け取るわけだ。
ちょっと難しいけど、うん、まあこのくらいなら書けそうだ。

(use mymodule)

(define rember-f
  (lambda (test? a l)
    (cond
      ((null? l) (quote ()))
      ((test? (car l) a) (cdr l))
      (else (cons (car l) (rember-f test? a (cdr l)))))))

(print (rember-f o= 5 '(6 2 5 3)))
(print (rember-f eq? 'jelly '(jelly beans are good)))
(print (rember-f equal? '(pop corn) '(lemonade (pop corn) and (cake))))

実行結果：

^o^ > gosh -I. rember-f.scm
(6 2 3)
(beans are good)
(lemonade and (cake))

うまくいった。

fullfun?またはone-to-one?

関数 fullfunn? （または one-to-one?）は、ファンが全単射、つまり各ペアの第2要素を集めたリストが集合になっているかどうかを判定する。
書いてみよう。

(use mymodule)

(define seconds
  (lambda (rel)
    (cond
      ((null? rel) (quote ()))
      (else (cons (second (car rel)) (seconds (cdr rel)))))))

(define fullfun?
  (lambda (fun)
    (set? (seconds fun))))

(print (fullfun? '((8 3) (4 8) (7 6) (6 2) (3 4))))
(print (fullfun? '((grape raisin) (plum prune) (stewed prune))))
(print (fullfun? '((grape raisin) (plum prune) (stewed grape))))

ここで、seconds という補助関数を作っている。seconds は各ペアの第2要素を集めたリストを作る。それが集合（セット）になっているかどうかを調べているわけだ。

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

うまくいったようだ。

ところで、one-to-one? は fullfun? の別名だ。全単射ということは一対一対応だということだからだろう。ここで、one-to-one? の別の定義は思いつけるかという質問が出てきた。ペアの第2要素が集合になっているなら、第1要素と第2要素を入れ替えた (revrel fun) はファンになっているはず。これを使うと次のようになる。

(use mymodule)

(define fun?
  (lambda (rel)
    (set? (firsts rel))))

(define revpair
  (lambda (pair)
    (build (second pair) (first pair))))

(define revrel
  (lambda (rel)
    (cond
      ((null? rel) (quote ()))
      (else (cons (revpair (car rel))
        (revrel (cdr rel)))))))

(define one-to-one?
  (lambda (fun)
    (fun? (revrel fun))))

(print (one-to-one? '((8 3) (4 8) (7 6) (6 2) (3 4))))
(print (one-to-one? '((grape raisin) (plum prune) (stewed prune))))
(print (one-to-one? '((grape raisin) (plum prune) (stewed grape))))

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

これで7章も終わり。

revrel

関数 revrel は、レルの各ペアの第1要素と第2要素を入れ替える関数。rev は reverse の略かな。
書いてみよう。

(use mymodule)

(define revrel
  (lambda (rel)
    (cond
      ((null? rel) (quote ()))
      (else (cons (build (second (car rel)) (first (car rel)))
        (revrel (cdr rel)))))))

(print (revrel '((8 a) (pumpkin pie) (got sick))))

前々回のエントリで作った、first、second、build を使っている。

実行：

^o^ > gosh -I. revrel.scm
((a 8) (pie pumpkin) (sick got))

ここで、ペアの2つの要素を交換する revpair 関数があったとして revrel を書くとどうなるか。こうなる。

(use mymodule)

(define revpair
  (lambda (pair)
    (build (second pair) (first pair))))

(define revrel
  (lambda (rel)
    (cond
      ((null? rel) (quote ()))
      (else (cons (revpair (car rel))
        (revrel (cdr rel)))))))

(print (revrel '((8 a) (pumpkin pie) (got sick))))

実行：

^o^ > gosh -I. revrel2.scm
((a 8) (pie pumpkin) (sick got))

当たり前だけど、書き直す前と同じ結果になった。

レルとファン

また新しい用語が出てきた。
レル（rel）というのは、ペアの集合（セット）らしい。レルの例：

((apples peaches) (pumpkin pie))
((4 3) (4 2) (7 6) (6 2) (3 4))

まあ、これはわかる。ファンのほうはよくわからない。「ここではファンは関数（function）を表すために使います。」といいながら、次の質問「(fun? rel) はなんですか。ここで rel は ((8 3) (4 2) (7 6) (6 3) (3 4)) です。」に対して「#tです。というのは (firsts rel) が集合だからです。」と答えている。どういうことさ。
まあいい。ファンは (firsts rel) が集合になるレルだと思っておこう。
で、fun? を set? と firsts を使って書け、と。（その前に set? と firsts を mymodule.scm に追加しておこう）

(use mymodule)

(define fun?
  (lambda (rel)
    (set? (firsts rel))))

(print (fun? '((8 3) (4 2) (7 6) (6 2) (3 4))))
(print (fun? '((b 4) (b 0) (b 9) (e 5) (g 4))))

実行結果：

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

うまくいったようだ。

さて、もうひとつ、有限関数という言葉が出てくる。「有限関数とは、ペアのリストであって、各ペアの第1要素はほかのどのペアの第1要素とも同じでないものと表現できます。」とある。それってファンのことじゃないの？

ペア

ペアという構造が出てきた。ペアとは、S式2つからなるリストのことだ。

a-pair?

で、質問はこの引数がペアかどうかを判定する関数 a-pair? を書け、と。どうすればいいかというと、要するに要素が2つのリストかどうかを確認すればいいんだな。言い換えれば、cdr の cdr が null? なら、それはペアだってことだ。

(use mymodule)

(define a-pair?
  (lambda (x)
    (cond
      ((atom? x) #f)
      ((null? x) #f)
      ((null? (cdr x)) #f)
      ((null? (cdr (cdr x))) #t)
      (else #f))))

(print (a-pair? '(pear pear)))
(print (a-pair? '(3 7)))
(print (a-pair? '((2) (pair))))
(print (a-pair? '(full (house))))

実行：

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

できた。

first、second、build

p.120 に first、second、build の定義が載っている。これはペアを作るときと、ペアから部分を取り出すときの関数だ。

(define first
  (lambda (p)
  (cond
    (else (car p)))))

(define second
  (lambda (p)
    (cond
      (else (car (cdr p))))))

(define build
  (lambda (a1 a2)
    (cond
      (else (cons a1 (cons a2 (quote ())))))))

で、これを一行文で再定義しろ、と。ま、簡単、cond の質問が else しかないんだから、cond はなくてもかまわないわけだ。

(define first
  (lambda (p)
    (car p)))

(define second
  (lambda (p)
    (car (cdr p))))

(define build
  (lambda (a1 a2)
    (cons a1 (cons a2 (quote ())))))

たぶん、あとで使うことになるんだろうから、a-pair? とあわせて mymodule.scm に追加しておこう。

intersectall

関数 intersectall は、セットのリスト l-set を引数にとって、各セットすべての共通部分を返す関数。
これは答えを見なければわからなかった。というか、はじめに思いついたのは fold を使った実装。でも、fold はまだ出てきてないから使わないとするとどうしたらいいんだろう、と。
とりあえず fold を使ったコードを載せる。

(use mymodule)

(define intersect
  (lambda (s1 s2)
    (cond
      ((null? s1) (quote ()))
      ((member? (car s1) s2) (cons (car s1) (intersect (cdr s1) s2)))
      (else (intersect (cdr s1) s2)))))

(define intersectall
  (lambda (l-set)
    (fold intersect (car l-set) (cdr l-set))))

(print (intersectall '((a b c) (c a d e) (e f g h a b))))
(print (intersectall '((6 pears and)
                       (3 peaches and 6 peppers)
                       (8 pears and 6 plums)
                       (and 6 prunes with lots of apples))))

^o^ > gosh -I. intersectall2.scm
(a)
(and 6)

期待どおりに動いている。
で、こっちが fold を使わないコード。答を見ながら写経した。

(use mymodule)

(define intersect
  (lambda (s1 s2)
    (cond
      ((null? s1) (quote ()))
      ((member? (car s1) s2) (cons (car s1) (intersect (cdr s1) s2)))
      (else (intersect (cdr s1) s2)))))

(define intersectall
  (lambda (l-set)
    (cond
    ((null? (cdr l-set)) (car l-set))
    (else (intersect (car l-set) (intersectall (cdr l-set)))))))

(print (intersectall '((a b c) (c a d e) (e f g h a b))))

なるほど、最終条件は (null? (cdr l-set)) なら値は (car l-set)、つまり最後のセットはそのまま返す。で、途中は (car l-set) と (cdr l-set) で再帰したセットに intersect を適用している。これですべてのセットの共通部分が取り出せるわけだ。
結果は：

^o^ > gosh -I. intersectall.scm
(a)
(6 and)

fold を使ったものと同じになった。よかった、fold 使ったコードも間違いじゃなかった。

日	月	火	水	木	金	土
			1	2	3	4
5	6	7	8	9	10	11
12	13	14	15	16	17	18
19	20	21	22	23	24	25
26	27	28	29	30	31

月: 2014年1月

valueとatom-to-function

insert-g（つづき）

subst

yyy

前回と今回のまとめ

insert-g

insertL-f と insertR-f

insert-g

関数を返す関数

関数を返す関数

ふたたび rember-f

関数を引数にとる関数

fullfun?またはone-to-one?

revrel

レルとファン

ペア

a-pair?

first、second、build

intersectall