-;;;; -*- 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: pipes-example.lisp,v 1.2 2002/11/07 20:26:13 kevin Exp $
-;;;;
-;;;; 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)
- (pipe-map (/ 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 "~&euler-transform: ~S"
- (pipe-values (euler-transform (pi-stream)) 10))
- (format t "~&accelerate-sequence: ~S"
- (pipe-values
- (accelerated-sequence #'euler-transform (pi-stream)) 10))))
+;;;; -*- 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
projects / pipes.git / blobdiff