-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
-;;;; *************************************************************************\r
-;;;; FILE IDENTIFICATION\r
-;;;;\r
-;;;; Name: pipes-examples.lisp\r
-;;;; Purpose: Pipe examples\r
-;;;; Programmer: Kevin M. Rosenberg\r
-;;;; Date Started: Apr 2000\r
-;;;;\r
-;;;; $Id: pipes-example.lisp,v 1.3 2003/03/15 00:48:56 kevin Exp $\r
-;;;;\r
-;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg\r
-;;;;\r
-;;;; *************************************************************************\r
-\r
-(in-package #:pipes-user)\r
-\r
-\r
-(defun integers (&optional (start 0) end)\r
- (if (or (null end) (<= start end))\r
- (make-pipe start (integers (+ start 1) end))\r
- nil))\r
-\r
-(defun fibgen (a b)\r
- (make-pipe a (fibgen b (+ a b))))\r
-\r
-(defun fibs ()\r
- (fibgen 0 1))\r
-\r
-\r
-(defun divisible? (x y) \r
- (zerop (rem x y)))\r
-\r
-(defun no-sevens ()\r
- (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers)))\r
-\r
-\r
-(defun sieve (stream)\r
- (make-pipe\r
- (pipe-head stream)\r
- (sieve (pipe-filter\r
- #'(lambda (x)\r
- (not (divisible? x (pipe-head stream))))\r
- (pipe-tail stream)))))\r
-\r
-(defun primes ()\r
- (sieve (integers 2)))\r
-\r
-\r
-;; Pi\r
-\r
-(defun scale-pipe (factor pipe)\r
- (pipe-map #'(lambda (x) (* x factor)) pipe))\r
-\r
-(defun sum-pipe (sum s)\r
- (make-pipe sum\r
- (sum-pipe (+ sum (pipe-head s))\r
- (pipe-tail s))))\r
-\r
-(defun partial-sums (s)\r
- (make-pipe (pipe-head s) (sum-pipe 0 s)))\r
-\r
-(defun pi-summands (n)\r
- (make-pipe (/ 1d0 n)\r
- (pipe-map #'- (pi-summands (+ n 2)))))\r
-\r
-(defun pi-stream ()\r
- (scale-pipe 4d0 (partial-sums (pi-summands 1))))\r
-\r
-(defun square (x)\r
- (* x x))\r
-\r
-(defun euler-transform (s)\r
- (let ((s0 (pipe-elt s 0))\r
- (s1 (pipe-elt s 1)) \r
- (s2 (pipe-elt s 2)))\r
- (if (and s0 s1 s2)\r
- (if (eql s1 s2) ;;; series has converged \r
- +empty-pipe+\r
- (make-pipe (- s2 (/ (square (- s2 s1))\r
- (+ s0 (* -2 s1) s2)))\r
- (euler-transform (pipe-tail s))))\r
- +empty-pipe+)))\r
-\r
-\r
-(defun ln2-summands (n)\r
- (make-pipe (/ 1d0 n)\r
- (pipe-map #'- (ln2-summands (1+ n)))))\r
-\r
-(defun ln2-stream ()\r
- (partial-sums (ln2-summands 1)))\r
-\r
-(defun make-tableau (transform s)\r
- (make-pipe s\r
- (make-tableau transform\r
- (funcall transform s))))\r
-\r
-(defun accelerated-sequence (transform s)\r
- (pipe-map #'pipe-head\r
- (make-tableau transform s)))\r
-\r
-\r
-(defun run-examples ()\r
- (let ((*print-length* 20))\r
- (format t "~&pi-stream:~& ~S"\r
- (pipe-values (pi-stream) 10))\r
- (format t "~& pi-stream euler-transform:~& ~S"\r
- (pipe-values (euler-transform (pi-stream)) 10))\r
- (format t "~& pi-stream accelerate-sequence:~& ~S"\r
- (pipe-values\r
- (accelerated-sequence #'euler-transform (pi-stream)) 10)))\r
- (format t "~&ln2-stream:~& ~S"\r
- (pipe-values (ln2-stream) 10))\r
- (format t "~& ln2-stream euler-transform:~& ~S"\r
- (pipe-values (euler-transform (ln2-stream)) 10))\r
- (format t "~& ln2-stream accelerate-sequence:~& ~S"\r
- (pipe-values\r
- (accelerated-sequence #'euler-transform (ln2-stream)) 10)))\r
-\r
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: pipes-examples.lisp
+;;;; Purpose: Pipe examples
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id$
+;;;;
+;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:pipes-user)
+
+
+(defun integers (&optional (start 0) end)
+ (if (or (null end) (<= start end))
+ (make-pipe start (integers (+ start 1) end))
+ nil))
+
+(defun fibgen (a b)
+ (make-pipe a (fibgen b (+ a b))))
+
+(defun fibs ()
+ (fibgen 0 1))
+
+
+(defun divisible? (x y)
+ (zerop (rem x y)))
+
+(defun no-sevens ()
+ (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers)))
+
+
+(defun sieve (stream)
+ (make-pipe
+ (pipe-head stream)
+ (sieve (pipe-filter
+ #'(lambda (x)
+ (not (divisible? x (pipe-head stream))))
+ (pipe-tail stream)))))
+
+(defun primes ()
+ (sieve (integers 2)))
+
+
+;; Pi
+
+(defun scale-pipe (factor pipe)
+ (pipe-map #'(lambda (x) (* x factor)) pipe))
+
+(defun sum-pipe (sum s)
+ (make-pipe sum
+ (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)))))
+
+(defun pi-stream ()
+ (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+)))
+
+
+(defun ln2-summands (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))))
+
+(defun accelerated-sequence (transform s)
+ (pipe-map #'pipe-head
+ (make-tableau transform s)))
+
+
+(defun run-examples ()
+ (let ((*print-length* 20))
+ (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)))
+
projects / pipes.git / commitdiff