Permalink
Browse files

ch3

  • Loading branch information...
nslobodin committed Aug 24, 2012
1 parent d269180 commit 81946c19e0fb5a9892024b6b82659e0b287b77f3
Showing with 309 additions and 0 deletions.
  1. +57 −0 ch3/ex3-69.scm
  2. +76 −0 ch3/ex3-70.scm
  3. +73 −0 ch3/ex3-71.scm
  4. +57 −0 ch3/ex3-73.scm
  5. +16 −0 ch3/ex3-74.scm
  6. +12 −0 ch3/ex3-75.scm
  7. +18 −0 ch3/ex3-76.scm
View
@@ -0,0 +1,57 @@
+;; Example 3.69
+
+#lang racket
+
+(require racket/stream)
+
+(define (display-stream-n stream n)
+ (if (<= n 0)
+ 'done
+ (begin
+ (display (stream-first stream))
+ (newline)
+ (display-stream-n (stream-rest stream) (- n 1)))))
+
+;; integers
+
+(define (integers-starting-from n)
+ (stream-cons n (integers-starting-from (+ n 1))))
+
+(define integers (integers-starting-from 1))
+
+;; pairs i <= j
+
+(define (interleave s1 s2)
+ (if (stream-empty? s1)
+ s2
+ (stream-cons (stream-first s1)
+ (interleave s2 (stream-rest s1)))))
+
+(define (pairs s t)
+ (stream-cons
+ (list (stream-first s) (stream-first t))
+ (interleave
+ (stream-map (lambda (x) (list (stream-first s)
+ x))
+ (stream-rest t))
+ (pairs (stream-rest s) (stream-rest t)))))
+
+(define (triples s t u)
+ (stream-cons
+ (list (stream-first s) (stream-first t) (stream-first u))
+ (interleave
+ (stream-map (λ (x) (append (list (stream-first s)) x))
+ (stream-rest (pairs t u)))
+ (triples (stream-rest s)
+ (stream-rest t)
+ (stream-rest u)))))
+
+(define phy
+ (stream-filter (λ (triple)
+ (let ((i (car triple))
+ (j (cadr triple))
+ (k (caddr triple)))
+ (= (* k k) (+ (* i i) (* j j)))))
+ (triples integers integers integers)))
+
+(display-stream-n phy 5)
View
@@ -0,0 +1,76 @@
+;; Example 3.70
+
+#lang racket
+
+(require racket/stream)
+
+(define (display-stream-n stream n)
+ (if (<= n 0)
+ 'done
+ (begin
+ (display (stream-first stream))
+ (newline)
+ (display-stream-n (stream-rest stream) (- n 1)))))
+
+(define (integers-starting-from n)
+ (stream-cons n (integers-starting-from (+ n 1))))
+
+(define integers (integers-starting-from 1))
+
+(define (merge-weighted s1 s2 weight)
+ (cond ((stream-empty? s1) s2)
+ ((stream-empty? s2) s1)
+ (else
+ (let ((w1 (weight (stream-first s1)))
+ (w2 (weight (stream-first s2))))
+ (cond ((< w1 w2)
+ (stream-cons (stream-first s1) (merge-weighted (stream-rest s1) s2 weight)))
+ ((> w1 w2)
+ (stream-cons (stream-first s2) (merge-weighted s1 (stream-rest s2) weight)))
+ (else
+ (stream-cons (stream-first s1)
+ (merge-weighted (stream-rest s1)
+ (stream-rest s2)
+ weight))))))))
+
+(define (interleave s1 s2)
+ (if (stream-empty? s1)
+ s2
+ (stream-cons (stream-first s1)
+ (interleave s2 (stream-rest s1)))))
+
+(define (weighted-pairs s t weight)
+ (stream-cons
+ (list (stream-first s) (stream-first t))
+ (merge-weighted
+ (stream-map (lambda (x) (list (stream-first s)
+ x))
+ (stream-rest t))
+ (weighted-pairs (stream-rest s) (stream-rest t) weight)
+ weight)))
+
+;; a)
+
+(define a-stream (weighted-pairs integers integers
+ (λ (pair) (+ (car pair) (cadr pair)))))
+
+(display-stream-n a-stream 10)
+
+;; b)
+
+(define (divisible? x y)
+ (= (remainder x y) 0))
+
+(define hamming-integers
+ (stream-filter (λ (x)
+ (and (not (divisible? x 2))
+ (not (divisible? x 3))
+ (not (divisible? x 5))))
+ integers))
+
+(define b-stream (weighted-pairs hamming-integers hamming-integers
+ (λ (pair) (+ (* 2 (car pair))
+ (* 3 (cadr pair))
+ (* 5 (car pair) (cadr pair))))))
+
+(display-stream-n b-stream 20)
View
@@ -0,0 +1,73 @@
+;; Example 3.71
+
+#lang racket
+
+;; dependencies
+
+(define (cube x) (* x x x))
+
+(require racket/stream)
+
+(define (display-stream-n stream n)
+ (if (<= n 0)
+ 'done
+ (begin
+ (display (stream-first stream))
+ (newline)
+ (display-stream-n (stream-rest stream) (- n 1)))))
+
+(define (integers-starting-from n)
+ (stream-cons n (integers-starting-from (+ n 1))))
+
+(define integers (integers-starting-from 1))
+
+(define (merge-weighted s1 s2 weight)
+ (cond ((stream-empty? s1) s2)
+ ((stream-empty? s2) s1)
+ (else
+ (let ((w1 (weight (stream-first s1)))
+ (w2 (weight (stream-first s2))))
+ (cond ((< w1 w2)
+ (stream-cons (stream-first s1) (merge-weighted (stream-rest s1) s2 weight)))
+ ((> w1 w2)
+ (stream-cons (stream-first s2) (merge-weighted s1 (stream-rest s2) weight)))
+ (else
+ (stream-cons (stream-first s1)
+ (merge-weighted (stream-rest s1)
+ (stream-rest s2)
+ weight))))))))
+
+(define (interleave s1 s2)
+ (if (stream-empty? s1)
+ s2
+ (stream-cons (stream-first s1)
+ (interleave s2 (stream-rest s1)))))
+
+(define (weighted-pairs s t weight)
+ (stream-cons
+ (list (stream-first s) (stream-first t))
+ (merge-weighted
+ (stream-map (lambda (x) (list (stream-first s)
+ x))
+ (stream-rest t))
+ (weighted-pairs (stream-rest s) (stream-rest t) weight)
+ weight)))
+
+;; 3.71
+
+(define (ramanujan-numbers)
+ (define (weight pair)
+ (+ (cube (car pair))
+ (cube (cadr pair))))
+
+ (define ram-pairs (weighted-pairs integers integers weight))
+
+ (define (iter pairs)
+ (let ((w1 (weight (stream-first pairs)))
+ (w2 (weight (stream-first (stream-rest pairs)))))
+ (if (= w1 w2)
+ (stream-cons w1 (iter (stream-rest (stream-rest pairs))))
+ (iter (stream-rest pairs)))))
+ (iter ram-pairs))
+
+(stream-ref (ramanujan-numbers) 0)
View
@@ -0,0 +1,57 @@
+;; Example 3.73
+
+#lang racket
+
+(require racket/stream)
+
+;; requirements
+
+(define (my-stream-map proc . argstreams)
+ (if (stream-empty? (car argstreams))
+ empty-stream
+ (stream-cons
+ (apply proc (map stream-first argstreams))
+ (apply my-stream-map
+ (cons proc (map stream-rest argstreams))))))
+
+(define (add-streams s1 s2)
+ (my-stream-map + s1 s2))
+
+(define (scale-stream stream factor)
+ (stream-map (lambda (x) (* x factor)) stream))
+
+(define (stream-enumerate-interval low high)
+ (if (> low high)
+ empty-stream
+ (stream-cons
+ low
+ (stream-enumerate-interval (+ low 1) high))))
+
+;; 3.73
+
+(define (integral integrand initial-value dt)
+ (define int
+ (stream-cons initial-value
+ (add-streams (scale-stream integrand dt)
+ int)))
+ int)
+
+(define (RC R C dt)
+ (lambda (v0 i)
+ (add-streams (scale-stream i R)
+ (integral (scale-stream i (/ 1 C))
+ v0
+ dt))))
+
+;; test
+
+(define RC1 (RC 5 1 0.5))
+
+(define S (RC1 2.5 (stream-enumerate-interval 1 10)))
+
+(stream-ref S 0)
+(stream-ref S 1)
+(stream-ref S 2)
+(stream-ref S 3)
+(stream-ref S 4)
+(stream-ref S 5)
View
@@ -0,0 +1,16 @@
+;; Example 3.74
+
+#lang racket
+
+(require racket/stream)
+
+(define (my-stream-map proc . argstreams)
+ (if (stream-empty? (car argstreams))
+ empty-stream
+ (stream-cons
+ (apply proc (map stream-first argstreams))
+ (apply my-stream-map
+ (cons proc (map stream-rest argstreams))))))
+
+(define zero-crossings
+ (my-stream-map sign-change-detector sense-data (stream-cons 0 sense-data)))
View
@@ -0,0 +1,12 @@
+;; Example 3.75
+
+#lang racket
+
+(require racket/stream)
+
+(define (make-zero-crossings input-stream last-value last-avpt)
+ (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
+ (stream-cons (sign-change-detectpr avpt last-avpt)
+ (make-zero-crossings (stream-rest input-stream)
+ (stream-first input-stream)
+ avpt))))
View
@@ -0,0 +1,18 @@
+;; Example 3.76
+
+#lang racket
+
+(require racket/stream)
+
+(define (my-stream-map proc . argstreams)
+ (if (stream-empty? (car argstreams))
+ empty-stream
+ (stream-cons
+ (apply proc (map stream-first argstreams))
+ (apply my-stream-map
+ (cons proc (map stream-rest argstreams))))))
+
+(define (smooth stream)
+ (my-stream-map (λ (x1 x2) (/ (+ x1 x2) 2))
+ (stream-cons 0 stream)
+ stream))

0 comments on commit 81946c1

Please sign in to comment.