start ch2

10 files changed, 282 insertions, 0 deletions

diff --git a/coding-exercises/2/1.rkt b/coding-exercises/2/1.rkt
new file mode 100644
index 0000000..8f15e64
--- /dev/null
+++ b/coding-exercises/2/1.rkt
@@ -0,0 +1,10 @@
+#lang racket
+
+(define (make-rat n d)
+  (define (sign x)
+    (cond
+      ((and (< x 0) (< d 0)) (* -1 x))
+      ((and (< 0 x) (< d 0)) (* -1 x))
+      (else x)))
+  (let ((g (gcd n d)))
+    (cons (sign (/ n g)) (abs (/ d g)))))
diff --git a/coding-exercises/2/10.rkt b/coding-exercises/2/10.rkt
new file mode 100644
index 0000000..20c70b0
--- /dev/null
+++ b/coding-exercises/2/10.rkt
@@ -0,0 +1,14 @@
+#lang racket
+(require 
+  "7.rkt"
+  "8.rkt"
+  "9.rkt")
+
+(define (div-interval x y)
+  (if (and (< 0 (lower-bound y)) (> 0 (upper-bound y)))
+    (error "Division by interval spanning zero")
+    (mul-interval 
+      x
+      (make-interval 
+        (/ 1.0 (upper-bound y))
+        (/ 1.0 (lower-bound y))))))
diff --git a/coding-exercises/2/2.rkt b/coding-exercises/2/2.rkt
new file mode 100644
index 0000000..814c999
--- /dev/null
+++ b/coding-exercises/2/2.rkt
@@ -0,0 +1,42 @@
+#lang racket
+(require "../../shared/chapter1.rkt")
+
+(define (make-segment p1 p2)
+  (cons p1 p2))
+
+(define (start-segment s)
+  (car s))
+
+(define (end-segment s)
+  (cdr s))
+
+(define (make-point x y)
+  (cons x y))
+
+(define (x-point p)
+  (car p))
+
+(define (y-point p)
+  (cdr p))
+
+(define (print-point p)
+  (newline)
+  (display "(")
+  (display (x-point p))
+  (display ",")
+  (display (y-point p))
+  (display ")"))
+
+(print-point (make-point 36 7))
+
+(define (midpoint-segment s)
+  (make-point 
+    (average (x-point (start-segment s)) (x-point (end-segment s))) 
+    (average (y-point (start-segment s)) (y-point (end-segment s))))) 
+
+(define start (make-point 36 7))
+(define end (make-point 36 9))
+(define line (make-segment start end))
+
+(define mid (midpoint-segment line))
+(print-point mid)
diff --git a/coding-exercises/2/3.rkt b/coding-exercises/2/3.rkt
new file mode 100644
index 0000000..83b86aa
--- /dev/null
+++ b/coding-exercises/2/3.rkt
@@ -0,0 +1,59 @@
+#lang racket
+(require "2.rkt")
+
+(define (perimeter rectangle)
+  (* 2 (+ (len (width rectangle)) (len (height rectangle)))))
+(define (area rectangle) 
+  (* (len (width rectangle)) (len (height rectangle)))) 
+
+;; (define (make-rectangle w h)
+;;  (cons w h))
+;; (define (width rectangle)
+;;   (car rectangle))
+;; (define (height rectangle)
+;;   (cdr rectangle))
+
+(define (make-rectangle w h)
+  (lambda (pick)
+    (if pick w h)))
+(define (width rectangle)
+  (rectangle true))
+(define (height rectangle)
+  (rectangle false))
+
+
+(define test-rectangle
+  (make-rectangle
+    (make-segment
+      (make-point 0 0) (make-point 2 0))
+    (make-segment
+      (make-point 0 0) (make-point 0 2))))
+
+(define (print-rectangle r)
+  (newline)
+  (display "rectangle{")
+  (display "width:")
+  (display (len (width r)))
+  (display ",")
+  (display "height:")
+  (display (len (height r)))
+  (display ",")
+  (display "area:")
+  (display (area r))
+  (display ",")
+  (display "perimeter:")
+  (display (perimeter r))
+  (display "}"))
+  
+(define (len segment)
+  (sqrt 
+    (+ (square 
+         (- (x-point (end-segment segment)) (x-point (start-segment segment))))
+       (square 
+         (- (y-point (end-segment segment)) (y-point (start-segment segment)))))))
+
+(define test-len 
+  (len (make-segment (make-point 0 2) (make-point 0 0))))
+
+(print-rectangle test-rectangle)
+
diff --git a/coding-exercises/2/4.rkt b/coding-exercises/2/4.rkt
new file mode 100644
index 0000000..583d697
--- /dev/null
+++ b/coding-exercises/2/4.rkt
@@ -0,0 +1,13 @@
+#lang racket
+(define (cons x y)
+  (lambda (m) (m x y)))
+
+(define (car r)
+  (r (lambda (p q) p)))
+
+(define (cdr r)
+  (r (lambda (p q) q)))
+
+(define test-cons (cons 0 1))
+(car test-cons)
+(cdr test-cons)
diff --git a/coding-exercises/2/5.rkt b/coding-exercises/2/5.rkt
new file mode 100644
index 0000000..311d6f5
--- /dev/null
+++ b/coding-exercises/2/5.rkt
@@ -0,0 +1,25 @@
+#lang racket
+(require sicp)
+(require "chapter1.rkt")
+
+(define (cons a b)
+  (* (power 2 a) (power 3 b)))
+
+(define (cdr i)
+  (define (iter n x)
+    (if (divides? 3 n)
+      (iter (/ n 3) (inc x))
+      x))
+  (iter i 0))
+
+(define (car i)
+  (define (iter n x)
+    (if (divides? 2 n)
+      (iter (/ n 2) (inc x))
+      x))
+  (iter i 0))
+
+
+(define test-cons (cons 5 7))
+(cdr test-cons)
+(car test-cons)
diff --git a/coding-exercises/2/6.rkt b/coding-exercises/2/6.rkt
new file mode 100644
index 0000000..8449104
--- /dev/null
+++ b/coding-exercises/2/6.rkt
@@ -0,0 +1,22 @@
+#lang racket
+(define zero (lambda (f) (lambda (x) x)))
+(define (add-1 n) (lambda (f) (lambda (x) (f ((n f) x)))))
+
+(define one (lambda (f) (lambda (x) (f x))))
+(define two (lambda (f) (lambda (x) (f (f x)))))
+
+(define (add-church f g)
+  (lambda (h) (lambda (x) ((g h) ((f h) x)))))
+
+(define (print)
+    (println (((add-1 zero) inc) 1))
+    (println ((one inc) 1))
+
+    (newline)
+    (println (((add-1 (add-1 zero)) inc) 1))
+    (println ((two inc) 1))
+
+    (newline)
+    (println (((add-church one two) inc) 1)))
+    
+(print)
diff --git a/coding-exercises/2/7.rkt b/coding-exercises/2/7.rkt
new file mode 100644
index 0000000..13f28a6
--- /dev/null
+++ b/coding-exercises/2/7.rkt
@@ -0,0 +1,45 @@
+#lang racket
+(provide
+  make-interval
+  upper-bound
+  lower-bound
+  add-interval
+  mul-interval
+  div-interval
+  print-interval)
+
+(define (add-interval x y)
+  (make-interval (+ (lower-bound x) (lower-bound y))
+                 (+ (upper-bound x) (upper-bound y))))
+
+(define (mul-interval x y)
+  (let ((p1 (* (lower-bound x) (lower-bound y)))
+        (p2 (* (lower-bound x) (upper-bound y)))
+        (p3 (* (upper-bound x) (lower-bound y)))
+        (p4 (* (upper-bound x) (upper-bound y))))
+    (make-interval (min p1 p2 p3 p4)
+                   (max p1 p2 p3 p4))))
+
+(define (div-interval x y)
+  (mul-interval x
+                (make-interval (/ 1.0 (upper-bound y))
+                               (/ 1.0 (lower-bound y)))))
+
+(define (make-interval a b) (cons a b))
+(define (lower-bound x) (car x))
+(define (upper-bound x) (cdr x))
+
+(define (print-interval x)
+  (newline)
+  (display "interval{")
+  (display (lower-bound x))
+  (display ",")
+  (display (upper-bound x))
+  (display "}")
+  (newline))
+
+(define (print)
+  (define test-interval (make-interval 1 2))
+  (print-interval test-interval))
+
+(print)
diff --git a/coding-exercises/2/8.rkt b/coding-exercises/2/8.rkt
new file mode 100644
index 0000000..1a205fd
--- /dev/null
+++ b/coding-exercises/2/8.rkt
@@ -0,0 +1,14 @@
+#lang racket
+(provide
+  sub-interval)
+(require "7.rkt")
+
+(define (sub-interval x y)
+  (make-interval (- (lower-bound x) (upper-bound y))
+                 (- (upper-bound x) (lower-bound y))))
+
+(define (print)
+  (define a (make-interval 1 2))
+  (define b (make-interval 0 2))
+  (print-interval (sub-interval a b)))
+(print)
diff --git a/coding-exercises/2/9.rkt b/coding-exercises/2/9.rkt
new file mode 100644
index 0000000..0525802
--- /dev/null
+++ b/coding-exercises/2/9.rkt
@@ -0,0 +1,38 @@
+#lang racket
+(provide
+  width)
+(require 
+  "7.rkt"
+  "8.rkt"
+  "9.rkt")
+
+(define (width x)
+  (/ (- (upper-bound x) (lower-bound x)) 2))
+ 
+(define (print-sum)
+  (newline)
+  (println "*** (width SUM) == (SUM width) ***")
+  (define a (make-interval 1 8))
+  (define b (make-interval 3 8))
+  (define c (add-interval a b))
+  (define d (sub-interval a b))
+  (define add-width (lambda (x y) (+ (width x) (width y))))
+  (print-interval a) (newline) (println (width a))
+  (print-interval c) (newline) (println (width c))
+  (println (add-width a b))
+  (print-interval d) (newline) (println (width d))
+  (println (add-width a b)))
+(print-sum)
+
+(define (print-mul)
+  (newline) (println " http://community.schemewiki.org/?sicp-ex-2.9 ")
+  (newline) (println " *** Multiplication: two pairs of different intervals with same width *** ")
+  (newline) (println " Can also be check algebraicly")
+  (define a (make-interval 1 8))
+  (define b (make-interval 3 8))
+  (define c (make-interval 0 7))
+  (define d (make-interval 0 5))
+  (println (width (mul-interval a b)))
+  (newline)
+  (println (width (mul-interval c d))))
+(print-mul)