前回まで作成した遅延ストリームは、stream-cons で遅延ストリームを生成するとき、ストリームの要素となる引数を評価していました。たとえば、(stream-cons (func x) ...) とすると、(func x) を評価した値がストリームの要素となります。ここで、ストリームにまだアクセスしていないのに、(func x) が評価されていることに注意してください。もし、(func x) がデータの入力処理だとすると、遅延ストリームを生成するときにデータをひとつ先読みしてしまうことになります。
そこで、コンスセルの CAR 部と CDR 部をまとめて遅延評価することにします。この場合、遅延オブジェクトが遅延ストリームを表すことになります。Scheme のライブラリ SRFI-40 はこの方法で遅延ストリームを実装しています。今回は SRFI-40 をもっと単純にした方法で遅延ストリームを作ってみましょう。
遅延ストリームを遅延オブジェクトで表す場合、その構造は次のようになります。
リスト : 遅延ストリーム
(defmacro stream-cons (a b)
`(delay (cons ,a ,b)))
(defun stream-car (s) (car (force s)))
(defun stream-cdr (s) (cdr (force s)))
;; 終端
(or (boundp 'stream-nil)
(defconstant stream-nil (delay nil)))
(defun stream-null (s) (null (force s)))
stream-cons は `(cons ,a (delay ,b)) ではなく `(delay (cons ,a ,b)) とします。これで stream-cons の引数 a, b が遅延評価されます。stream-car と stream-cdr は遅延ストリーム s を force で評価してから car と cdr を適用します。遅延ストリームは遅延オブジェクトで表すので、終端の定義を (delay '()) とし、定数 stream-nil に格納します。終端のチェックを行う述語は stream-null とし、遅延ストリーム s を force で評価してから null でチェックします。
ここで stream-null を評価すると、遅延ストリームが force されることに注意してください。たとえば、遅延ストリームを連結する stream-append を次のように定義すると問題が発生します。
リスト : 遅延ストリームの連結 (間違い版)
(defun stream-append-bad (s1 s2)
(if (stream-null s1)
s2
(stream-cons (stream-car s1)
(stream-append-bad (stream-cdr s1) s2))))
stream-append-bad でストリームを生成するとき、stream-null で s1 が force されることになります。つまり、新しいストリームを生成する前に引数のストリームが評価されてしまうのです。次の例を見てください。
* (setq s1 (stream-cons (progn (print "oops!") 1) stream-nil)) #S(PROMISE ...) * (setq s2 (stream-cons 2 stream-nil)) #S(PROMISE ...) * (setq s3 (stream-append-bad s1 s2)) "oops!" #S(PROMISE ...) * (stream-car s3) 1 * (stream-car (stream-cdr s3)) 2
S1 と S2 を連結した新しいストリーム S3 を評価していないにもかかわらず、引数のストリーム S1 が force されていることがわかります。この場合、stream-append の本体を delay と force で囲みます。
リスト : 遅延ストリームの連結 (修正版)
(defun stream-append (s1 s2)
(delay
(force
(if (stream-null s1)
s2
(stream-cons (stream-car s1)
(stream-append (stream-cdr s1) s2))))
delay と force で囲むのは無駄なように思いますが、これにより stream-append を評価して遅延ストリームを生成するとき、引数 S1 の遅延ストリームが force されずにすむわけです。
実際には、次に示すようなマクロを定義すると簡単です。
リスト : 式 expr の遅延ストリームを返す (defmacro stream-delay (expr) `(delay (force ,expr)))
リスト : 遅延ストリームの連結 (完成版)
(defun stream-append (s1 s2)
(stream-delay
(if (stream-null s1)
s2
(stream-cons (stream-car s1)
(stream-append (stream-cdr s1) s2)))))
簡単な実行例を示します。
* (setq s1 (stream-cons (progn (print "oops!") 1) stream-nil)) #S(PROMISE ...) * (setq s2 (stream-cons 2 stream-nil)) #S(PROMISE ...) * (setq s3 (stream-append s1 s2)) #S(PROMISE ...) * (stream-car s3) "oops!" 1 * (stream-car (stream-cdr s3)) 2
このように、stream-delay を使うことで、新しい遅延ストリームを生成するとき、引数のストリームが force されるのを防止することができます。
同様に stream-map や stream-filter など、遅延ストリームを受け取って新しい遅延ストリームを返す関数は stream-delay で囲む必要があります。詳細は プログラムリスト をお読みください。
それでは簡単な実行例として、素数を求めるプログラムで実行速度を比較してみましょう。
リスト : 素数を求める [追記 (2020/04/18)]
(defvar *primes* (stream-cons 2 (stream-cons 3 (stream-cons 5 (primes-from 7)))))
(defun primep (n)
(every (lambda (p) (/= (mod n p) 0))
(stream-to-list (stream-take-while (lambda (p) (<= (* p p) n)) *primes*))))
(defun primes-from (n)
(if (primep n)
(stream-cons n (primes-from (+ n 2)))
(primes-from (+ n 2))))
素数列 primes の定義は 遅延ストリーム (2) で作成したものと同じです。(stream-ref primes 10000) の実行時間を求めたところ、結果は次のようになりました。
lazys.l : 0.324 秒 lazys2.l : 0.475 秒 実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz, sbcl version 1.4.5
今回の遅延ストリームのほうが少し遅くなりました。興味のある方はいろいろ試してみてください。
関数 primp は stream-take-while で新しい遅延ストリームを生成し、さらに stream-to-list でリストに変換しているので、実行時間はとても遅くなります。次のように、遅延ストリームをたどって判定したほうが速くなります。
リスト : 素数の判定
(defun primep (n &optional (ps (stream-cdr *primes*)))
(let ((p (stream-car ps)))
(cond
((> (* p p) n) t)
((zerop (mod n p)) nil)
(t (primep n (stream-cdr ps))))))
実行結果は次のようになりました。
(stream-ref *primes* 10000) lazys.l : 0.040 秒 lazys2.l : 0.055 秒 (stream-ref *primes* 100000) lazys.l : 0.883 秒 lazys2.l : 0.987 秒 実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz, sbcl version 1.4.5
;;;
;;; lazys2.l : 遅延評価と遅延ストリーム
;;;
;;; Copyright (C) 2017-2020 Makoto Hiroi
;;;
;;;
;;; 遅延評価
;;;
;;; プロミスの定義
(defstruct promise (result nil) thunk)
(defmacro delay (expr)
`(make-promise :thunk (lambda () ,expr)))
(defun force (ps)
(when (promise-thunk ps)
(setf (promise-result ps) (funcall (promise-thunk ps))
(promise-thunk ps) nil))
(promise-result ps))
;;;
;;; 遅延ストリーム
;;;
;;; 遅延ストリームの生成
;;; 遅延オブジェクトでストリームを表す
(defmacro stream-cons (a b)
`(delay (cons ,a ,b)))
(defun stream-car (s) (car (force s)))
(defun stream-cdr (s) (cdr (force s)))
;;; 終端
(or (boundp 'stream-nil)
(defconstant stream-nil (delay nil)))
(defun stream-null (s) (null (force s)))
(defmacro stream-delay (expr)
`(delay (force ,expr)))
;;; 整数列を生成
(defun range (low high &optional (step 1))
(if (> low high)
stream-nil
(stream-cons low (range (+ low step) high))))
;;; フィボナッチ数列
(defun fibonacci (a b)
(stream-cons a (fibonacci b (+ a b))))
;;; 無限ストリームの生成
(defun stream-unfold (iterate seed &optional (pred (lambda (x) (declare (ignore x)) nil)))
(if (funcall pred seed)
stream-nil
(stream-cons seed (stream-unfold iterate (funcall iterate seed) pred))))
;; リストを遅延ストリームに変換
(defun list-to-stream (xs)
(if (null xs)
stream-nil
(stream-cons (car xs) (list-to-stream (cdr xs)))))
;;; 有限ストリームをリストに変換
(defun stream-to-list (s)
(loop until (stream-null s) collect (stream-car s)
do (setq s (stream-cdr s))))
;;; n 番目の要素を求める
(defun stream-ref (s n)
(if (zerop n)
(stream-car s)
(stream-ref (stream-cdr s) (1- n))))
;;; 先頭から n 個の要素を取り出す
(defun stream-take (s n)
(stream-delay
(if (or (stream-null s) (zerop n))
stream-nil
(stream-cons (stream-car s) (stream-take (stream-cdr s) (1- n))))))
;;; 先頭から n 個の要素を取り除く
(defun stream-drop (s n)
(if (or (stream-null s) (zerop n))
s
(stream-drop (stream-cdr s) (1- n))))
;;; ストリームの結合
(defun stream-append (s1 s2)
(stream-delay
(if (stream-null s1)
s2
(stream-cons (stream-car s1)
(stream-append (stream-cdr s1) s2)))))
(defun interleave (s1 s2)
(stream-delay
(if (stream-null s1)
s2
(stream-cons (stream-car s1)
(interleave s2 (stream-cdr s1))))))
;;; 遅延評価版
(defun stream-append-delay (s1 s2)
(stream-delay
(if (stream-null s1)
(force s2)
(stream-cons (stream-car s1)
(stream-append-delay (stream-cdr s1) s2)))))
(defun interleave-delay (s1 s2)
(stream-delay
(if (stream-null s1)
(force s2)
(stream-cons (stream-car s1)
(interleave-delay (force s2) (cdr s1))))))
;;;
;;; 高階関数
;;;
;;; マップ関数
(defun stream-map (proc &rest s)
(stream-delay
(if (member-if #'stream-null s)
stream-nil
(stream-cons (apply proc (mapcar #'stream-car s))
(apply #'stream-map proc (mapcar #'stream-cdr s))))))
(defun stream-flatmap (proc s)
(stream-delay
(if (stream-null s)
stream-nil
(stream-append-delay (funcall proc (stream-car s))
(delay (stream-flatmap proc (stream-cdr s)))))))
;;; フィルター
(defun stream-filter (pred s)
(stream-delay
(cond
((stream-null s) stream-nil)
((funcall pred (stream-car s))
(stream-cons (stream-car s)
(stream-filter pred (stream-cdr s))))
(t (stream-filter pred (stream-cdr s))))))
;;; 畳み込み
(defun stream-fold-left (proc a s)
(if (stream-null s)
a
(stream-fold-left proc (funcall proc a (stream-car s)) (stream-cdr s))))
(defun stream-fold-right (proc a s)
(if (stream-null s)
a
(funcall proc (stream-car s) (stream-fold-right proc a (stream-cdr s)))))
;;; 巡回
(defun stream-for-each (proc s)
(unless (stream-null s)
(funcall proc (stream-car s))
(stream-for-each proc (stream-cdr s))))
;;;
(defun stream-take-while (pred s)
(stream-delay
(if (not (funcall pred (stream-car s)))
stream-nil
(stream-cons (stream-car s)
(stream-take-while pred (stream-cdr s))))))
;;;
(defun stream-drop-while (pred s)
(stream-delay
(if (not (funcall pred (stream-car s)))
s
(stream-drop-while pred (stream-cdr s)))))
;;; 遅延ストリームの併合
(defun stream-merge (s1 s2)
(stream-delay
(cond
((stream-null s1) s2)
((stream-null s2) s1)
((<= (stream-car s1) (stream-car s2))
(stream-cons (stream-car s1) (stream-merge (stream-cdr s1) s2)))
(t
(stream-cons (stream-car s2) (stream-merge s1 (stream-cdr s2)))))))
;;;
;;; 集合演算
;;;
;; 和集合
(defun stream-union (s1 s2)
(stream-delay
(cond
((stream-null s1) s2)
((stream-null s2) s1)
((= (stream-car s1) (stream-car s2))
(stream-cons (stream-car s1)
(stream-union (stream-cdr s1) (stream-cdr s2))))
((< (stream-car s1) (stream-car s2))
(stream-cons (stream-car s1)
(stream-union (stream-cdr s1) s2)))
(t
(stream-cons (stream-car s2)
(stream-union s1 (stream-cdr s2)))))))
;;; 積集合
(defun stream-intersect (s1 s2)
(stream-delay
(cond
((or (stream-null s1) (stream-null s2)) stream-nil)
((= (stream-car s1) (stream-car s2))
(stream-cons (stream-car s1)
(stream-intersect (stream-cdr s1) (stream-cdr s2))))
((< (stream-car s1) (stream-car s2))
(stream-intersect (stream-cdr s1) s2))
(t
(stream-intersect s1 (stream-cdr s2))))))
;;; ハミングの問題
(defvar *hs*)
(setq *hs*
(stream-cons
1
(stream-union
(stream-map (lambda (x) (* x 2)) *hs*)
(stream-union (stream-map (lambda (x) (* x 3)) *hs*)
(stream-map (lambda (x) (* x 5)) *hs*)))))
;;; 素数の生成
(defun sieve (s)
(stream-cons (stream-car s)
(sieve (stream-filter (lambda (x) (/= (mod x (stream-car s)) 0))
(stream-cdr s)))))
;;; 別解
(declaim (ftype (function (integer) t) primes-from))
(defvar *primes* (stream-cons 2 (stream-cons 3 (stream-cons 5 (primes-from 7)))))
(defun primep (n)
(every (lambda (p) (/= (mod n p) 0))
(stream-to-list (stream-take-while (lambda (p) (<= (* p p) n)) *primes*))))
(defun primes-from (n)
(if (primep n)
(stream-cons n (primes-from (+ n 2)))
(primes-from (+ n 2))))
;;; 順列の生成
(defun make-perm (n s)
(if (zerop n)
(stream-cons nil stream-nil)
(stream-flatmap
(lambda (x)
(stream-map (lambda (y) (cons x y))
(make-perm (1- n)
(stream-filter (lambda (z) (not (eql x z))) s))))
s)))
;;; 8 Queen の解法
(defun attack (q xs &optional (n 1))
(cond
((null xs) nil)
((or (= (+ q n) (car xs)) (= (- q n) (car xs))) t)
(t (attack q (cdr xs) (1+ n)))))
(defun queen (s)
(stream-delay
(if (stream-null s)
(stream-cons nil stream-nil)
(stream-filter
(lambda (ls)
(if (null ls)
t
(not (attack (car ls) (cdr ls)))))
(stream-flatmap
(lambda (x)
(stream-map (lambda (y) (cons x y))
(queen (stream-filter (lambda (z) (not (eql x z))) s))))
s)))))
;;; 木の巡回 (リストを木としてみる)
(defun stream-of-tree (ls cont)
(cond
((null ls) (funcall cont))
((atom ls)
(stream-cons ls (funcall cont)))
(t
(stream-of-tree
(car ls)
(lambda ()
(stream-of-tree
(cdr ls)
(lambda () (funcall cont))))))))
;;; ツリーマッチング
(defun same-fringe-p (tree1 tree2 &key (test #'eql))
(labels
((iter (s1 s2)
(cond
((and (stream-null s1) (stream-null s2)) t)
((or (stream-null s1) (stream-null s2)) nil)
((funcall test (stream-car s1) (stream-car s2))
(iter (stream-cdr s1) (stream-cdr s2)))
(t nil))))
(iter (stream-of-tree tree1 (lambda () stream-nil))
(stream-of-tree tree2 (lambda () stream-nil)))))
;;; 組 (pair) の生成
(defun pair-stream (s1 s2)
(stream-flatmap
(lambda (x)
(stream-map (lambda (y) (list x y)) s2))
s1))
(defun pair-stream1 (s1 s2 &optional (n 1))
(stream-delay
(let ((ys (list-to-stream (nreverse (stream-to-list (stream-take s2 n))))))
(stream-append-delay
(stream-map (lambda (x y) (list x y)) (stream-take s1 n) ys)
(delay (pair-stream1 s1 s2 (1+ n)))))))
前回は Scheme のライブラリ SRFI-40 を単純化した遅延ストリームを作成しましたが、Common Lisp にも遅延評価や遅延ストリームを扱うためのライブラリ (パッケージ) がいくつか公開されています。ここでは、参考文献 2 付録 A の「シリーズ (series)」を取り上げます。
シリーズは Richard C. Waters 氏が開発された Common Lisp 用のパッケージです。参考文献 2 付録 A によると、『シリーズ (series) は列によく似たデータ構造で、列と同種の操作を行うことができる。』『シリーズは、ストリームのように非有界な要素の集合を表現でき、遅延評価を提供している。シリーズの各要素は、それが必要とされるまで計算されることはない。』とのことです。
なお、今まで説明した遅延ストリームとシリーズでは使い方が大きく異なります。M.Hiroi は勉強不足でシリーズをまだよく理解していませんが、関数型言語の遅延ストリームのような使い方、たとえば再帰的に数列を定義することはできないと思います。それでも、便利な関数が多数用意されているので、無限ストリームだけではなく、いろいろなケースで使うことができるのではないかと思っています。今回は実際にシリーズを試してみましょう。
シリーズのインストールは Quicklisp を使うと簡単です。Quicklisp は Zach Beane 氏が開発された Common Lisp 用のパッケージ管理ツールです。Web サイト Quicklisp beta からファイル quicklisp.lisp をダウンロードし、REPL で以下のコマンドを実行するとインストールすることができます。
(load "quicklisp.lisp") (quicklisp-quickstart:install) (ql:add-to-init-file)
Quicklisp の説明は次のページが参考になると思います。
有益な情報を公開されている作者の皆様に感謝いたします。
あとは REPL で (ql:quickload :series) を実行すると、シリーズをダウンロードしてインストールすることができます。
シリーズを使うときは (require :series) でパッケージをロードしてください。series:関数名 でシリーズの関数を使用することができます。また、(use-package :series) を実行すると、series: を省略することができます。
* (require :series) NIL * (series:scan (list 1 2 3)) #Z(1 2 3) * (use-package :series) T * (scan (list 1 2 3)) #Z(1 2 3)
シリーズは #Z(...) で表記されます。(series::install) を実行すると、REPL で #Z(...) を入力することができます。
* (series::install) T * #Z(1 2 3) #Z(1 2 3)
関数 series は引数を無限に繰り返すシリーズを返します。make-series は引数を格納したシリーズを返します。関数 scan は引数 (sequence) をシリーズに変換します。
series arg &rest args make-series arg &rest args scan sequence scan type sequence
scan の引数 type は列の型を指定します。省略された場合は list になります。
簡単な実行例を示します。
* (subseries (series 1 2 3 4 5) 0 15) #Z(1 2 3 4 5 1 2 3 4 5 1 2 3 4 5) * (make-series 1 2 3 4 5) #Z(1 2 3 4 5) * (scan '(a b c d e f)) #Z(A B C D E F) * (scan 'vector #(1 2 3 4 5)) #Z(1 2 3 4 5)
関数 subseries は列関数 subseq のシリーズバージョンです。
数列の生成は関数 scan-range を使うと簡単です。
scan-range &key (:from 0) (:by 1) (:type 'number) :upto :below :downto :above :length
scan-range は :from から :by 刻みの数列 (シリーズ) を返します。:upto, :below, :downto, :above, :length は終了条件を指定します。終了条件が無い場合は無限列になります。
簡単な実行例を示します。
* (scan-range :from 1 :upto 10) #Z(1 2 3 4 5 6 7 8 9 10) * (scan-range :from 10 :by -1 :downto 0) #Z(10 9 8 7 6 5 4 3 2 1 0) * (scan-range :length 10) #Z(0 1 2 3 4 5 6 7 8 9)
もっと複雑なシリーズを生成する場合は高階関数 scan-fn を使います。
scan-fn type init step &optional test
init は初期値を与える関数、step は前項から次項を生成する関数、test は終了条件を表す述語です。type は init と step の返すデータ型を表します。init と step は多値を返すこともできます。その場合、返す値の数だけシリーズが生成されます。このとき、type は values 型指定子で複数の型を指定してください。
簡単な実行例を示します。
* (scan-fn t (lambda () 1) #'1+ (lambda (x) (> x 20))) #Z(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) * (scan-fn '(values integer integer) (lambda () (values 0 1)) (lambda (a b) (values b (+ a b))) (lambda (a b) (> (+ a b) 10000))) #Z(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584) #Z(1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)
このほかにも、シリーズを生成する関数はいろいろ用意されています。詳しくはリファレンス series | Quickdocs をお読みください。
シリーズの入力を元に、シリーズではない出力を生成する関数を「集積関数 (collector)」といいます。シリーズの要素を取り出す操作は集積関数として定義されています。
collect-frist items &optional (default nil) collect-last items &optional (default nil) collect-nth n items &optional (default nil)
collect-first は先頭要素を、collect-last は末尾の要素を、collect-nth は n 番目の要素を取り出して返します。要素がない場合は default の値が返されます。default が指定されていない場合は nil が返されます。
簡単な実行例を示します。
* (collect-first #Z(1 2 3 4 5)) 1 * (collect-last #Z(1 2 3 4 5)) 5 * (collect-nth 0 #Z(1 2 3 4 5)) 1 * (collect-nth 4 #Z(1 2 3 4 5)) 5 * (collect-nth 5 #Z(1 2 3 4 5)) NIL
シリーズの長さは collect-length で求めることができます。
* (collect-length #Z(1 2 3 4 5)) 5 * (collect-length #Z()) 0
collect-sum はシリーズの合計値を、collect-max, collect-min は最大値と最小値を求めます。
* (collect-sum #Z(1 2 3 4 5 6 7 8 9 10)) 55 * (collect-max #Z(1 2 3 4 5 6 7 8 9 10)) 10 * (collect-min #Z(1 2 3 4 5 6 7 8 9 10)) 1 * (collect-min #Z()) NIL
関数 collect はシリーズを他のデータ型に変換します。
collect items collect type items
引数 type は変換するデータ型を指定します。type を省略すると list になります。
* (collect #Z(1 2 3 4 5)) (1 2 3 4 5) * (collect 'vector #Z(1 2 3 4 5)) #(1 2 3 4 5)
collect-append はシリーズの要素 (列型) を連結した新しい列を返します。
collect-append items collect-append type items
引数 type は変換するデータ型を指定します。type を省略すると list になります。
* (collect-append #Z((1 2) (3 4) (5 6))) (1 2 3 4 5 6) * (collect-append 'vector #Z((1 2) (3 4) (5 6))) #(1 2 3 4 5 6) * (collect-append 'vector #Z(#(1 2) #(3 4) #(5 6))) #(1 2 3 4 5 6)
高階関数 collect-fn はシリーズの畳み込みを行います。
collect-fn type init function &rest items
init は初期値を与える関数、function は 2 引数の関数で、第 1 引数が累積変数、第 2 引数がシリーズの要素になります。引数 type は function が返す値のデータ型を指定します。
* (collect-fn 'integer (lambda () 0) #'+ #Z(1 2 3 4 5 6 7 8 9 10)) 55 * (collect-fn 'list (lambda () nil) (lambda (a x) (cons x a)) #Z(1 2 3 4 5 6 7 8 9 10)) (10 9 8 7 6 5 4 3 2 1)
複数のシリーズを受け取るときは、init と function に多値を返す関数を指定します。この場合、scan-fn と同様に、type は values 型指定子で複数のデータ型を指定します。function の引数ですが、受け取るシリーズの個数が m 個とすると、最初に m 個の累積変数が渡され、そのあとに m 個のシリーズの要素が渡されます。
簡単な実行例を示します。
* (collect-fn '(values integer integer) (lambda () (values 0 0)) (lambda (a b x y) (values (+ a x) (+ b y))) #Z(1 2 3 4) #Z(5 6 7 8)) 10 26
なお、引数のシリーズが 1 つでも、init と function に多値を返す関数を指定することができます。この場合も function に渡される引数は累積変数が先で最後にシリーズの要素が渡されます。ようするに、init や function の返り値が次の function の呼び出し時の引数 (累積変数) に渡されるわけです。
簡単な実行例を示します。
* (collect-fn '(values integer integer) (lambda () (values 0 0)) (lambda (s n x) (values (+ s x) (1+ n))) #Z(1 2 3 4 5 6 7 8 9 10)) 55 10
このように、要素の個数と合計値を同時に求めることができます。
このほかにも、いろいろな集積関数が用意されています。詳しくはリファレンス series | Quickdocs をお読みくださいませ。
高階関数 map-fn はマッピングを行います。
map-fn type function &rest items
type は function が返す値のデータ型を指定します。もし、function が m 個の値を返すならば、map-fn は m 個のシリーズを返します。
簡単な実行例を示します。
* (map-fn 'integer (lambda (x) (* x x)) #Z(1 2 3 4 5 6 7 8 9 10)) #Z(1 4 9 16 25 36 49 64 81 100) * (map-fn t #'+ #Z(1 2 3 4 5) #Z(6 7 8 9 10)) #Z(7 9 11 13 15) * (map-fn '(values integer rational) #'floor #Z(3/2 8/3 16/5)) #Z(1 2 3) #Z(1/2 2/3 1/5)
なお、map-fn には略記法があって、map-fn t #'function は #Mfunction と記述することができます。ただし、(series::install) を評価しないと #M を使うことはできません。ご注意ください。
* (#M(lambda (x) (* x x)) #Z(1 2 3 4 5 6 7 8 9 10)) #Z(1 4 9 16 25 36 49 64 81 100) * (#M+ #Z(1 2 3 4 5) #Z(6 7 8 9 10)) #Z(7 9 11 13 15) * (#Mcons #Z(1 2 3 4 5) #Z(6 7 8 9 10)) #Z((1 . 6) (2 . 7) (3 . 8) (4 . 9) (5 . 10))
#Mfunction が使える場所はリストの先頭 (関数の位置) だけです。
シリーズには map-fn を簡単に使用するためのマクロ mapping が用意されています。
(mapping ((x r) (y s)) ...) ≡ (map-fn t (lambda (x y) ...) r s)
* (mapping ((x (scan-range :upto 10))) (* x x)) #Z(0 1 4 9 16 25 36 49 64 81 100)
mapping はシリーズを返しますが、シリーズを作らずに nil を返すマクロ iterate も用意されています。
* (iterate ((x (scan-range :upto 10))) (print (* x x))) 0 1 4 9 16 25 36 49 64 81 100 NIL
フィルターは関数 choose または高階関数 choose-if を使います。
choose bools &optional (items bools) choose-if pred items
choose の引数 bools は真偽値を格納したシリーズで、j 番目が nil であれば items の j 番目の要素を削除します。bools の長さ l が items よりも短い場合、items の l 版明光の要素はすべて削除されます。choose-if は列関数 remove-if-not のシリーズバージョンです。
簡単な実行例を示します。
* (choose #Z(t nil t nil t) #Z(1 2 3 4 5 6)) #Z(1 3 5) * (choose-if #'evenp #Z(1 2 3 4 5 6 7 8 9 10)) #Z(2 4 6 8 10)
マッピングのように、シリーズから新しいシリーズを計算する関数を「変換関数 (transducer)」といいます。シリーズにはマッピングやフィルター以外にもいろいろな変換関数が用意されています。
cotruncate &rest items until bools &rest items until-if pred &&rest items
引数のシリーズで最短の長さを k とします。cotruncate はシリーズの長さを k に揃えた新しいシリーズを返します。真偽値を格納したシリーズ bools において、nil ではない最初の要素の位置を k' とします。until はシリーズの長さを (min k k') に揃えます。第 1 引数のシリーズで述語 pred が真を返すまでの長さを k'' とします。until-if はシリーズの長さを (min k k'') に揃えます。
簡単な実行例を示します。
* (cotruncate #Z(1 2 3) #Z(4 5) #Z(6 7 8 9)) #Z(1 2) #Z(4 5) #Z(6 7) * (until #Z(nil nil t nil) #Z(1 2 3 4 5) #Z(6 7 8 9)) #Z(1 2) #Z(6 7) * (until-if #'minusp #Z(1 2 3 4 -1) #Z(5 6 7 8 9 10)) #Z(1 2 3 4) #Z(5 6 7 8)
関数 catenate は複数のシリーズを連結した新しいシリーズを返します。
catenate &rest items
* (catenate #Z(1 2 3 4 5) #Z(6 7 8 9 10)) #Z(1 2 3 4 5 6 7 8 9 10) * (catenate #Z(1 2 3 4 5) #Z() #Z(6 7 8 9 10)) #Z(1 2 3 4 5 6 7 8 9 10)
関数 mingle は 2 つのシリーズの要素を混合した新しいシリーズを返します。
mingle items1 items2 comparator
mingle は items1 の要素 x と items2 の要素 y を (comparator x y) で比較して、真を返す場合は x を、偽を返す場合は y を新しいシリーズに格納します。もし、シリーズが comparator の順序で整列されていれば、mingle はマージと同じ結果になります。
* (mingle #Z(1 3 5 7 9) #Z(2 4 6 8 10) #'<) #Z(1 2 3 4 5 6 7 8 9 10) * (mingle #Z(9 2 5 3 1) #Z(2 4 6 8 10) #'<) #Z(2 4 6 8 9 2 5 3 1 10)
高階関数 collecting-fn は collect-fn とよく似ていますが、シリーズを返すところが異なります。
collecting-fn type init function &rest items
collecting-fn は function の返り値を格納したシリーズを返します。function が多値を返す場合、その数だけシリーズを生成して返します。
簡単な実行例を示します。
* (collecting-fn 'integer (lambda () 0) (lambda (a x) (+ a x)) (scan-range :from 1 :upto 20)) #Z(1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210) * (collecting-fn 'integer (lambda () 1) (lambda (a x) (* a x)) (scan-range :from 1 :upto 20)) #Z(1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 6227020800 87178291200 1307674368000 20922789888000 355687428096000 6402373705728000 121645100408832000 2432902008176640000) * (collecting-fn '(values integer integer) (lambda () (values 0 0)) (lambda (s n x) (values (+ s x) (1+ n))) (scan-range :from 1 :upto 20)) #Z(1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210) #Z(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
このほかにも、シリーズにはいろいろな関数が用意されています。詳しくはリファレンス series | Quickdocs をお読みください。
パッケージ series には 参考文献 1 付録 B に記述されている「ジェネレータ (generator)」と「ギャザラ (gather)」も含まれています。関数 generator はシリーズをジェネレータに変換し、マクロ next-in を使って要素を一つずつ取り出すことができます。
generator items next-in gen [action]
next-in でジェネレータ gen が空の場合、action で指定された S 式を実行します。action が指定されていない場合はエラーが送出されます。
簡単な実行例を示します。
* (let ((g (generator (scan-range :from 1 :upto 10)))) (loop (print (next-in g (return))))) 1 2 3 4 5 6 7 8 9 10 NIL
ギャザラはシリーズに要素を追加して、指定した集積関数で結果を求める機能です。
gatherer collector next-out gatherer item result-of gatherer
関数 gatherer はギャザラを生成します。このとき、シリーズの集積関数 collector を指定します。関数 next-out は item を gatherer に追加します。reuslt-of は集積関数を評価して結果を求めます。
* (let ((g (gatherer #'collect))) (dotimes (x 10 (result-of g)) (next-out g x))) (0 1 2 3 4 5 6 7 8 9) * (let ((g (gatherer #'collect-sum))) (dotimes (x 10 (result-of g)) (next-out g (* x x)))) 285
リスト : FizzBuzz 問題
(defun change (n)
(cond ((zerop (mod n 15)) "FizzBuzz")
((zerop (mod n 3)) "Fizz")
((zerop (mod n 5)) "Buzz")
(t (format nil "~D" n))))
(defun fizzbuzz ()
(#Mchange (scan-range :from 1 :upto 100)))
;; 別解
(defun fizzbuzz1 ()
(#M(lambda (x y z) (let ((s (concatenate 'string x y)))
(if (string= s "") (format nil "~D" z) s)))
(series "" "" "Fizz")
(series "" "" "" "" "Buzz")
(scan-range :from 1 :upto 100)))
* (fizzbuzz1)
#Z("1" "2" "Fizz" "4" "Buzz" "Fizz" "7" "8" "Fizz" "Buzz" "11" "Fizz" "13" "14"
"FizzBuzz" "16" "17" "Fizz" "19" "Buzz" "Fizz" "22" "23" "Fizz" "Buzz" "26" "Fizz"
"28" "29" "FizzBuzz" "31" "32" "Fizz" "34" "Buzz" "Fizz" "37" "38" "Fizz" "Buzz"
"41" "Fizz" "43" "44" "FizzBuzz" "46" "47" "Fizz" "49" "Buzz" "Fizz" "52" "53"
"Fizz" "Buzz" "56" "Fizz" "58" "59" "FizzBuzz" "61" "62" "Fizz" "64" "Buzz" "Fizz"
"67" "68" "Fizz" "Buzz" "71" "Fizz" "73" "74" "FizzBuzz" "76" "77" "Fizz" "79"
"Buzz" "Fizz" "82" "83" "Fizz" "Buzz" "86" "Fizz" "88" "89" "FizzBuzz" "91" "92"
"Fizz" "94" "Buzz" "Fizz" "97" "98" "Fizz" "Buzz")
リスト : 三角数と四角数 (defun triangular () (map-fn 'integer (lambda (x) (/ (* x (1+ x)) 2)) (scan-range :from 1))) (defun square () (map-fn 'integer (lambda (x) (* x x)) (scan-range :from 1)))
* (subseries (triangular) 0 20) #Z(1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210) * (subseries (square) 0 20) #Z(1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 400)
リスト : 三角錐数と四角錐数 (defun triangular-pyramidal () (collecting-fn 'integer (lambda () 0) #'+ (triangular))) (defun square-pyramidal () (collecting-fn 'integer (lambda () 0) #'+ (square)))
* (subseries (triangular-pyramidal) 0 20) #Z(1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540) * (subseries (square-pyramidal) 0 20) #Z(1 5 14 30 55 91 140 204 285 385 506 650 819 1015 1240 1496 1785 2109 2470 2870)
リスト : フィボナッチ数列
(defun fibonacci ()
(scan-fn '(values integer integer)
(lambda () (values 0 1))
(lambda (a b) (values b (+ a b)))))
* (subseries (fibonacci) 0 40) #Z(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986)
* (collect-last (until-if (lambda (x) (> x 300000000)) (fibonacci))) 267914296
* (collect-sum (until-if (lambda (x) (> x 300000000)) (fibonacci))) 701408732
* (collect-sum (choose-if #'evenp (until-if (lambda (x) (> x 300000000)) (fibonacci)))) 350704366
リスト : 素数
(defun primep (n ps)
(do ((ps ps (cdr ps)))
((> (* (car ps) (car ps)) n) t)
(if (zerop (mod n (car ps)))
(return))))
(defun primes (n)
(collect-fn 'list
(lambda () (list 2))
(lambda (ps x) (if (primep x ps) (append ps (list x)) ps))
(scan-range :from 3 :by 2 :upto n)))
* (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 500) (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)