pipes-example.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          pipes-examples.lisp
   6 ;;;; Purpose:       Pipe examples
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: pipes-example.lisp,v 1.1 2002/11/02 17:49:10 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; *************************************************************************
  15
  16 (in-package #:pipes-user)
  17
  18
  19 (defun integers (&optional (start 0) end)
  20   "a pipe of integers from START to END."
  21   (if (or (null end) (<= start end))
  22     (make-pipe start (integers (+ start 1) end))
  23     nil))
  24
  25 (defun fibgen (a b)
  26     (make-pipe a (fibgen b (+ a b))))
  27
  28 (defun fibs ()
  29   (fibgen 0 1))
  30
  31
  32 (defun divisible? (x y)
  33   (zerop (rem x y)))
  34
  35
  36 (defun no-sevens ()
  37    (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers)))
  38
  39
  40 (defun sieve (stream)
  41   (make-pipe
  42    (pipe-head stream)
  43    (sieve (pipe-filter
  44            #'(lambda (x)
  45                (not (divisible? x (pipe-head stream))))
  46            (pipe-tail stream)))))
  47
  48 (defun primes ()
  49   (sieve (integers 2)))
  50
  51
  52 ;; Pi
  53
  54 (defun scale-pipe (factor pipe)
  55   (pipe-map #'(lambda (x) (* x factor)) pipe))
  56
  57 (defun sum-pipe (sum s)
  58   (make-pipe sum
  59              (sum-pipe (+ sum (pipe-head s))
  60                        (pipe-tail s))))
  61
  62 (defun partial-sums (s)
  63   (make-pipe (pipe-head s) (sum-pipe 0 s)))
  64
  65 (defun pi-summands (n)
  66   (make-pipe (/ 1d0 n)
  67              (pipe-map #'- (pi-summands (+ n 2)))))
  68
  69 (defun pi-stream ()
  70    (scale-pipe 4d0 (partial-sums (pi-summands 1))))
  71
  72 (defun square (x)
  73   (* x x))
  74
  75 (defun euler-transform (s)
  76       (let ((s0 (pipe-elt s 0))
  77             (s1 (pipe-elt s 1))
  78             (s2 (pipe-elt s 2)))
  79         (if (and s0 s1 s2)
  80             (if (eql s1 s2)     ;;; series has converged
  81                 +empty-pipe+
  82               (make-pipe (- s2 (/ (square (- s2 s1))
  83                                   (+ s0 (* -2 s1) s2)))
  84                          (euler-transform (pipe-tail s))))
  85           +empty-pipe+)))
  86
  87
  88 (defun ln2-summands (n)
  89   (pipe-map (/ 1d0 n)
  90             (pipe-map #'- (ln2-summands (1+ n)))))
  91
  92 (defun ln2-stream ()
  93   (partial-sums (ln2-summands 1)))
  94
  95 (defun make-tableau (transform s)
  96   (make-pipe s
  97              (make-tableau transform
  98                            (funcall transform s))))
  99
 100 (defun accelerated-sequence (transform s)
 101   (pipe-map #'pipe-head
 102             (make-tableau transform s)))
 103
 104
 105 (defun run-examples ()
 106   (let ((*print-length* 20))
 107     (format t "~&pi-stream: ~S"
 108             (pipe-display (pi-stream) 10))
 109     (format t "~&euler-transform: ~S"
 110             (pipe-display (euler-transform (pi-stream)) 10))
 111     (format t "~&accelerate-sequence: ~S"
 112             (pipe-display
 113              (accelerated-sequence #'euler-transform (pi-stream)) 10))))