/usr/share/common-lisp/source/pipes/pipes-example.lisp is in cl-pipes 1.2.1-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | ;;;; -*- 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)))
|