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 |
---|