ch2

ch2/ex2-40.scm

@@ -1 +1,59 @@
 ;; Example 2.40
+
+;; Prime functions
+(define (smallest-divisor n)
+  (find-divisor n 2))
+
+(define (square x)
+  (* x x))
+
+(define (divides? a b)
+  (= (remainder b a) 0))
+
+(define (find-divisor n test-divisor)
+  (cond ((> (square test-divisor) n) n)
+        ((divides? test-divisor n) test-divisor)
+        (else (find-divisor n (+ test-divisor 1)))))
+
+(define (prime? n)
+  (= n (smallest-divisor n)))
+
+(define (fold-right op initial seq)
+  (if (null? seq)
+      initial
+      (op (car seq)
+          (fold-right op initial (cdr seq)))))
+
+(define (enumerate-interval low high)
+  (if (> low high)
+      null
+      (cons low
+            (enumerate-interval (+ low 1) high))))
+
+(define (filter predicate seq)
+  (cond ((null? seq) null)
+        ((predicate (car seq))
+         (cons (car seq) (filter predicate (cdr seq))))
+        (else (filter predicate (cdr seq)))))
+
+(define (flatmap proc seq)
+  (fold-right append null (map proc seq)))
+
+(define (prime-sum? pair)
+  (prime? (+ (car pair) (cadr pair))))
+
+(define (make-pair-sum pair)
+  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
+
+(define (unique-pairs n)
+  (flatmap (lambda (i)
+             (map (lambda (j) (list i j))
+                  (enumerate-interval 1 (- i 1))))
+           (enumerate-interval 1 n)))
+
+(define (prime-sum-pairs n)
+  (map make-pair-sum
+       (filter prime-sum?
+               (unique-pairs n))))
+
+(prime-sum-pairs 6)

ch2/ex2-41.scm

@@ -0,0 +1,48 @@
+;; Examle 2.41
+
+;; Helpers
+
+(define (fold-right op initial seq)
+  (if (null? seq)
+      initial
+      (op (car seq)
+          (fold-right op initial (cdr seq)))))
+
+(define (enumerate-interval low high)
+  (if (> low high)
+      null
+      (cons low
+            (enumerate-interval (+ low 1) high))))
+
+(define (filter predicate seq)
+  (cond ((null? seq) null)
+        ((predicate (car seq))
+         (cons (car seq) (filter predicate (cdr seq))))
+        (else (filter predicate (cdr seq)))))
+
+(define (flatmap proc seq)
+  (fold-right append null (map proc seq)))
+
+(define (unique-pairs n)
+  (flatmap (lambda (i)
+             (map (lambda (j) (list i j))
+                  (enumerate-interval 1 (- i 1))))
+           (enumerate-interval 1 n)))
+
+(define (unique-triplets n)
+  (flatmap (lambda (i)
+             (flatmap (lambda (j)
+                        (map (lambda (k) (list i j k))
+                             (enumerate-interval 1 (- j 1))))
+                      (enumerate-interval 1 (- i 1))))
+           (enumerate-interval 1 n)))
+
+(unique-triplets 6)
+
+(display "--- result --- \n")
+
+(define (triplets-equals-to s n)
+  (filter (lambda (triplet) (= (fold-right + 0 triplet) s))
+          (unique-triplets n)))
+
+(triplets-equals-to 10 6)

ch2/ex2-42.scm

@@ -0,0 +1 @@
+;; Example 2.42

ch2/ex2-44.scm

@@ -0,0 +1,29 @@
+;; Example 2.44
+
+(define (right-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (right-split painter (- n 1))))
+        (beside painter (below smaller smaller)))))
+
+(define (up-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (up-split painter (- n 1))))
+        (below painter (beside smaller smaller)))))
+
+(define (corner-split painter n)
+  (if (= n 0)
+      painter
+      (let ((up (up-split painter (- n 1)))
+            (right (right-split painter (- n 1))))
+        (let ((top-left (beside up up))
+              (bottom-right (below right right))
+              (corner (corner-split painter (- n 1))))
+          (beside (below painter top-left)
+                  (below bottom-right corner))))))
+
+(define (square-limit painter n)
+  (let ((quarter (corner-split painter n)))
+    (let ((half (beside (flip-horiz quarter) quarter)))
+      (below half (flip-vert half)))))

ch2/ex2-45.scm

@@ -0,0 +1,17 @@
+;; Example 2.45
+
+(define (up-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (up-split painter (- n 1))))
+        (below painter (beside smaller smaller)))))
+
+(define (split f s)
+  (lambda (painter n)
+    (if (= n 0)
+        painter
+        (let ((smaller ((split f s) painter (- n 1))))
+          (f painter (s smaller smaller))))))
+
+(define right-split (split beside below))
+(define up-split (split below beside))

ch2/ex2-46.scm

@@ -0,0 +1,29 @@
+;; Example 2.46
+
+(define (make-vect x y)
+  (cons x y))
+
+(define (xcor-vect vect)
+  (car vect))
+
+(define (ycor-vect vect)
+  (cdr vect))
+
+(define (add-vect a b)
+  (make-vect (+ (xcor-vect a) (xcor-vect b))
+             (+ (ycor-vect a) (ycor-vect b))))
+
+(define (sub-vect a b)
+  (make-vect (- (xcor-vect a) (xcor-vect b))
+             (- (ycor-vect a) (ycor-vect b))))
+
+(define (scale-vect a s)
+  (make-vect (* (xcor-vect a) s)
+             (* (ycor-vect a) s)))
+
+(define a (make-vect 1 2))
+(define b (make-vect 4 5))
+
+(add-vect a b)
+(sub-vect a b)
+(scale-vect a 2)

