--- a/package.lisp Sun Sep 04 22:20:37 2016 +0000
+++ b/package.lisp Mon Sep 05 11:53:46 2016 +0000
@@ -19,7 +19,6 @@
#:cl-arrows
#:losh
#:iterate
- #:sand.graphviz
#:sand.quickutils
#:sand.utils)
(:export--- a/src/streams.lisp Sun Sep 04 22:20:37 2016 +0000
+++ b/src/streams.lisp Mon Sep 05 11:53:46 2016 +0000
@@ -37,6 +37,16 @@
(defun empty-stream ()
nil)
+(defmacro str* (&rest args)
+ (if (null (cdr args))
+ (car args)
+ `(scons ,(car args) (stream* ,@(cdr args)))))
+
+(defun str (&rest args)
+ (if (null args)
+ (empty-stream)
+ (scons (car args) (apply #'str (cdr args)))))
+
;;;; Stream Operations --------------------------------------------------------
(defun stream-nth (n stream)
@@ -44,11 +54,11 @@
(scar stream)
(stream-nth (1- n) (scdr stream))))
-(defun stream-map (function stream)
- (if (snullp stream)
+(defun stream-map (function &rest streams)
+ (if (some #'snullp streams)
(empty-stream)
- (scons (funcall function (scar stream))
- (stream-map function (scdr stream)))))
+ (scons (apply function (mapcar #'scar streams))
+ (apply #'stream-map function (mapcar #'scdr streams)))))
(defun stream-do (function stream)
(if (snullp stream)
@@ -59,11 +69,6 @@
(defun print-stream (stream)
(stream-do #'pr stream))
-(defun stream-range (low high)
- (if (> low high)
- (empty-stream)
- (scons low (stream-range (1+ low) high))))
-
(defun stream-filter (function stream)
(if (snullp stream)
(empty-stream)
@@ -81,18 +86,103 @@
(scdr stream)
(stream-drop (1- n) (scdr stream))))
+(defun stream-add (&rest streams)
+ (apply #'stream-map #'+ streams))
+
+(defun stream-mul (&rest streams)
+ (apply #'stream-map #'* streams))
+
+(defun stream-scale (factor stream)
+ (stream-map (curry #'* factor) stream))
+
+(defun stream-partial-sums (stream)
+ (scons (scar stream)
+ (stream-map (curry #'+ (scar stream))
+ (stream-partial-sums (scdr stream)))))
+
+
+;;;; Stream Creation ----------------------------------------------------------
+(defun stream-range (low high)
+ (if (> low high)
+ (empty-stream)
+ (scons low (stream-range (1+ low) high))))
+
+
+(defun integers-from (n)
+ (scons n (integers-from (1+ n))))
+
+(defun integers ()
+ (integers-from 0))
+
+
+(defun fibgen (a b)
+ (scons a (fibgen b (+ a b))))
+
+(defun fibonacci-numbers ()
+ (fibgen 0 1))
+
+
+(defun sieve (stream)
+ (let ((x (scar stream)))
+ (scons x (sieve
+ (stream-filter (lambda (n) (not (dividesp n x)))
+ (scdr stream))))))
+
+(defun primes ()
+ (sieve (integers-from 2)))
+
+
+(defparameter *primes%*
+ (scons 2 (stream-filter #'primep% (integers-from 3))))
+
+(defun primep% (n)
+ (recursively ((prime-stream *primes%*))
+ (cond
+ ((> (square (scar prime-stream)) n) t)
+ ((dividesp n (scar prime-stream)) nil)
+ (t (recur (scdr prime-stream))))))
+
;;;; Scratch ------------------------------------------------------------------
-(trace primep)
+; (trace primep)
+
+; (->> (stream-range 10000 1000000)
+; (stream-filter #'primep)
+; (stream-take 2)
+; print-stream)
+
+; (stream-nth 2 (stream-filter #'primep (stream-range 1 10)))
+
+; (untrace primep)
-(->> (stream-range 10000 1000000)
- (stream-filter #'primep)
- (stream-take 2)
- print-stream)
+(defparameter *ones*
+ (scons 1 *ones*))
+
+(defparameter *ints*
+ (scons 1 (stream-add *ones* *ints*)))
-(stream-nth 2 (stream-filter #'primep (stream-range 1 10)))
+(defparameter *fibs*
+ (str* 0 1 (stream-add *fibs* (scdr *fibs*))))
-(untrace primep)
+(defparameter *powers-of-two*
+ (scons 1 (stream-scale 2 *powers-of-two*)))
+
+(defparameter *factorials*
+ (scons 1 (stream-mul *factorials* (scdr (integers)))))
+; (->> *integers*
+; (stream-filter (lambda (i) (not (dividesp i 7))))
+; (stream-take 15)
+; print-stream)
+
+; (->> *factorials*
+; (stream-take 10)
+; print-stream)
+
+
+; (->> (stream-partial-sums (integers))
+; (stream-take 10)
+; print-stream)
+