HOME もうひとつの Scheme 入門 download 書き込む

8. 高階関数

1. 初めに

高階関数は関数を引数にとる関数です。リストの各要素に同じ処理をするマッピング、リストから 条件を満たした要素を取り出すフィルタリング、畳み込み、条件によって要素を並べ替えるソーティングがあります。

高階関数はプログラムのモジュール化を促進します。 個々のケースの再帰関数を書く代わりに、多くの場合に適応できる高階関数を書けば、 プログラムが短くなり、見通しが良くなります。

例えば、ソーティングに高階関数を使うとさまざまな条件で並び替えをすることができ、 並び替えの条件と、並び替えの手順を完全に分離することができます。 sort という関数は２つの引数をとり、最初の引数に並び替えるリスト、 ２番目の引数に順序付けをする手続きを引数にとります。 例えば、整数のリストを単純に昇順に並び替えるときは次のようにします。 < が２つの数を比較する関数です。 

(sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239) <)
⇒ (2239 2644 2828 2958 4179 5340 6729 7754 7883 9099)
また、下２桁が小さい順に並べるには次のようにします。 
(sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239) 
      (lambda (x y) (< (modulo x 100) (modulo y 100))))
⇒ (2828 6729 2239 5340 2644 7754 2958 4179 7883 9099)
このように、並べ替える手順 (quick sort, merge sort, etc) と２つの要素を比較する 関数が完全に分離されているので、プログラムの再利用が促進されます。

この文書では、まず、処理系にあらかじめ定義されている高階関数について説明し、 それから自前の高階関数を作ってみます。Scheme は手続きと他のデータを全く区別しないので、 手続きも単に引数に渡してやるだけで、簡単に高階関数を作ることができます。

実は、Scheme であらかじめ定義されている関数のかなりの部分が高階関数です。 理由は、Scheme では、ブロックを定義する構文が無いので、lambda 式（つまり無名関数） がブロックの働きをするからです。

2. マッピング

リストの各要素に同じ操作をする関数です。 操作を施したリストを返す map と、副作用を目的とする for-each の２つが R5RS で定義されています。

2.1. map

書式は以下の通りです。 
(map procedure list1 list2 ...)
procedure は手続きと結びついたシンボルまたは、lambda 式で定義される無名関数です。 引数にとるリストの数は、procedure の引数によって変わります。

例 

; '(1 2 3) と '(4 5 6) の各要素を足し合わせる。
(map + '(1 2 3) '(4 5 6))
⇒ (5 7 9)

