;;;; -*- 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 7061 2003-09-07 06:34:45Z kevin $
;;;;
;;;; 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)))

