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$
  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   (if (or (null end) (<= start end))
  21       (make-pipe start (integers (+ start 1) end))
  22     nil))
  23
  24 (defun fibgen (a b)
  25   (make-pipe a (fibgen b (+ a b))))
  26
  27 (defun fibs ()
  28   (fibgen 0 1))
  29
  30
  31 (defun divisible? (x y)
  32   (zerop (rem x y)))
  33
  34 (defun no-sevens ()
  35   (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers)))
  36
  37
  38 (defun sieve (stream)
  39   (make-pipe
  40    (pipe-head stream)
  41    (sieve (pipe-filter
  42            #'(lambda (x)
  43                (not (divisible? x (pipe-head stream))))
  44            (pipe-tail stream)))))
  45
  46 (defun primes ()
  47   (sieve (integers 2)))
  48
  49
  50 ;; Pi
  51
  52 (defun scale-pipe (factor pipe)
  53   (pipe-map #'(lambda (x) (* x factor)) pipe))
  54
  55 (defun sum-pipe (sum s)
  56   (make-pipe sum
  57              (sum-pipe (+ sum (pipe-head s))
  58                        (pipe-tail s))))
  59
  60 (defun partial-sums (s)
  61   (make-pipe (pipe-head s) (sum-pipe 0 s)))
  62
  63 (defun pi-summands (n)
  64   (make-pipe (/ 1d0 n)
  65              (pipe-map #'- (pi-summands (+ n 2)))))
  66
  67 (defun pi-stream ()
  68   (scale-pipe 4d0 (partial-sums (pi-summands 1))))
  69
  70 (defun square (x)
  71   (* x x))
  72
  73 (defun euler-transform (s)
  74   (let ((s0 (pipe-elt s 0))
  75         (s1 (pipe-elt s 1))
  76         (s2 (pipe-elt s 2)))
  77     (if (and s0 s1 s2)
  78         (if (eql s1 s2) ;;; series has converged
  79                 +empty-pipe+
  80           (make-pipe (- s2 (/ (square (- s2 s1))
  81                               (+ s0 (* -2 s1) s2)))
  82                      (euler-transform (pipe-tail s))))
  83           +empty-pipe+)))
  84
  85
  86 (defun ln2-summands (n)
  87   (make-pipe (/ 1d0 n)
  88              (pipe-map #'- (ln2-summands (1+ n)))))
  89
  90 (defun ln2-stream ()
  91   (partial-sums (ln2-summands 1)))
  92
  93 (defun make-tableau (transform s)
  94   (make-pipe s
  95              (make-tableau transform
  96                            (funcall transform s))))
  97
  98 (defun accelerated-sequence (transform s)
  99   (pipe-map #'pipe-head
 100             (make-tableau transform s)))
 101
 102
 103 (defun run-examples ()
 104   (let ((*print-length* 20))
 105     (format t "~&pi-stream:~&  ~S"
 106             (pipe-values (pi-stream) 10))
 107     (format t "~& pi-stream euler-transform:~&  ~S"
 108             (pipe-values (euler-transform (pi-stream)) 10))
 109     (format t "~& pi-stream accelerate-sequence:~&  ~S"
 110             (pipe-values
 111              (accelerated-sequence #'euler-transform (pi-stream)) 10)))
 112       (format t "~&ln2-stream:~&  ~S"
 113             (pipe-values (ln2-stream) 10))
 114     (format t "~& ln2-stream euler-transform:~&  ~S"
 115             (pipe-values (euler-transform (ln2-stream)) 10))
 116     (format t "~& ln2-stream accelerate-sequence:~&  ~S"
 117             (pipe-values
 118              (accelerated-sequence #'euler-transform (ln2-stream)) 10)))
 119