# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1473076426 0
# Node ID ba6e58d41e02eedbc81c968d55df4ad5b58792b7
# Parent  dc2c9931b634c9c5480e1d8f9c7ff5430da931dd
More SICP streams

diff -r dc2c9931b634 -r ba6e58d41e02 package.lisp
--- 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
diff -r dc2c9931b634 -r ba6e58d41e02 src/streams.lisp
--- 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)
+