[SICP][Lisp]ストリーム

SICP 3.5 ストリーム Common Lisp で実装したので、コードを貼っておこう。

遅延ストリーム・無限ストリームを使って、エラトステネスのふるいを作成し、素数を求めた。

(defmacro stream-cons (a b)
  `(cons ,a
  (delay ,b)))

(defun stream-car (s)
  (car s))

(defun stream-cdr (s)
  (force (cdr s)))

(defmacro delay (func)
  `#'(lambda () ,func))

(defun force (delay-obj)
  (funcall delay-obj))

(defvar +stream-empty+ (delay nil))

(defun stream-null? (s)
  (eq s +stream-empty+))

(defun stream-enumerate-interval (a b)
  (format t "[~a]~%" a b)
  (if (= a b)
      +stream-empty+
      (stream-cons a
     (stream-enumerate-interval (1+ a) b))))

(defun stream-each (func s)
  (unless (stream-null? s)
    (funcall func (stream-car s))
    (stream-each func (stream-cdr s))))

(defun stream-cadr (s)
  (stream-car (stream-cdr s)))

(defun stream-caddr (s)
  (stream-car (stream-cdr (stream-cdr s))))

(defun stream-nth (n s)
  (if (= n 0)
      (stream-car s)
      (stream-nth (1- n) (stream-cdr s))))

(defun stream-integers-starting-from (n)
  (stream-cons n
        (stream-integers-starting-from (1+ n))))

(defun stream-map (func &rest ss)
  (if (null (car ss))
      +stream-empty+
      (stream-cons
       (apply func (mapcar #'car ss))
       (apply #'stream-map (cons func (mapcar #'stream-cdr ss))))))

(defun stream-filter (pred s)
  (if (stream-null? s)
      +stream-empty+
      (if (funcall pred (car s))
   (stream-cons (car s)
         (stream-filter pred (stream-cdr s)))
   (stream-filter pred (stream-cdr s)))))

(defun stream-take (s n)
  (labels ((iter (s ts n)
      (if (= n 0)
   (reverse ts)
   (iter (stream-cdr s)
         (cons (stream-car s) ts)
         (1- n)))))
    (iter s '() n)))

(defun divisible? (x y)
  (= (mod x y) 0))

(defun sieve (stream)
  (stream-cons
   (stream-car stream)
   (sieve
    (stream-filter
     #'(lambda (x) (not (divisible? x (stream-car stream))))
     (stream-cdr stream)))))

sieve関数に2から始まる整数の無限ストリームを渡すと、最初の要素の値2と、2で割れる数を除外した無限ストリームを引数とするsieve関数の結果をconsしたものとなり、素数を表す無限ストリームが得られる。

実行例

最初の10個の素数を取得する。

CL-USER> (stream-take (sieve (stream-integers-starting-from 2)) 10) 
(2 3 5 7 11 13 17 19 23 29)

おおっ。素晴しい。

1000個目の素数を取得する。

CL-USER> (stream-nth 999 (sieve (stream-integers-starting-from 2)))
7919

楽しいねー。

 

10000個目の素数を取得する。

CL-USER> (stream-take (sieve (stream-integers-starting-from 2)) 9999) 
帰ってこない...

と思ったら、SBCL(swankサーバー側)でエラーとなっていて、 ヒープを使い尽していた。

fatal error encountered in SBCL pid 26815(tid 140737295218432):
Heap exhausted, game over.

ゲームオーバー...