カテゴリー: Scheme

関数を返す関数

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

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

うまくいった。

関数 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 は、レルの各ペアの第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 は、セットのリスト 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 使ったコードも間違いじゃなかった。

この関数 xxx はどんな関数か、という質問。

(use mymodule)

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

(print (xxx '(stewed tomatoes and macaroni casserole)
            '(macaroni and cheese)))

^o^ > gosh -I. xxx.scm
(stewed tomatoes casserole)

答は s1 に含まれていて s2 に含まれていないすべてのアトムからなるセットを返す関数。
(car s1) が s2 のメンバーなら cons せずに、メンバーでないなら cons して再帰している。終了条件は (null? s1) で値は () だ。まあ、見ればわかるよね。

関数 union は、2つのセット s1 と s2 の和集合を返す関数。
(car s1) が s2 のメンバーなら cons せずに（なぜなら s2 に含まれているから）、メンバーでないなら cons して再帰すればいい。

(use mymodule)

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

(print (union '(stewed tomatoes and macaroni casserole)
              '(macaroni and cheese)))

^o^ > gosh -I. union.scm
(stewed tomatoes casserole macaroni and cheese)

今度は2つの集合の共通部分に関する関数だ。

intersect?

関数 intersect? は、セット s1 と s2 が共通部分を持てば #t を返す。

(use mymodule)

(define intersect?
  (lambda (s1 s2)
    (cond
      ((null? s1) #f)
      ((member? (car s1) s2) #t)
      (else (intersect? (cdr s1) s2)))))

(print (intersect? '(stewed tomatoes and macaroni)
                   '(macaroni and cheese)))

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

これを or を使って書くと短くなる。

(use mymodule)

(define intersect?
  (lambda (s1 s2)
    (cond
      ((null? s1) #f)
      (else (or (member? (car s1) s2) (intersect? (cdr s1) s2))))))

(print (intersect? '(stewed tomatoes and macaroni)
                   '(macaroni and cheese)))

ここで誤植発見。cond の1つ目の質問 (null? s1) に対する値が本（「Scheme手習い」）では nil になっているけど、これは #f の間違いだろう。

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

intersect

関数 intersect はセット s1 と s2 の共通部分を返す。

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

(print (intersect '(stewed tomatoes and macaroni)
                  '(macaroni and cheese)))

^o^ > gosh -I. intersect.scm
(and macaroni)