;;;; -*- 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)))