kb84tkhrのブログ

何を書こうか考え中です あ、あと組織とは関係ないってやつです 個人的なやつ

Scheme手習い(11) 抽象化、部分適用

第8章「究極のlambda」の続き
insertRとinsertLを高階関数に書き換えます

(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))))))))

(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))))))))

そっくりですね
違うのは要素を挿入する部分、つまり(cons new (cons old (cdr l)))と
(cons old (cons new (cdr l)))だけ
ここを引数として取るような関数insert-g を作ります
(比較は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))))))))

するとinsertLとinsertRが以下のように書けるようになります

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

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))
(define insertR (insert-g seqR))

以下は何を言おうとしているのか

これらの2つの定義にどこか普通ではないことがありますか。

いや別に
何かあります?

はい。

あるんですか

以前でしたら

seqがseqLのとき(define insertL (insert-g seq))

で、

seqがseqRのとき(define insertR (insert-g seq))

としていたでしょう。

今までなら

lのcarは何ですか。
ここで lは((a b c) x y z)です。

とか言ってた類のことかな?
これを実際試すときには(car (quote ((a b c) x y z)))としてたけど
今回はquoteしなくていいですね、ってこと?
((a b c) x y z)は評価されちゃうと困るけど
seqLやらseqRは評価してもらわないと逆に困る

しかし、「のとき」は引数として関数を渡すときには不要です。

「のとき」ってなんじゃらほいという疑問は残る
原文でもwhereだから訳が変ってわけでもなさそうだ
しいて言えば「のとき」以下は、くらいかな

seqL、seqRを他で使うことがないなら、わざわざdefineしないで以下のようにlambdaでも書ける
書けるんだけれども本では触れられない なぜだろう

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

lambdaもquoteしない
当たり前といえば当たり前だけれども
考え過ぎるとゲシュタルト崩壊みたいな気分になる

では、

次のyyyについてはどう思いますか。

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

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

驚きです。これは

よく知っているremberではありませんか!
ちょっと意表をつかれた

newは使われないんだけど何か引数を書かないといけないから#fを渡している

これまでに見たことこそ抽象化の力です。

insertLとinsertRとsubstとremberは実はそっくりさんだった、というお話でした

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

DRY原則、かな
いよいよ戒律も残すはあとひとつ

次はvalueをネタにして第9の戒律の練習

(define value
  (lambda (aexp)
    (cond ((atom? aexp) aexp)
          ((eq? (operator aexp) (quote +))
          (o+ (value (1st-sub-exp aexp)) (value (2nd-sub-exp aexp))))
          ((eq? (operator aexp) (quote *))
          (o* (value (1st-sub-exp aexp)) (value (2nd-sub-exp aexp))))
          ((eq? (operator aexp) (quote ^))
          (o^ (value (1st-sub-exp aexp)) (value (2nd-sub-exp aexp)))))))

+の行と*の行と^の行がそっくりで、+、*、^に応じてo+、o*、o^を使い分けているだけだから
そういう関数を作ってやります

(define atom-to-function
  (lambda (x)
    (cond ((eq? x (quote +)) o+)
          ((eq? x (quote *)) o*)
          (else o^))))

これを使うとvalueはこうなります

(define value
  (lambda (nexp)
    (cond ((atom? nexp) nexp)
          (else ((atom-to-function (operator nexp))
                 (value (1st-sub-exp nexp))
                 (value (2nd-sub-exp nexp)))))))

演算子を増やすときはatom-to-functionだけを変更すればいいし
前置記法に書き換えたい場合はvalueだけを(しかも1箇所だけを)変更すればよくなりました

D・R・Y!
D・R・Y!

multiremberのeq?を引数で指定できるようにしたmultirember-fを作ります

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

> (multirember-f = 2 '(1 2 3 2))
(1 3)

(test? xxx a)という部分をまとめて関数にしてしまえば、test?とaを別にして渡す必要がなくなります

(define multiremberT
  (lambda (test? lat)
    (cond ((null? lat) (quote ()))
          ((test? (car lat))
          (multiremberT test? (cdr lat)))
          (else
          (cons (car lat) (multiremberT test? (cdr lat)))))))

> (multiremberT (lambda (a) (= a 2)) '(1 2 3 2))
(1 3)

関数の部分適用てやつですかね
こっちの書き方のほうが適用範囲が広がりそうです