source: project/release/5/srfi-41/trunk/streams-math.scm @ 39713

Last change on this file since 39713 was 39713, checked in by Kon Lovett, 2 months ago

remove "primitives", replace inline type checks

File size: 3.7 KB
Line 
1;;;; streams-math.scm
2;;;; Kon Lovett, Apr '09
3
4; Copyright (C) 2007 by Philip L. Bewig of Saint Louis, Missouri, USA.  All rights
5; reserved.  Permission is hereby granted, free of charge, to any person obtaining a copy of
6; this software and associated documentation files (the "Software"), to deal in the Software
7; without restriction, including without limitation the rights to use, copy, modify, merge,
8; publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to
9; whom the Software is furnished to do so, subject to the following conditions: The above
10; copyright notice and this permission notice shall be included in all copies or substantial
11; portions of the Software.  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
12; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
13; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
14; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
15; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
16; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
17
18
19;;;
20
21(module streams-math
22
23(;export
24  prime-number?
25  stream-max
26  stream-min
27  stream-sum
28  odd-numbers-stream
29  even-numbers-stream
30  cardinal-numbers-stream
31  natural-numbers-stream
32  prime-numbers-stream
33  hamming-sequence-stream
34  fibonacci-stream)
35
36(import scheme
37  (chicken base)
38  (chicken type)
39  (chicken syntax)
40  streams
41  streams-utils)
42
43;;; Section Combinators
44
45(define (left-section fn . args) (lambda xs (apply fn (append args xs))))
46
47;;;
48
49(define (stream-max strm)
50  (stream-fold-one max (check-stream 'stream-max strm 'stream)) )
51
52(define (stream-min strm)
53  (stream-fold-one min (check-stream 'stream-min strm 'stream)) )
54
55(define stream-sum (left-section stream-fold + 0))
56
57(define odd-numbers-stream (stream-from 1 2))
58
59(define even-numbers-stream (stream-from 0 2))
60
61(define cardinal-numbers-stream (stream-iterate add1 0))
62
63(define natural-numbers-stream (stream-iterate add1 1))
64
65#|
66(define-stream (prime-sieve$ strm)
67  (define-stream (sift$ base strm)
68    (define-stream (next$ base mult strm)
69      (let ((first (stream-car strm))
70            (rest (stream-cdr strm)))
71        (cond
72          ((< first mult)
73            (stream-cons first (next$ base mult rest)) )
74          ((< mult first)
75            (next$ base (+ base mult) strm) )
76          (else
77            (next$ base (+ base mult) rest) ) ) ) )
78    (next$ base (+ base base) strm) )
79  (let ((first (stream-car strm))
80        (rest (stream-cdr strm)))
81    (stream-cons first (prime-sieve$ (sift$ first rest))) ) )
82
83(define prime-numbers-stream (prime-sieve$ (stream-from 2)))
84|#
85
86(define prime-numbers-stream
87  (stream-cons 2 (stream-filter prime-number? (stream-drop 2 natural-numbers-stream))) )
88
89(define (prime-number? n)
90  ;
91  (define (iter s)
92    (let (
93      (np (stream-car s)) )
94      (cond
95        ((> np (sqrt n))      #t)
96        ((= 0 (modulo n np))  #f)
97        (else                 (iter (stream-cdr s)) ) ) ) )
98  ;
99  (iter prime-numbers-stream) )
100
101;; http://www.research.att.com/~njas/sequences/A051037
102
103(define hamming-sequence-stream
104  (stream-cons 1
105    (stream-unique =
106      (stream-merge <
107        (stream-map (left-section * 2) hamming-sequence-stream)
108        (stream-map (left-section * 3) hamming-sequence-stream)
109        (stream-map (left-section * 5) hamming-sequence-stream)))) )
110
111#;
112(define power-table
113  (stream-of
114    (stream-of (expt m n) (m in (stream-from 1)))
115    (n in (stream-from 2))))
116
117(define fibonacci-stream
118  (stream-cons 0
119    (stream-cons 1
120      (stream-map +
121        fibonacci-stream
122        (stream-cdr fibonacci-stream)))))
123
124) ;module streams-math
Note: See TracBrowser for help on using the repository browser.