高階関数の使い方
関数型言語は「関数 (function)」をほかのデータと同等に取り扱うことができます。つまり、関数を変数に代入したり、引数として渡すことができるのです。また、値として関数を返すこともできるので、関数を作る関数を定義することが簡単にできます。関数を引数として受け取る関数を「汎関数 (functional)」とか「高階関数 (higher order function)」と呼びます。
高階関数といえば、マップ (map)、フィルター (filter)、畳み込み (fold, reduce) などが有名です。最近では、無名関数 (ラムダ式) をサポートするプログラミング言語が増えているので、map, filter, reduce の知名度も上昇しているのではないでしょうか。これらの高階関数を上手に使うと、プログラムを簡単に作ることができるようになります。
今回は ISLisp で高階関数の使い方をおさらいすることにしましょう。使用する処理系は笹川さんが開発されている Easy-ISLisp (ver2.65) です。
●Lisp のマップ関数
Lisp のマッピングといえば、伝統的な関数に mapcar があります。Common Lisp にも mapcar がありますし、Scheme には map があります。Common Lisp と ISLisp には、ほかにも次に示すマップ関数が用意されています。
- mapcar func xs ...
引数のリストの要素に関数 func を適用し、その結果を格納したリストを返す - maplist func xs ...
引数のリストに関数 func を適用し、その結果を格納したリストを返す - mapc func xs ...
引数のリストの要素に関数 func を適用するが、その結果は蓄積せずに xs を返す - mapl func xs ...
引数のリストに関数 func を適用するが、その結果は蓄積せずに xs を返す - mapcan func xs ...
引数のリストの要素に関数 func を適用し、その結果を nconc で連結したリストを返す - mapcon func xs ...
引数のリストに関数 func を適用し、その結果を nconc で連結したリストを返す
これらの関数の動作は定義をみるとよくわかります。簡単のため引数のリストを一つだけ受け取るマップ関数を作ってみましょう。プログラムは次のようになります。
リスト : マップ関数の簡単な定義 (mymap.lsp)
(defun mapcar1 (func xs)
(if (null xs)
nil
(cons (funcall func (car xs)) (mapcar1 func (cdr xs)))))
(defun maplist1 (func xs)
(if (null xs)
nil
(cons (funcall func xs) (maplist1 func (cdr xs)))))
(defun mapc1 (func xs)
(cond
((consp xs)
(funcall func (car xs))
(mapc1 func (cdr xs))))
xs)
(defun mapl1 (func xs)
(cond
((consp xs)
(funcall func xs)
(mapl1 func (cdr xs))))
xs)
(defun mapcan1 (func xs)
(if (null xs)
nil
(nconc (funcall func (car xs)) (mapcan1 func (cdr xs)))))
(defun mapcon1 (func xs)
(if (null xs)
nil
(nconc (funcall func xs) (mapcon1 func (cdr xs)))))
簡単な実行例を示します。
Easy-ISLisp Ver2.65 > (load "mymap.lsp") T > (mapcar1 #'identity '(a b c d e)) (A B C D E) > (mapcar1 (lambda (x) (* x x)) '(1 2 3 4 5)) (1 4 9 16 25) > (maplist1 #'identity '(a b c d e)) ((A B C D E) (B C D E) (C D E) (D E) (E)) > (maplist1 (lambda (xs) (apply #'+ xs)) '(1 2 3 4 5)) (15 14 12 9 5) > (mapc1 #'print '(a b c d e)) A B C D E (A B C D E) > (mapl1 #'print '(a b c d e)) (A B C D E) (B C D E) (C D E) (D E) (E) (A B C D E) > (mapcan1 (lambda (x) (list x x)) '(a b c d e)) (A A B B C C D D E E) > (mapcon1 (lambda (x) (mapcar (lambda (y) (* y y)) x)) '(1 2 3 4 5)) (1 4 9 16 25 4 9 16 25 9 16 25 16 25 25)
mapcar は (car xs) でリストの要素を取り出して関数 func に渡しますが、maplist は xs をそのまま func に渡します。mapc と mapl は副作用のために用いられます。違いは mapcar と maplist と同じです。mapc は Scheme の for-each と同様の動作になります。なお、for-each の返り値は仕様に規定されていないので、Scheme 処理系に依存します。
mapcan は mapcar の結果を nconc で連結する、つまり、マッピングの結果を平坦化する動作になります。いわゆる flatmap とか Haskell の concatMap などの関数と同様の操作になります。mapcon は maplist の結果を平坦化します。
mapcan と mapcon はリストの連結に nconc を使っているので、循環リストが生成されないように注意してください。たとえば、mapcon1 に恒等関数 identity を渡すと無限ループになります。
●数列の生成
Easy-ISLisp のライブラリ list には s 以上 e 以下の整数列を生成する関数 iota が用意されています。iota と mapcar を組み合わせると、いろいろな数列を生成することができます。簡単な例を示しましょう。
> (import "list") T > (iota 1 10) (1 2 3 4 5 6 7 8 9 10) > (mapcar (lambda (x) (- (* 2 x) 1)) (iota 1 10)) (1 3 5 7 9 11 13 15 17 19) > (mapcar (lambda (x) (* 2 x)) (iota 1 10)) (2 4 6 8 10 12 14 16 18 20) > (mapcar (lambda (x) (div (* x (+ x 1)) 2)) (iota 1 10)) (1 3 6 10 15 21 28 36 45 55) > (mapcar (lambda (x) (* x x)) (iota 1 10)) (1 4 9 16 25 36 49 64 81 100)
Easy-ISLisp の場合、ライブラリ list は (import "list") で読み込むことができます。(iota 1 10) を評価すると、1 から 10 までの整数列 (リスト) を生成します。
リストの要素に (lambda (x) (- (* 2 x) 1)) を適用すると奇数列を生成することができます。(lambda (x) (* 2 x)) を適用すると偶数列になります。(lambda (x) (div (* x (+ x 1)) 2)) を適用すると「三角数」になり、(lambda (x) (* x x)) を適用すると「四角数 (平方数)」になります。
点を多角形の形に並べたとき、その総数を多角数 (polygonal number) といいます。三角形に配置したものを三角数 (triangular number)、四角形に配置したものを四角数 (square number)、五角形に配置したものを五角数 (pentagonal number) といいます。多角数の詳しい説明は拙作のページ Puzzle DE Programming 多角数 をお読みください。
三角数は公差 1、四角数は公差 2、五角数は公差 3、p 角数は公差 p - 2 の等差数列の和になります。n 番目の p 角数 Pp,n は次式で求めることができます。
Pp,n = ((p - 2)n^2 - (p - 4)n) / 2
これを ISLisp でプログラムすると次のようになります。
> (defun polygonal-number (p n) (div (- (* (- p 2) n n) (* (- p 4) n)) 2)) POLYGONAL-NUMBER > (mapcar (lambda (x) (polygonal-number 5 x)) (iota 1 10)) (1 5 12 22 35 51 70 92 117 145) > (mapcar (lambda (x) (polygonal-number 6 x)) (iota 1 10)) (1 6 15 28 45 66 91 120 153 190) > (mapcar (lambda (x) (polygonal-number 7 x)) (iota 1 10)) (1 7 18 34 55 81 112 148 189 235)
このように、多角数を簡単に求めることができます。なお、Easy-ISLisp のライブラリ list には整数列に関数を適用する tabulate が用意されています。
tabulate func s e
> (tabulate #'identity 1 10) (1 2 3 4 5 6 7 8 9 10) > (tabulate (lambda (x) (polygonal-number 5 x)) 1 10) (1 5 12 22 35 51 70 92 117 145) > (tabulate (lambda (x) (polygonal-number 6 x)) 1 10) (1 6 15 28 45 66 91 120 153 190) > (tabulate (lambda (x) (polygonal-number 7 x)) 1 10) (1 7 18 34 55 81 112 148 189 235)
●パスカルの三角形
次は maplist を使って「パスカルの三角形」を作ってみましょう。
図 : パスカルの三角形
パスカルの三角形は、上図のように両側がすべて 1 で、内側の数はその左上と右上の和になっています。これは (a + b)n を展開したときの各項の係数を表しています。そして、その値は右側の図のように組み合わせの数 nＣr に対応しています。
きれいな三角形にはなりませんが、maplist を使うと簡単にプログラムを作ることができます。
リスト : パスカルの三角形
(defun pascal (n xs)
(print xs)
(if (<= (length xs) n)
(pascal n (maplist (lambda (ys)
(if (null (cdr ys)) 1 (+ (car ys) (car (cdr ys)))))
(cons 0 xs)))))
関数 pascal はリスト xs の隣同士の要素を足した値をリストを生成し、それを print で出力します。この処理は maplist を使えば簡単です。maplist に渡すラムダ式の中で、引数 ys の先頭要素と二番目の要素を足し算します。二番目の要素が無い場合は 1 を返します。また、maplist を呼び出すときは xs の先頭に 0 を追加します。これで、リストの先頭と最後尾を 1 にすることができます。あとは pascal を再帰呼び出しして処理を繰り返すだけです。
それでは実行してみましょう。
> (pascal 16 '(1)) (1) (1 1) (1 2 1) (1 3 3 1) (1 4 6 4 1) (1 5 10 10 5 1) (1 6 15 20 15 6 1) (1 7 21 35 35 21 7 1) (1 8 28 56 70 56 28 8 1) (1 9 36 84 126 126 84 36 9 1) (1 10 45 120 210 252 210 120 45 10 1) (1 11 55 165 330 462 462 330 165 55 11 1) (1 12 66 220 495 792 924 792 495 220 66 12 1) (1 13 78 286 715 1287 1716 1716 1287 715 286 78 13 1) (1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1) (1 15 105 455 1365 3003 5005 6435 6435 5005 3003 1365 455 105 15 1) (1 16 120 560 1820 4368 8008 11440 12870 11440 8008 4368 1820 560 120 16 1)
●複数のリストを操作する
一般に、Lisp / Scheme 以外の関数型言語 (Haskell, SML, OCaml など) では、マップ関数に渡すことができるリストは一つだけです。このため、複数のリストを扱いたいときは、それを一つのリストにまとめる操作が必要になります。このような操作を行う関数を zip といいます。
zip は引数のリストの要素を取り出して、それらをリスト (またはタプル) に格納し、それを一つのリストに格納して返します。これを ISLisp でプログラムすると次のようになります。
> (defun zip (&rest args) (apply #'mapcar #'list args))
ZIP
> (zip '(a b c) '(1 2 3))
((A 1) (B 2) (C 3))
> (zip '(a b c) '(1 2 3) '("foo" "bar" "baz"))
((A 1 "foo") (B 2 "bar") (C 3 "baz"))
Common Lisp や ISLisp のマップ関数は複数のリストを受け取ることができるので、zip は簡単に定義することができます。なお、Haskell には zip と map を組み合わせた関数 zipWith がありますが、Lisp では mapcar で同じことを行うことができます。
簡単な例を示しましょう。
> (mapcar #'+ '(1 2 3 4 5) '(10 11 12 13 14)) (11 13 15 17 19) > (mapcar #'= '(1 2 3 4 5) '(5 4 3 2 1)) (NIL NIL T NIL NIL) > (mapcar #'append '((1 2) (3 4) (5 6)) '((a b) (c d) (e f))) ((1 2 A B) (3 4 C D) (5 6 E F))
関数に添字を渡すマップ関数 map-with-index も簡単に定義することができます。
リスト : 添字付きマップ関数
(defun map-with-index (func &rest args)
(let ((n (apply #'min (mapcar #'length args))))
(apply #'mapcar func (iota 0 (- n 1)) args)))
iota で添字を表すリストを生成し、それを他の引数と一緒に mapcar に渡すだけです。簡単な実行例を示します。
> (map-with-index #'list '(a b c d e)) ((0 A) (1 B) (2 C) (3 D) (4 E)) > (map-with-index #'list '(a b c d e) '(5 4 3 2 1)) ((0 A 5) (1 B 4) (2 C 3) (3 D 2) (4 E 1))
●格子点と直積集合
平面や空間などの座標において、各成分がすべて整数であるような点を「格子点 (lattice point)」といいます。二次元の座標 (x, y) で x と y の範囲が有限であれば、格子点は「直積集合 (direct product)」で求めることができます。直積は「デカルト積 (Cartesian product)」と呼ばれることもあります。
最近では、多くの処理系で集合演算をサポートしています。その中には、直積集合を求める関数 (product など) が用意されている処理系もあります。Lisp の場合、マップ関数を使って私たちでも簡単に作ることができます。
リスト : 直積集合 (ISLisp) (defun product (xs ys) (mapcan (lambda (x) (mapcar (lambda (y) (list x y)) ys)) xs))
内側の mapcar で xs の要素 x と ys の組を生成し、外側の mapcan で mapcar の返り値のリストを nconc で連結 (平坦化) します。簡単な実行例を示します。
> (product '(0 1 2 3) '(0 1 2 3)) ((0 0) (0 1) (0 2) (0 3) (1 0) (1 1) (1 2) (1 3) (2 0) (2 1) (2 2) (2 3) (3 0) (3 1) (3 2) (3 3))
三次元の座標は product を 2 回使えばできるはずです。結果は次のようになりました。
> (product (product '(0 1) '(2 3)) '(4 5)) (((0 2) 4) ((0 2) 5) ((0 3) 4) ((0 3) 5) ((1 2) 4) ((1 2) 5) ((1 3) 4) ((1 3) 5)) > (product '(0 1) (product '(2 3) '(4 5))) ((0 (2 4)) (0 (2 5)) (0 (3 4)) (0 (3 5)) (1 (2 4)) (1 (2 5)) (1 (3 4)) (1 (3 5)))
集合 A, B の直積集合を A * B で表すと、一般に A * B = B * A は成り立ちません。また、(A * B) * C の要素は ((a, b), c) に、A * (B * C) の要素は (a, (b, c)) に、A * B * C の要素は (a, b, c) になるので、厳密に言えばこれらは異なる集合になります。
実際には、((a, b), c) や (a, (b, c)) を (a, b, c) と同一視して、複数の集合の直積を 2 つの集合の直積の繰り返しで定義してもよいようです。詳しくは 参考 URL 1 をお読みください。
これを ISLisp でプログラムすると次のようになります。
リスト : 格子点
(defun lattice-point (&rest args)
(cond
((null args) (list '()))
((null (cdr args))
(mapcar (lambda (x) (list x)) (car args)))
(t
(mapcan (lambda (x) (mapcar (lambda (ys) (cons x ys))
(apply #'lattice-point (cdr args))))
(car args)))))
関数名は lattice-point としました。引数 args にリストがひとつしかない場合、その要素をリストに包み、それを格納したリストに変換します。args にリストが複数ある場合、lattice-point を再帰呼び出しして、(cdr args) の格子点を生成します。あとは、格子点のリスト ys にリスト (car args) の要素 x を追加していくだけです。
それでは実際に試してみましょう。
> (lattice-point '(0 1)) ((0) (1)) > (lattice-point '(0 1) '(2 3)) ((0 2) (0 3) (1 2) (1 3)) > (lattice-point '(0 1) '(2 3) '(4 5)) ((0 2 4) (0 2 5) (0 3 4) (0 3 5) (1 2 4) (1 2 5) (1 3 4) (1 3 5)) > (lattice-point '(0 1) '(2 3) '(4 5) '(6 7)) ((0 2 4 6) (0 2 4 7) (0 2 5 6) (0 2 5 7) (0 3 4 6) (0 3 4 7) (0 3 5 6) (0 3 5 7) (1 2 4 6) (1 2 4 7) (1 2 5 6) (1 2 5 7) (1 3 4 6) (1 3 4 7) (1 3 5 6) (1 3 5 7))
●フィルター
フィルターはリストの要素に述語 pred を適用し、pred が真を返す要素をリストに格納して返す高階関数です。関数型言語 (Haskell, OCaml, SML など) ではお馴染みの関数ですが、ISLisp の仕様には規定されていません。Common Lisp にも filter はありませんが、pred が真を返す要素を削除する remove-if や、偽を返す要素を削除する remove-if-not が用意されています。
Easy-ISLisp の場合、ライブラリ seq に remove, remove-if, remove-if-not が用意されています。
- remove item xs
item と等しい (eql) 要素を削除した新しい列を返す - remove-if pred xs
述語 pred が真を返す要素を削除した新しい列を返す - remove-if-not pred xs
述語 pred が偽を返す要素を削除した新しい列を返す
簡単な使用例を示します。
> (import "list") T > (import "seq") T > (defun evenp (x) (= (mod x 2) 0)) EVENP > (defun oddp (n) (= (mod n 2) 1)) ODDP > (remove 2 '(1 2 3 1 2 3 1 2 3)) (1 3 1 3 1 3) > (remove-if #'evenp (iota 1 20)) (1 3 5 7 9 11 13 15 17 19) > (remove-if #'oddp (iota 1 20)) (2 4 6 8 10 12 14 16 18 20) > (remove-if-not #'evenp (iota 1 20)) (2 4 6 8 10 12 14 16 18 20) > (remove-if-not #'oddp (iota 1 20)) (1 3 5 7 9 11 13 15 17 19)
ところで、フィルターと同様のプログラムはマップ関数 mapcan でも可能です。次の例を見てください。
> (mapcan (lambda (x) (if (evenp x) (list x))) (iota 1 20)) (2 4 6 8 10 12 14 16 18 20)
nconc xs ys は、xs が nil ならば ys を返し、ys が nil ならば xs を返します。mapcan に渡すラムダ式において、(pred x) が真ならば (list x) を返し、そうでなければ nil を返すことにすると、nil を除いたリストが連結されることになります。つまり、pred が真となる要素が取り出される、フィルターと同じ動作になるというわけです。
それでは簡単な例題として、n 以下の素数を求めるプログラムを作ってみましょう。
リスト : 素数
;;; エラトステネスの篩
(defun sieve (n xs ps)
(if (>= (* (car xs) (car xs)) n)
(revappend ps xs)
(sieve n
(remove-if
(lambda (x) (= (mod x (car xs)) 0)) (cdr xs))
(cons (car xs) ps))))
(defun primes (n)
(sieve n (iota 2 n) nil))
素数を求める基本的な考え方は簡単です。最初に、2 から n までの整数列を生成します。先頭の 2 は素数なので、この整数列から 2 で割り切れる整数を取り除き除きます。2 で割り切れる整数が取り除かれたので、残った要素の先頭が素数になります。先頭要素は 3 になるので、今度は 3 で割り切れる整数を取り除けばいいのです。このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩 (ふるい)」といいます。
実際の処理は関数 sieve で行います。引数 ps は素数を格納するリストです。関数 primes で 2 から n までの整数列を生成して、sieve の引数 xs に渡します。リスト xs の先頭要素を x とすると、x * x >= n のとき xs には素数しかありません。関数 revappend で ps と xs を連結して返します。revappend は Easy-ISLisp のライブラリ list に用意されている関数です。そうでなければ、 x で割り切れる要素を remove-if で取り除き、sieve を再帰呼び出しします。このとき、累積変数 ps に素数 x を追加します
それでは実行してみましょう。
> (primes 100) (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97) > (primes 1000) (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997)
プログラムは簡単ですが、実行速度は速くないので実用的ではないと思います。エラトステネスの篩は配列を使ったほうが高速です。興味のある方は挑戦してみてください
●畳み込み
Common Lisp には畳み込みを行う関数 reduce が用意されていますが、ISLisp の仕様には規定されていません。ですが、Easy-ISLisp のライブラリ list には畳み込みを行う関数 fold-left と fold-right が用意されています。
- fold-left f a xs1 [xs2 ...]
リストの先頭から畳み込む
関数 f の第 1 引数に累積値、それ以降にリストの要素が渡される - fold-right f a xs1 [xs2 ...]
リストの末尾から畳み込む
関数 f の第 1 引数に累積値、それ以降にリストの要素が渡される
fold-left と fold-right はマップ関数と同じように複数のリストを受け取ることができます。関数型言語 (Haskell, OCAML, SML など) では、引数のリストは一つだけのことが多いです。
簡単な実行例を示します。
> (fold-left #'+ 0 (iota 1 100)) 5050 > (fold-left #'* 1 (iota 1 20)) 2432902008176640000 > (fold-right #'+ 0 (iota 1 100)) 5050 > (fold-right #'* 1 (iota 1 20)) 2432902008176640000
関数 + で畳み込みを行うとリストの総和を求めることができます。関数 * で畳み込みを行うとリストの要素を乗算することができます。階乗も簡単に求めることができます。
> (defun xcons (a b) (cons b a)) XCONS > (fold-left #'xcons nil (iota 1 10)) (10 9 8 7 6 5 4 3 2 1) > (fold-right #'xcons nil (iota 1 10)) (1 2 3 4 5 6 7 8 9 10)
関数 cons の引数を逆にした関数 xcons を定義します。xcons で畳み込みを行うと、リストを反転することや、リストをコピーすることができます。
このほかにも、畳み込みと 2 引数の関数を組み合わせると、いろいろな関数を実現することができます。最初に length の例を示します。
> (defun my-length (xs) (fold-left (lambda (a x) (+ a 1)) 0 xs)) MY-LENGTH > (my-length nil) 0 > (my-length '(1 2 3 4 5)) 5
fold_left で length を実現する場合、初期値を 0 にしてラムダ式の第 1 引数 a を +1 することで実現できます。
次に mapcar の例を示します。
> (defun my-mapcar (func xs) (fold-right (lambda (a x) (cons (funcall func x) a)) nil xs)) MY-MAPCAR > (my-mapcar (lambda (x) (* x x)) (iota 1 10)) (1 4 9 16 25 36 49 64 81 100)
mapcar は fold_rigth を使うと簡単です。初期値を nil にしてラムダ式の第 2 引数に関数 func を適用した結果を第 1 引数のリストに追加するだけです。
次に filter の例を示します。
> (defun filter (pred xs) (fold-right (lambda (a x) (if (funcall pred x) (cons x a) a)) nil xs)) FILTER > (filter #'evenp (iota 1 20)) (2 4 6 8 10 12 14 16 18 20)
filter の場合も初期値を nil にして、ラムダ式の第 2 引数が条件を満たしていれば第 1 引数のリストに追加します。
最後に述語が真となる要素の個数を求めてみましょう。これは Common Lisp の関数 count-if と同じです。なお、Easy-ISLisp のライブラリ seq には count, count-if, count-if-not が定義されています。
> (defun count-if (pred xs) (fold-left (lambda (a x) (if (funcall pred x) (+ a 1) a)) 0 xs)) COUNT-IF > (count-if #'evenp (iota 1 10)) 5 > (count-if #'evenp '(1 3 5 7 9)) 0 > (count-if #'evenp '(0 2 4 6 8)) 5
このように、畳み込みを使っていろいろな処理を実現することができます。
●scan-left と scan-right
畳み込みはリストの要素に関数を適用してその結果を返しますが、計算途中の累積値をリストに格納して返す関数を定義することもできます。参考 URL 2 によると、これを prefix scan (単に scan) と呼ぶそうです。
scan が高階関数といわれても、馴染みのない方が多いかもしれませんね。scan というと M.Hiroi はＣ言語の標準ライブラリ関数 scanf を思い出します。高階関数 scan を標準で用意している処理系は、関数型言語でもそれほど多くはないと思います。M.Hiroi が知っているところでは Haskell (scanl, scanr) や Scala (scanLeft, scanRight) ぐらいでしょうか。
ISLisp でプログラムすると次のようになります。
リスト : 累積値リストの生成
(defun scan-left (fn a xs)
(if (null xs)
(list a)
(cons a (scan-left fn (funcall fn (car xs) a) (cdr xs)))))
(defun scan-right (fn a xs)
(if (null xs)
(list a)
(let ((ys (scan-right fn a (cdr xs))))
(cons (funcall fn (car xs) (car ys)) ys))))
関数 scan-left はリストの最後の要素が最終の累積値になります。xs が空リストのとき、累積変数 a の値をリストに格納して返します。そうでなければ、scan-left を再帰呼び出しして、その返り値に累積変数 a の値を追加して返します。scan-left を再帰呼び出しするときは、関数 fn を呼び出して累積変数の値を更新することに注意してください。
関数 scan-right はリストの先頭の要素が最終の累積値、最後の要素が初期値になります。xs が空リストの場合は (list a) を返します。そうでなければ、scan-right を再帰呼び出しします。このとき、累積変数 a の値は更新しません。返り値のリストは変数 ys にセットします。この ys の先頭要素が一つ前の累積値になるので、この値と xs の要素を関数 fn に渡して評価します。あとは、fn の返り値を ys の先頭に追加して返せばいいわけです。
簡単な実行例を示します。
> (scan-left #'+ 0 '(1 2 3 4 5 6 7 8 9 10)) (0 1 3 6 10 15 21 28 36 45 55) > (scan-left #'cons nil '(1 2 3 4 5)) (NIL (1) (2 1) (3 2 1) (4 3 2 1) (5 4 3 2 1)) > (scan-left #'* 1 '(1 2 3 4 5 6 7 8 9 10)) (1 1 2 6 24 120 720 5040 40320 362880 3628800) > (scan-right #'+ 0 '(1 2 3 4 5 6 7 8 9 10)) (55 54 52 49 45 40 34 27 19 10 0) > (scan-right #'cons nil '(1 2 3 4 5)) ((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5) NIL)
●ちょっと便利な高階関数
最後に、Scheme のライブラリ SRFI-1 の中からちょっと便利な高階関数を紹介しましょう。
take-while pred xs => ys drop-while pred xs => zs span pred xs => (ys zs) break pred xs => (ys zs)
take-while はリスト xs の先頭から述語 pred を満たす要素を取り出し、それをリスト ys に格納して返します。drop-while はリスト xs の先頭から述語 pred を満たす要素を取り除き、残ったリスト zs を返します。
span はリスト xs の先頭から述語 pred を満たす要素を取り出し、リスト ys に格納して返します。逆に、break は pred を満たさない要素を取り出し、リスト ys に格納して返します。span と break の返り値はリストで、2 番目の値 zs は残りのリストになります。なお、Haskell のライブラリ Data.List にも同様の関数 takeWhile, dropWhile, span, break が用意されています。
ISLisp でプログラムを書くと次のようになります。
リスト : take-while, drop-while, span, break-list
(defun take-while (pred xs)
(if (or (null xs)
(not (pred (car xs))))
'()
(cons (car xs) (take-while pred (cdr xs)))))
(defun drop-while (pred xs)
(if (or (null xs)
(not (pred (car xs))))
xs
(drop-while pred (cdr xs))))
(defun span (pred xs)
(if (or (null xs)
(not (pred (car xs))))
(list nil xs)
(let ((ys (span pred (cdr xs))))
(list (cons (car xs) (car ys))
(car (cdr ys))))))
(defun break-list (pred xs)
(if (or (null xs)
(pred (car xs)))
(list nil xs)
(let ((ys (break-list pred (cdr xs))))
(list (cons (car xs) (car ys))
(car (cdr ys))))))
take-while と drop-while は拙作のページ ISLisp 入門: ISLisp ドリル 問題 28 の解答プログラムと同じです。それから、Easy-ISLisp の場合、break はデバッガを起動する関数として定義されているので、名前を break-list に変更しています。プログラムは単純な再帰なので、とくに難しいところはないと思います。
簡単な実行例を示します。
> (take-while #'evenp '(2 4 6 8 1 2 3 4 5)) (2 4 6 8) > (drop-while #'evenp '(2 4 6 8 1 2 3 4 5)) (1 2 3 4 5) > (span #'evenp '(2 4 6 8 1 2 3 4 5)) ((2 4 6 8) (1 2 3 4 5)) > (span #'oddp '(2 4 6 8 1 2 3 4 5)) (NIL (2 4 6 8 1 2 3 4 5)) > (break-list #'evenp '(2 4 6 8 1 2 3 4 5)) (NIL (2 4 6 8 1 2 3 4 5)) > (break-list #'oddp '(2 4 6 8 1 2 3 4 5)) ((2 4 6 8) (1 2 3 4 5))
ところで、拙作のページ ISLisp 入門: ISLisp ドリル 問題 29 (pack) のような問題は、span を使うと簡単に解くことができます。次のリストを見てください。
リスト : pack の解答例
(defun pack (xs)
(if (null xs)
nil
(let ((ys (span (lambda (x) (eql (car xs) x)) xs)))
(cons (car ys) (pack (car (cdr ys)))))))
;;; 別解
(defun pack1 (xs)
(if (null xs)
nil
(let ((pred (lambda (x) (eql (car xs) x))))
(cons (take-while pred xs) (pack (drop-while pred xs))))))
pack1 は take-while と drop-while を使ったプログラムです。簡単な実行例を示します。
> (pack '(a b c d e)) ((A) (B) (C) (D) (E)) > (pack '(a a a b b c d d d d)) ((A A A) (B B) (C) (D D D D)) > (pack1 '(a b c d e)) ((A) (B) (C) (D) (E)) > (pack1 '(a a a b b c d d d d)) ((A A A) (B B) (C) (D D D D))
このほかにも、Easy-ISLisp のライブラリ list と seq には、Common Lisp ライクな高階関数が用意されています。興味のある方は Easy-ISLisp のドキュメントや拙作のページ リスト操作関数 (改訂版), 列関数 をお読みくださいませ。
●参考 URL
●プログラムリスト
リスト : 高階関数の使い方 (mymap.lsp)
(import "list")
(import "seq")
(defun evenp (n) (= (mod n 2) 0))
(defun oddp (n) (= (mod n 2) 1))
(defun xcons (a b) (cons b a))
;;; マップ関数
(defun mapcar1 (func xs)
(if (null xs)
nil
(cons (funcall func (car xs)) (mapcar1 func (cdr xs)))))
(defun maplist1 (func xs)
(if (null xs)
nil
(cons (funcall func xs) (maplist1 func (cdr xs)))))
(defun mapc1 (func xs)
(cond
((consp xs)
(funcall func (car xs))
(mapc1 func (cdr xs))))
xs)
(defun mapl1 (func xs)
(cond
((consp xs)
(funcall func xs)
(mapl1 func (cdr xs))))
xs)
(defun mapcan1 (func xs)
(if (null xs)
nil
(nconc (funcall func (car xs)) (mapcan1 func (cdr xs)))))
(defun mapcon1 (func xs)
(if (null xs)
nil
(nconc (funcall func xs) (mapcon1 func (cdr xs)))))
;;; 複数のリストを受け取る
(defun zip (&rest args)
(apply #'mapcar #'list args))
(defun map-with-index (func &rest args)
(let ((n (apply #'min (mapcar #'length args))))
(apply #'mapcar func (iota 0 (- n 1)) args)))
;;; パスカルの三角形
(defun pascal (n xs)
(print xs)
(if (<= (length xs) n)
(pascal n (maplist (lambda (ys)
(if (null (cdr ys)) 1 (+ (car ys) (car (cdr ys)))))
(cons 0 xs)))))
;;; 直積集合
(defun product (xs ys)
(mapcan (lambda (x) (mapcar (lambda (y) (list x y)) ys)) xs))
;;; 格子点
(defun lattice-point (&rest args)
(cond
((null args) (list '()))
((null (cdr args))
(mapcar (lambda (x) (list x)) (car args)))
(t
(mapcan (lambda (x) (mapcar (lambda (ys) (cons x ys))
(apply #'lattice-point (cdr args))))
(car args)))))
;;; エラトステネスの篩
(defun sieve (n xs ps)
(if (> (* (car xs) (car xs)) n)
(revappend ps xs)
(sieve n
(remove-if
(lambda (x) (= (mod x (car xs)) 0)) (cdr xs))
(cons (car xs) ps))))
(defun primes (n)
(sieve n (iota 2 n) nil))
;;; prefix scan
(defun scan-left (fn a xs)
(if (null xs)
(list a)
(cons a (scan-left fn (funcall fn (car xs) a) (cdr xs)))))
(defun scan-right (fn a xs)
(if (null xs)
(list a)
(let ((ys (scan-right fn a (cdr xs))))
(cons (funcall fn (car xs) (car ys)) ys))))
;;; take-while, drop-while
(defun take-while (pred xs)
(if (or (null xs)
(not (pred (car xs))))
'()
(cons (car xs) (take-while pred (cdr xs)))))
(defun drop-while (pred xs)
(if (or (null xs)
(not (pred (car xs))))
xs
(drop-while pred (cdr xs))))
(defun span (pred xs)
(if (or (null xs)
(not (pred (car xs))))
(list nil xs)
(let ((ys (span pred (cdr xs))))
(list (cons (car xs) (car ys))
(car (cdr ys))))))
(defun break-list (pred xs)
(if (or (null xs)
(pred (car xs)))
(list nil xs)
(let ((ys (break-list pred (cdr xs))))
(list (cons (car xs) (car ys))
(car (cdr ys))))))
;;; ISLisp ドリル 問題 28 と同じ
(defun pack (xs)
(if (null xs)
nil
(let ((ys (span (lambda (x) (eql (car xs) x)) xs)))
(cons (car ys) (pack (car (cdr ys)))))))
(defun pack1 (xs)
(if (null xs)
nil
(let ((pred (lambda (x) (eql (car xs) x))))
(cons (take-while pred xs) (pack (drop-while pred xs))))))