From 692c4be5bf0688806d3df9530a014ec02ad53c78 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 7 Sep 2003 06:34:45 +0000 Subject: [PATCH] r7061: initial property settings --- package.lisp | 2 +- pipes-example.lisp | 238 ++++++++++++++++++++++----------------------- pipes.asd | 2 +- src.lisp | 2 +- 4 files changed, 122 insertions(+), 122 deletions(-) diff --git a/package.lisp b/package.lisp index 24ee187..ce37886 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.3 2003/05/06 16:15:51 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; diff --git a/pipes-example.lisp b/pipes-example.lisp index 3ce8cc0..6e7b0c0 100644 --- a/pipes-example.lisp +++ b/pipes-example.lisp @@ -1,119 +1,119 @@ -;;;; -*- 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,v 1.3 2003/03/15 00:48:56 kevin Exp $ -;;;; -;;;; 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))) - +;;;; -*- 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))) + diff --git a/pipes.asd b/pipes.asd index 2ea9b5a..a8be424 100644 --- a/pipes.asd +++ b/pipes.asd @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: pipes.asd,v 1.4 2003/05/06 16:15:51 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of PIPES, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; ************************************************************************* diff --git a/src.lisp b/src.lisp index b4edcdc..aa871ef 100644 --- a/src.lisp +++ b/src.lisp @@ -7,7 +7,7 @@ ;;;; Programmers: Kevin M. Rosenberg and Peter Norvig ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: src.lisp,v 1.2 2003/05/06 16:15:51 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg and ;;;; Copyright (c) 1998-2002 by Peter Norvig. -- 2.34.1