;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: pipes-example.lisp,v 1.1 2002/11/02 17:49:10 kevin Exp $
+;;;; $Id: pipes-example.lisp,v 1.2 2002/11/07 20:26:13 kevin Exp $
;;;;
;;;; This file, part of pipes, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(defun integers (&optional (start 0) end)
- "a pipe of integers from START to END."
(if (or (null end) (<= start end))
- (make-pipe start (integers (+ start 1) end))
+ (make-pipe start (integers (+ start 1) end))
nil))
(defun fibgen (a b)
- (make-pipe a (fibgen b (+ 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)))
+ (pipe-filter #'(lambda (x) (not (divisible? x 7))) (integers)))
(defun sieve (stream)
(pipe-map #'- (pi-summands (+ n 2)))))
(defun pi-stream ()
- (scale-pipe 4d0 (partial-sums (pi-summands 1))))
+ (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
+ (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))))
+ (make-pipe (- s2 (/ (square (- s2 s1))
+ (+ s0 (* -2 s1) s2)))
+ (euler-transform (pipe-tail s))))
+empty-pipe+)))
-
+
(defun ln2-summands (n)
(pipe-map (/ 1d0 n)
(defun run-examples ()
(let ((*print-length* 20))
(format t "~&pi-stream: ~S"
- (pipe-display (pi-stream) 10))
+ (pipe-values (pi-stream) 10))
(format t "~&euler-transform: ~S"
- (pipe-display (euler-transform (pi-stream)) 10))
+ (pipe-values (euler-transform (pi-stream)) 10))
(format t "~&accelerate-sequence: ~S"
- (pipe-display
+ (pipe-values
(accelerated-sequence #'euler-transform (pi-stream)) 10))))
;;;; Programmers: Kevin M. Rosenberg and Peter Norvig
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: pipes.lisp,v 1.1 2002/11/02 17:49:10 kevin Exp $
+;;;; $Id: pipes.lisp,v 1.2 2002/11/07 20:26:13 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg and
;;;; Copyright (c) 1998-2002 by Peter Norvig.
(defconstant +empty-pipe+ nil)
(defmacro make-pipe (head tail)
- "create a pipe by eval'ing head and delaying tail."
+ "Create a pipe by evaluating head and delaying tail."
`(cons ,head #'(lambda () ,tail)))
(defun pipe-tail (pipe)
- "return tail of pipe or list, and destructively update
+ "Return tail of pipe or list, and destructively update
the tail if it is a function."
- ;; pipes should never contain functions as values
(if (functionp (rest pipe))
(setf (rest pipe) (funcall (rest pipe)))
(rest pipe)))
(defun pipe-head (pipe) (first pipe))
-(defun pipe-elt (pipe n)
- "nth element of pipe, 0 based."
- (if (= n 0) (pipe-head pipe)
- (pipe-elt (pipe-tail pipe) (- n 1))))
+(defun pipe-elt (pipe i)
+ "The i-th element of pipe, 0-based."
+ (if (= i 0)
+ (pipe-head pipe)
+ (pipe-elt (pipe-tail pipe) (- i 1))))
-(defun enumerate (pipe &key count key (result pipe))
- "go through all or count elements of pipe,
- possibly applying the key function. "
+(defun pipe-enumerate (pipe &key count key (result pipe))
+ "Go through all (or count) elements of pipe,
+ possibly applying the KEY function. (Try PRINT.)"
+ ;; Returns RESULT, which defaults to the pipe itself.
(if (or (eq pipe +empty-pipe+) (eql count 0))
result
(progn
(unless (null key) (funcall key (pipe-head pipe)))
- (enumerate (pipe-tail pipe)
+ (pipe-enumerate (pipe-tail pipe)
:count (if count (1- count))
- :key key
- :result result))))
+ :key key :result result))))
-(defun pipe-display (pipe &optional count)
- (enumerate pipe :count count))
+(defun pipe-values (pipe &optional count)
+ "Simple wrapper to return values of a pipe"
+ (pipe-enumerate pipe :count count))
(defun pipe-force (pipe)
- (enumerate pipe))
+ "Force the enumeration of all of the pipe. Never returns
+if the pipe is infinite in length."
+ (pipe-enumerate pipe))
(defun pipe-filter (predicate pipe)
- "keep only items in (non-null) pipe satisfying predicate"
- (if (eq pipe +empty-pipe+)
+ "Keep only items in pipe satisfying predicate."
+ (if (eq pipe +empty-pipe+)
+empty-pipe+
- (let ((head (pipe-head pipe))
- (tail (pipe-tail pipe)))
+ (let ((head (pipe-head pipe))
+ (tail (pipe-tail pipe)))
(if (funcall predicate head)
- (make-pipe head (pipe-filter predicate tail))
+ (make-pipe head (pipe-filter predicate tail))
(pipe-filter predicate tail)))))
(defun pipe-map (fn pipe)
- "Map fn over pipe, delaying all but the first fn call,
- collecting res<ults"
+ "Map fn over pipe, delaying all but the first fn call."
(if (eq pipe +empty-pipe+)
- +empty-pipe+
+ +empty-pipe+
(make-pipe (funcall fn (pipe-head pipe))
(pipe-map fn (pipe-tail pipe)))))
-(defun pipe-map-filtering (fn pipe &optional filter-test)
+(defun pipe-map-filtering (fn pipe &optional filter-pred)
"Map fn over pipe, delaying all but the first fn call,
- collecting results"
+ while filtering results."
(if (eq pipe +empty-pipe+)
- +empty-pipe+
+ +empty-pipe+
(let* ((head (pipe-head pipe))
(tail (pipe-tail pipe))
(result (funcall fn head)))
- (if (or (and filter-test (funcall filter-test result))
+ (if (or (and filter-pred (funcall filter-pred result))
result)
- (make-pipe result (pipe-map-filtering fn tail filter-test))
- (pipe-map-filtering fn tail filter-test)))))
-
+ (make-pipe result (pipe-map-filtering fn tail filter-pred))
+ (pipe-map-filtering fn tail filter-pred)))))
+
-(defun pipe-append (pipex pipey)
- "return a pipe that appends two pipes"
- (if (eq pipex +empty-pipe+)
- pipey
- (make-pipe (pipe-head pipex)
- (pipe-append (pipe-tail pipex) pipey))))
+(defun pipe-append (x y)
+ "Return a pipe that appends the elements of x and y."
+ (if (eq x +empty-pipe+)
+ y
+ (make-pipe (pipe-head x)
+ (pipe-append (pipe-tail x) y))))
+
(defun pipe-mappend (fn pipe)
- "lazily map fn over pipe, appending results"
+ "Lazily map fn over pipe, appending results."
(if (eq pipe +empty-pipe+)
- +empty-pipe+
+ +empty-pipe+
(let ((x (funcall fn (pipe-head pipe))))
(make-pipe (pipe-head x)
(pipe-append (pipe-tail x)
- (pipe-mappend fn (pipe-tail pipe)))))))
+ (pipe-mappend fn (pipe-tail pipe)))))))
-(defun pipe-mappend-filtering (fn pipe &optional filter-test)
+(defun pipe-mappend-filtering (fn pipe &optional filter-pred)
"Map fn over pipe, delaying all but the first fn call,
- appending results, filtering along the way"
+ appending results while filtering."
(if (eq pipe +empty-pipe+)
- +empty-pipe+
+ +empty-pipe+
(let* ((head (pipe-head pipe))
(tail (pipe-tail pipe))
(result (funcall fn head)))
- (if (or (and filter-test (funcall filter-test result))
+ (if (or (and filter-pred (funcall filter-pred result))
result)
- (make-pipe (pipe-head result)
- (pipe-append (pipe-tail result)
- (pipe-mappend-filtering fn tail filter-test)))
- (pipe-mappend-filtering fn tail filter-test)))))
+ (make-pipe (pipe-head result)
+ (pipe-append (pipe-tail result)
+ (pipe-mappend-filtering fn tail filter-pred)))
+ (pipe-mappend-filtering fn tail filter-pred)))))
projects / pipes.git / commitdiff