pipes-example.lisp

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