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

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

remove "primitives"

File size: 3.8 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(define-inline (%structure-instance? x s) (##core#inline "C_i_structurep" x s))
44
45(include-relative "streams-inlines")
46
47;;; Section Combinators
48
49(define (left-section fn . args) (lambda xs (apply fn (append args xs))))
50
51;;;
52
53(define (stream-max strm)
54  (stream-fold-one max (%check-stream 'stream-max strm 'stream)) )
55
56(define (stream-min strm)
57  (stream-fold-one min (%check-stream 'stream-min strm 'stream)) )
58
59(define stream-sum (left-section stream-fold + 0))
60
61(define odd-numbers-stream (stream-from 1 2))
62
63(define even-numbers-stream (stream-from 0 2))
64
65(define cardinal-numbers-stream (stream-iterate add1 0))
66
67(define natural-numbers-stream (stream-iterate add1 1))
68
69#|
70(define-stream (prime-sieve$ strm)
71  (define-stream (sift$ base strm)
72    (define-stream (next$ base mult strm)
73      (let ((first (stream-car strm))
74            (rest (stream-cdr strm)))
75        (cond
76          ((< first mult)
77            (stream-cons first (next$ base mult rest)) )
78          ((< mult first)
79            (next$ base (+ base mult) strm) )
80          (else
81            (next$ base (+ base mult) rest) ) ) ) )
82    (next$ base (+ base base) strm) )
83  (let ((first (stream-car strm))
84        (rest (stream-cdr strm)))
85    (stream-cons first (prime-sieve$ (sift$ first rest))) ) )
86
87(define prime-numbers-stream (prime-sieve$ (stream-from 2)))
88|#
89
90(define prime-numbers-stream
91  (stream-cons 2 (stream-filter prime-number? (stream-drop 2 natural-numbers-stream))) )
92
93(define (prime-number? n)
94  ;
95  (define (iter s)
96    (let (
97      (np (stream-car s)) )
98      (cond
99        ((> np (sqrt n))      #t)
100        ((= 0 (modulo n np))  #f)
101        (else                 (iter (stream-cdr s)) ) ) ) )
102  ;
103  (iter prime-numbers-stream) )
104
105;; http://www.research.att.com/~njas/sequences/A051037
106
107(define hamming-sequence-stream
108  (stream-cons 1
109    (stream-unique =
110      (stream-merge <
111        (stream-map (left-section * 2) hamming-sequence-stream)
112        (stream-map (left-section * 3) hamming-sequence-stream)
113        (stream-map (left-section * 5) hamming-sequence-stream)))) )
114
115#;
116(define power-table
117  (stream-of
118    (stream-of (expt m n) (m in (stream-from 1)))
119    (n in (stream-from 2))))
120
121(define fibonacci-stream
122  (stream-cons 0
123    (stream-cons 1
124      (stream-map +
125        fibonacci-stream
126        (stream-cdr fibonacci-stream)))))
127
128) ;module streams-math
Note: See TracBrowser for help on using the repository browser.