; '(1 2 3) の各要素を２乗したリストを返す。
(map (lambda (x) (* x x)) '(1 2 3))
⇒ (1 4 9)

2.2. for-each

書式は map と同じですが、副作用を目的にして使われます。

例： 

(define sum 0)
(for-each (lambda (x) (set! sum (+ sum x))) '(1 2 3 4))
sum
⇒ 10

練習問題 1

次の関数を map を用いて書いてください。
  1. リストの各要素を２倍する関数。
  2. ２つのリストの各要素の差をとる関数。

3. フィルタリング

R5RS では規定されていませんが、MIT-Scheme には keep-matching-items, delete-matching-items が定義されています。他の処理系でも 用意されていると思います。 
(keep-matching-items '(1 2 -3 -4 5) positive?)
⇒ (1 2 5)

練習問題 2

次の関数を書いてください。
  1. リストの要素のうち偶数だけを選んで返す関数。
  2. 10 以上 100 以下の数を選んで返す関数。

4. 畳み込み

R5RS では規定されていませんが、MIT-Scheme には reduce などが 用意されています。 
(reduce + 0 '(1 2 3 4))                 ⇒  10
(reduce + 0 '(1 2))                     ⇒  3
(reduce + 0 '(1))                       ⇒  1
(reduce + 0 '())                        ⇒  0
(reduce + 0 '(foo))                     ⇒  foo
(reduce list '() '(1 2 3 4))            ⇒  (((1 2) 3) 4)

練習問題 3

  1. リストの各要素を二乗し、それを足し合わせた後、平方根をとる関数を reduce を使って書いてください。

5. 並び替え

R5RS では規定されていませんが、MIT-Scheme には sort (merge-sort), quick-sort が 用意されています。 
(sort '(3 5 1 4 -1) <)
⇒ (-1 1 3 4 5)

練習問題 4

次の関数を書いてください。
  1. 実数からなるリストをリストの要素の平均値に近い順に並び替える。
  2. 文字列からなるリストを文字列の長さの長い順に並び替える。

6. apply

procedure をリストに適応するときに使います。最初の引数が procedure, 最後の引数がリストになっている必要があります。たいした働きをしていないように思えますが、 以外に便利な関数です。 
(apply max '(1 3 2))      ⇒   3
(apply + 1 2 '(3 4 5))    ⇒  15
(apply - 100 '(5 12 17))  ⇒  66

練習問題 5

  1. 練習問題 3 と同じ関数を apply を使って書いてください。
  2. 任意個の数の平均を求める関数 (繰り返しの練習問題 3 の 4) を apply を使って書いてください。

7. 自前の高階関数

自前の高階関数を書くこともきわめて簡単です。 ここでは、member-if, member, および fractal を定義してみます。

7.1. member-if, member

条件とリストを引数にとり、その条件を満たす要素より後のリストを返す関数 member-if は 次のように書けます。Scheme では手続きも他の変数と全く同様に扱えます。 
(define (member-if proc ls)
  (cond
   ((null? ls) #f)
   ((proc (car ls)) ls)
   (else (member-if proc (cdr ls)))))

(member-if (lambda(x) (< 0 x)) '(0 -1 -2 3 5 -7))
⇒  (3 5 -7)
また、比較する関数を指定して、あるものがリストにあるか調べる関数 member は次のように書けます。 
(define (member proc obj ls)
  (cond
   ((null? ls) #f)
   ((proc obj (car ls)) ls)
   (else (member proc obj (cdr ls)))))

(member string=? "hello" '("hi" "guys" "bye" "hello" "see you"))
⇒  ("hello" "see you")

7.2. フラクタル曲線

C curve, Dragon curve などの 2 点の間に(複数の）点を挿入して生成するフラクタル曲線は、新たな点の挿入の仕方とフラクタル曲線 を作る一般的なルーチンに分離することができます。 以下にコードを示して説明します。 
01:     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
02:     ;;;
03:     ;;;                frac.scm
04:     ;;;
05:     ;;;        draw fractal curves
06:     ;;;         by T.Shido
07:     ;;;       on August 20, 2005
08:     ;;;
09:     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10:     
11:     (define _x car)
12:     (define _y cdr)
13:     (define point cons)
14:     
15:     ;;; (rappend '(1 2 3) '(4 5 6)) -> (3 2 1 4 5 6)
16:     (define (rappend ls0 ls1)
17:       (let loop((ls0 ls0) (ls1 ls1))
18:         (if (null? ls0)
19:             ls1
20:           (loop (cdr ls0) (cons (car ls0) ls1)))))
21:       
22:     ;;; 
23:     (define (devide p1 p2 r)
24:       (point (+ (* r (_x p1)) (* (- 1.0 r) (_x p2)))
25:     	 (+ (* r (_y p1)) (* (- 1.0 r) (_y p2)))))
26:     
27:     ;;; print out data points to a file
28:     (define (print-curve points fout)
29:       (with-output-to-file fout
30:         (lambda ()
31:           (for-each
32:            (lambda (p)
33:              (display (_x p))
34:              (display " ")
35:              (display (_y p))
36:              (newline))
37:            points))))
38:              
39:     
40:     ;;; the main function to create fractal curves
41:     (define (fractal proc n points fout)
42:       (let loop((i 0) (points points))
43:         (if (= n i)
44:     	(print-curve points fout)
45:     	(loop
46:     	 (1+ i)
47:     	 (let iter ((points points) (acc '()))
48:     	   (if (null? (cdr points)) 
49:     	       (reverse! (cons (car points) acc))
50:     	       (iter
51:     		(cdr points)
52:     		(rappend (proc (first points) (second points)) acc)))))))
53:       'done)
54:     
55:     
56:     
57:     ;;; c curve
58:     (define (c-curve p1 p2) 
59:       (let ((p3 (devide p1 p2 0.5)))
60:         (list
61:          p1
62:          (point (+ (_x p3) (- (_y p3) (_y p2)))
63:     	    (+ (_y p3) (- (_x p2) (_x p3)))))))
64:     
65:     ;;; dragon curve
66:     (define dragon-curve 
67:       (let ((n 0))
68:         (lambda (p1 p2)
69:           (let ((op (if (even? n) + -))
70:     	    (p3 (devide  p1 p2 0.5)))
71:     	(set! n (1+ n))
72:     	(list
73:     	 p1
74:     	 (point (op (_x p3) (- (_y p3) (_y p2)))
75:     		(op (_y p3) (- (_x p2) (_x p3)))))))))
76:           
77:     
78:     ;;; koch curve
79:     (define (koch p1 p2)
80:       (let ((p3 (devide p1 p2 2/3))
81:     	(p4 (devide p1 p2 1/3))
82:     	(p5 (devide p1 p2 0.5))
83:     	(c  (/ (sqrt 3) 2)))
84:         (list
85:          p1
86:          p3
87:          (point (- (_x p5) (* c (- (_y p4) (_y p3))))
88:     	    (+ (_y p5) (* c (- (_x p4) (_x p3)))))
89:          p4)))
90:         
91:
行 説明
11--13 xy 平面上の点はドット対で表します。点の x 座標は car で、y 座標は cdr で得ることができますが、 可読性を上げるためにそれぞれ別名 _x, _y をつけます。また、点は cons で作ることができますが、 これにも別名 point をつけます。
15--20 (rappend ls0 ls1)
２つのリストを引数にとり、最初のリストを反転させて、２番目のリストにつなげます。
23--25 (devide p1 p2 r)
２点 p1, p2 を比 r で内分する点を求めます。
27--37 (print-curve points fout)
点のリスト points を fout に１行に１点ずつ出力します。
40--53 (fractal proc n points fout)
フラクタル曲線を描く高階関数です。
proc は点を補間する関数、 n は繰り返しの回数、points は点のリスト、fout はデータを出力するファイル名です。
この関数は loop と iter の２重のループからなっています。loop は データリストに対する補間を n 回繰り返します。また、iter は補間関数を使ってデータリストに新しい点を追加していきます。 つまり、 iter を n 回繰り返してフラクタル曲線を描きます。
補間関数 proc は２つの点を引数に取る関数で、１番目の引数そのものと、 新たに補間された点からなるリストを返します。
57--63 (c-curve p1 p2)
C curve を描くための補間関数です。
65--75 (dragon-curve p1 p2)
Dragon curve を描くための補間関数です。
78--89 (koch p1 p2)
Koch 曲線を描くための補間関数です。
C-Curve, Dragon-Curve, Koch-Curve を描くには次のようにします。 コンパイルしてから計算させたほうが待ち時間が短くなります。 ソースコードを付録につけておいたので遊んでみてください。 
(compile-file "frac.scm")
(load "frac")

;; C-Curve
(fractal c-curve 14 '((0 . 0) (2 . 3)) "c14.dat")
;Value: done

;; Dragon-Curve
(fractal dragon-curve 14 '((0 . 0) (1 . 0)) "d14.dat")
;Value: done

;; Koch-Curve
(fractal koch 5 '((0 . 0) (1 . 0)) "k5.dat")
;Value: done
'*.dat' というファイルに x 座標と y 座標がテキスト形式で保存されるので、 いつも使っているプロットソフトを使ってプロットします。

図 1--3 は gnuplot を使ってプロットしたものです。


図１: C-Curve


図２: Dragon-Curve


図３: Koch-Curve

練習問題 6

  1. keep-matching-items を自分で定義してみてください。
  2. map を自分で定義してみてください。 複数のリストに対応するのは少し難しいかもしれません。任意個の引数を取るには ドット（.) で 区切ります。ドット以下がリストとして関数にわたります。

    例：my-list 

    (define (my-list . x) x)
    また、apply を使う必要もあります。

8. 終わりに

今回は高階関数について説明しました。 フラクタル曲線の例で示したように、高階関数はプログラムのモジュール化を促進します。 意識して積極的に使うようにしましょう。

この文章で示したように、Scheme では 自前の高階関数を簡単に定義することができます。

次回は入出力について説明します。

練習問題の解答

練習問題 1


; 1
(define (double ls)
  (map (lambda (x) (* x 2)) ls))

; 2
(define (sub ls1 ls2)
  (map - ls1 ls2))

練習問題 2

; 1
(define (filter-even ls)
  (keep-matching-items ls even?))
; 2
(define (filter-10-100 ls)
  (keep-matching-items ls (lambda (x) (<= 10 x 100))))

練習問題 3

(define (sqrt-sum-sq ls)
  (sqrt (reduce + 0 (map (lambda (x) (* x x)) ls))))

練習問題 4

; 1
(define (sort-ave ls)
  (let ((ave (/ (apply + ls) (length ls))))
    (sort ls (lambda (x y) (< (abs (- x ave)) (abs (- y ave)))))))

; 2
(define (sort-string ls)
  (sort ls (lambda (x y) (> (string-length x) (string-length y)))))

練習問題 5

; 1
(define (sqrt-sum-sq-a ls)
  (sqrt (apply + (map (lambda (x) (* x x)) ls))))

; 2
(define (ave . ls)
  (/ (apply + ls) (length ls)))

練習問題 6

; 1
(define (my-keep-matching-items ls fn)
  (cond
   ((null? ls) '())
   ((fn (car ls))
    (cons (car ls) (my-keep-matching-items (cdr ls) fn)))
   (else
    (my-keep-matching-items  (cdr ls) fn))))

; 2
(define (my-map fun . lss)
  (letrec ((iter (lambda (fun lss)
		       (if (null? lss)
			   '()
			   (cons (fun (car lss))
				 (iter fun (cdr lss))))))
	   (map-rec (lambda (fun lss)
		      (if (memq '() lss)
			  '()
			  (cons (apply fun (iter car lss))
				(map-rec fun (iter cdr lss)))))))
    (map-rec fun lss)))

(my-map + '(1 2 3) '(10 20 30) '(100 200 300))
⇒ (111 222 333)

HOME もうひとつの Scheme 入門 download 書き込む