ch2/ex2-47.scm

@@ -0,0 +1,42 @@
+;; Example 2.47
+
+(define (make-vect x y)
+  (cons x y))
+
+(define (make-frame origin edge1 edge2)
+  (list origin edge1 edge2))
+
+(define (origin-frame frame)
+  (car frame))
+
+(define (edge1-frame frame)
+  (cadr frame))
+
+(define (edge2-frame frame)
+  (caddr frame))
+
+(define fr (make-frame (make-vect 0 0) (make-vect 1 1) (make-vect 2 2)))
+fr
+(origin-frame fr)
+(edge1-frame fr)
+(edge2-frame fr)
+
+(display "--- Version 2 --- \n")
+
+(define (make-frame-2 origin edge1 edge2)
+  (cons origin (cons edge1 edge2)))
+
+(define (origin-frame-2 frame)
+  (car frame))
+
+(define (edge1-frame-2 frame)
+  (cadr frame))
+
+(define (edge2-frame-2 frame)
+  (cddr frame))
+
+(define fr (make-frame-2 (make-vect 5 5) (make-vect 6 6) (make-vect 7 7)))
+fr
+(origin-frame-2 fr)
+(edge1-frame-2 fr)
+(edge2-frame-2 fr)

ch2/ex2-48.scm

@@ -0,0 +1,10 @@
+;; Example 2.48
+
+(define (make-segment v1 v2)
+  (cons v1 v2))
+
+(define (start-segment v1)
+  (car v1))
+
+(define (end-segment v2)
+  (cdr v2))

ch2/ex2-49.scm

@@ -0,0 +1,138 @@
+;; Example 2.49
+
+(require (lib "racket/draw"))
+(require racket/class)
+
+(define target (make-bitmap 100 100))
+(define dc (new bitmap-dc% [bitmap target]))
+
+;; Vectors
+
+(define (make-vect x y)
+  (cons x y))
+
+(define (xcor-vect vect)
+  (car vect))
+
+(define (ycor-vect vect)
+  (cdr vect))
+
+(define (add-vect a b)
+  (make-vect (+ (xcor-vect a) (xcor-vect b))
+             (+ (ycor-vect a) (ycor-vect b))))
+
+(define (sub-vect a b)
+  (make-vect (- (xcor-vect a) (xcor-vect b))
+             (- (ycor-vect a) (ycor-vect b))))
+
+(define (scale-vect s a)
+  (make-vect (* (xcor-vect a) s)
+             (* (ycor-vect a) s)))
+
+;; Frames
+
+(define (make-frame origin edge1 edge2)
+  (list origin edge1 edge2))
+
+(define (origin-frame frame)
+  (car frame))
+
+(define (edge1-frame frame)
+  (cadr frame))
+
+(define (edge2-frame frame)
+  (caddr frame))
+
+;; Coords mapping
+
+(define (frame-coord-map frame)
+  (lambda (v)
+    (add-vect 
+     (origin-frame frame)
+     (add-vect (scale-vect (xcor-vect v)
+                           (edge1-frame frame))
+               (scale-vect (ycor-vect v)
+                           (edge2-frame frame))))))
+
+;; Segments
+
+(define (make-segment v1 v2)
+  (cons v1 v2))
+
+(define (start-segment v1)
+  (car v1))
+
+(define (end-segment v2)
+  (cdr v2))
+
+;; Painters
+
+(define (my-draw-line v1 v2)
+  (send dc draw-line
+        (xcor-vect v1) (ycor-vect v1)
+        (xcor-vect v2) (ycor-vect v2)))
+
+(define (segments->painter segment-list)
+  (lambda (frame)
+    (for-each
+     (lambda (segment)
+       (my-draw-line
+        ((frame-coord-map frame) (start-segment segment))
+        ((frame-coord-map frame) (end-segment segment))))
+     segment-list)))
+
+;; Painting
+;; a.
+
+(define a-painter (segments->painter 
+                   (list (make-segment 
+                          (make-vect 0 0) 
+                          (make-vect 0 1))
+                         (make-segment 
+                          (make-vect 0 1) 
+                          (make-vect 1 1))
+                         (make-segment
+                          (make-vect 1 1)
+                          (make-vect 1 0))
+                         (make-segment
+                          (make-vect 1 0)
+                          (make-vect 0 0)))))
+
+(send dc clear)
+(a-painter (make-frame (make-vect 0 0) (make-vect 0 99) (make-vect 99 0)))
+(send target save-file "ex2-49-a.png" 'png)
+
+;; b.
+(define b-painter (segments->painter 
+                   (list (make-segment 
+                          (make-vect 0 0) 
+                          (make-vect 1 1))
+                         (make-segment 
+                          (make-vect 0 1) 
+                          (make-vect 1 0)))))
+
+(send dc clear)
+(b-painter (make-frame (make-vect 0 0) (make-vect 0 100) (make-vect 100 0)))
+(send target save-file "ex2-49-b.png" 'png)
+
+;; c
+(define c-painter (segments->painter 
+                   (list (make-segment 
+                          (make-vect 0 0.5) 
+                          (make-vect 0.5 0))
+                         (make-segment 
+                          (make-vect 0.5 0) 
+                          (make-vect 1 0.5))
+                         (make-segment
+                          (make-vect 1 0.5)
+                          (make-vect 0.5 1))
+                         (make-segment
+                          (make-vect 0.5 1)
+                          (make-vect 0 0.5)))))
+
+(send dc clear)
+(c-painter (make-frame (make-vect 0 0) (make-vect 0 100) (make-vect 100 0)))
+(send target save-file "ex2-49-c.png" 'png)
+
+;; d.
+;; bleeeeh. I'm too lazy.