X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=pipes-example.lisp;h=61d8d75ae649c0032d6a4dc63baf679433523f84;hb=HEAD;hp=c5722ec41034b26f28118bd02df71cc3626c7fa4;hpb=108cf113175bc41454b5b028d78fe00e67c37d83;p=pipes.git diff --git a/pipes-example.lisp b/pipes-example.lisp index c5722ec..61d8d75 100644 --- a/pipes-example.lisp +++ b/pipes-example.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: pipes-example.lisp,v 1.1 2002/11/02 17:49:10 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -17,24 +17,22 @@ (defun integers (&optional (start 0) end) - "a pipe of integers from START to END." (if (or (null end) (<= start end)) - (make-pipe start (integers (+ start 1) end)) + (make-pipe start (integers (+ start 1) end)) nil)) (defun fibgen (a b) - (make-pipe a (fibgen b (+ a b)))) + (make-pipe a (fibgen b (+ a b)))) (defun fibs () (fibgen 0 1)) -(defun divisible? (x y) +(defun divisible? (x y) (zerop (rem x y))) - (defun no-sevens () - (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers))) + (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers))) (defun sieve (stream) @@ -42,7 +40,7 @@ (pipe-head stream) (sieve (pipe-filter #'(lambda (x) - (not (divisible? x (pipe-head stream)))) + (not (divisible? x (pipe-head stream)))) (pipe-tail stream))))) (defun primes () @@ -56,58 +54,66 @@ (defun sum-pipe (sum s) (make-pipe sum - (sum-pipe (+ sum (pipe-head s)) - (pipe-tail s)))) + (sum-pipe (+ sum (pipe-head s)) + (pipe-tail s)))) (defun partial-sums (s) (make-pipe (pipe-head s) (sum-pipe 0 s))) (defun pi-summands (n) (make-pipe (/ 1d0 n) - (pipe-map #'- (pi-summands (+ n 2))))) + (pipe-map #'- (pi-summands (+ n 2))))) (defun pi-stream () - (scale-pipe 4d0 (partial-sums (pi-summands 1)))) + (scale-pipe 4d0 (partial-sums (pi-summands 1)))) (defun square (x) (* x x)) (defun euler-transform (s) - (let ((s0 (pipe-elt s 0)) - (s1 (pipe-elt s 1)) - (s2 (pipe-elt s 2))) - (if (and s0 s1 s2) - (if (eql s1 s2) ;;; series has converged - +empty-pipe+ - (make-pipe (- s2 (/ (square (- s2 s1)) - (+ s0 (* -2 s1) s2))) - (euler-transform (pipe-tail s)))) - +empty-pipe+))) - + (let ((s0 (pipe-elt s 0)) + (s1 (pipe-elt s 1)) + (s2 (pipe-elt s 2))) + (if (and s0 s1 s2) + (if (eql s1 s2) ;;; series has converged + +empty-pipe+ + (make-pipe (- s2 (/ (square (- s2 s1)) + (+ s0 (* -2 s1) s2))) + (euler-transform (pipe-tail s)))) + +empty-pipe+))) + (defun ln2-summands (n) - (pipe-map (/ 1d0 n) - (pipe-map #'- (ln2-summands (1+ n))))) + (make-pipe (/ 1d0 n) + (pipe-map #'- (ln2-summands (1+ n))))) (defun ln2-stream () (partial-sums (ln2-summands 1))) (defun make-tableau (transform s) (make-pipe s - (make-tableau transform - (funcall transform s)))) + (make-tableau transform + (funcall transform s)))) (defun accelerated-sequence (transform s) (pipe-map #'pipe-head - (make-tableau transform s))) + (make-tableau transform s))) (defun run-examples () (let ((*print-length* 20)) - (format t "~&pi-stream: ~S" - (pipe-display (pi-stream) 10)) - (format t "~&euler-transform: ~S" - (pipe-display (euler-transform (pi-stream)) 10)) - (format t "~&accelerate-sequence: ~S" - (pipe-display - (accelerated-sequence #'euler-transform (pi-stream)) 10)))) + (format t "~&pi-stream:~& ~S" + (pipe-values (pi-stream) 10)) + (format t "~& pi-stream euler-transform:~& ~S" + (pipe-values (euler-transform (pi-stream)) 10)) + (format t "~& pi-stream accelerate-sequence:~& ~S" + (pipe-values + (accelerated-sequence #'euler-transform (pi-stream)) 10))) + (format t "~&ln2-stream:~& ~S" + (pipe-values (ln2-stream) 10)) + (format t "~& ln2-stream euler-transform:~& ~S" + (pipe-values (euler-transform (ln2-stream)) 10)) + (format t "~& ln2-stream accelerate-sequence:~& ~S" + (pipe-values + (accelerated-sequence #'euler-transform (ln2-stream)) 10))) +