compound data and intervals

2.1/2.01.scm

@@ -0,0 +1,42 @@
+
+(define (gcd a b)
+  (if (= b 0)
+      a
+      (gcd b (remainder a b))))
+
+(define (print-rat x)
+  (display (numer x))
+  (display "/")
+  (display (denom x))
+  (newline))
+
+;;  XOR: Exclusive OR
+;;
+;;    x      y   (xor x y)
+;;  ----------------------
+;;  false  false  false
+;;  false  true   true
+;;  true   false  true
+;;  true   true   false
+;;  ----------------------
+;;
+(define (xor x y)
+  (or (and x (not y)) 
+      (and y (not x))))
+
+(define (numer x) (car x))
+(define (denom x) (cdr x))
+
+(define (make-rat n d) 
+  (let ((g (gcd n d))
+	(sign (if (xor (positive? n) 
+		       (positive? d)) 
+		  - 
+		  +)))
+    (cons (/ (sign (abs n)) g) 
+	  (/ (abs d) g))))
+
+(print-rat (make-rat 12 -15))
+(print-rat (make-rat -4 -18))
+(print-rat (make-rat -18 15))
+(print-rat (make-rat 3 5))

2.1/2.02.scm

@@ -0,0 +1,50 @@
+
+(define (make-segment start end)
+  (cons start end))
+
+(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 (average a b)
+  (/ (+ a b) 2))
+
+(define (midpoint-segment s)
+  (let* ((start (start-segment s))
+	 (end   (end-segment s))
+	 (x1 (x-point start))
+	 (y1 (y-point start))
+	 (x2 (x-point end))
+	 (y2 (y-point end)))
+    (make-point (average x1 x2)
+		(average y1 y2))))
+
+;; From the book, modified
+(define (print-point p)
+  (display "(")
+  (display (x-point p))
+  (display ",")
+  (display (y-point p))
+  (display ")")
+  (newline))
+
+;; Make points and a segment
+
+(define a1 (make-point 4 2))
+(define b1 (make-point 10 -12))
+
+(define seg1 (make-segment a1 b1))
+
+;; Find midpoint
+(print-point (midpoint-segment seg1)) ; => (7,-5) correct

2.1/2.03.scm

@@ -0,0 +1,113 @@
+
+;; Depends on 2.02
+
+;; Both definitions of make-rectangle below create rectangles 
+;; with sides parallel to coordinate axes. 
+
+;; First variant asks for lower-left and upper-right corner of the rectangle
+(define (make-rectangle down-left up-right)
+  (let ((up-left    (make-point (x-point down-left)
+				(y-point up-right)))
+	(down-right (make-point (x-point up-right)
+				(y-point down-left))))
+    (rect-4-corners down-left up-left up-right down-right)))
+
+;; 2nd variant asks for diagonal running from upper-left to lower-right corner
+(define (make-rectangle diagonal)
+  (let* ((diag-start (start-segment diagonal))
+	 (diag-end   (end-segment diagonal))
+	 (up-left    diag-start)
+	 (down-right diag-end)
+	 (down-left  (make-point (x-point diag-start)
+				 (y-point diag-end)))
+	 (up-right   (make-point (x-point diag-end)
+				 (y-point diag-start))))
+    (rect-4-corners down-left up-left up-right down-right)))
+
+;; Accepts four corners of the rectangle as input.
+;; Returns 4 sides as segment pairs: ((left, right), (bottom, top))
+(define (rect-4-corners down-left up-left up-right down-right)
+  (let ((left   (make-segment down-left  up-left))
+	(right  (make-segment down-right up-right))
+	(bottom (make-segment down-left  down-right))
+	(top    (make-segment up-left    up-right)))
+    (cons (cons left right) (cons bottom top))))
+
+(define (leftside-rectangle r)
+  (caar r))
+
+(define (rightside-rectangle r)
+  (cdar r))
+
+(define (bottomside-rectangle r)
+  (cadr r))
+
+(define (topside-rectangle r)
+  (cddr r))
+
+(define (segment-length s)
+  (let ((x-length (abs (- (x-point (end-segment s))
+			  (x-point (start-segment s)))))
+	(y-length (abs (- (y-point (end-segment s))
+			  (y-point (start-segment s))))))
+    (sqrt (+ (sqr x-length) (sqr y-length)))))
+
+(define (perimeter r)
+  (* 2 (+ (segment-length (leftside-rectangle r))
+	  (segment-length (bottomside-rectangle r)))))
+
+(define (area r)
+  (* (segment-length (leftside-rectangle r))
+     (segment-length (bottomside-rectangle r))))
+
+(define diagonal0 (make-segment (make-point 0 3) 
+				(make-point 4 0)))
+
+(segment-length diagonal0)
+
+;; Using corner points
+(define rect1 (make-rectangle (make-point 0 0)
+			      (make-point 4 3)))
+
+(perimeter rect1) ; => 14
+(area rect1)      ; => 12
+
+;; Using diagonal (must redefine make-rectangle first)
+(define rect1 (make-rectangle diagonal0))
+
+;; Third variant of make-rectangle uses two diagonals to construct
+;; rectangle. First diagonal runs from up-left to down-right corner,
+;; second from down-left to up-right corner.
+(define (make-rectangle diag1 diag2)
+  (if (and (equal-enough? (segment-length diag1) 
+			  (segment-length diag2))
+	   (close-enough? (midpoint-segment diag1)
+			  (midpoint-segment diag2)))
+      (let* ((up-left    (start-segment diag1))
+	     (down-right (end-segment diag1))
+	     (down-left  (start-segment diag2))
+	     (up-right   (end-segment diag2)))
+	(rect-4-corners down-left up-left up-right down-right))
+      (printf "These diagonals don't describe a rectangle.\n")))
+
+(define tolerance 0.001)
+
+(define (equal-enough? a b)
+  (< (abs (- a b)) tolerance))
+
+(define (close-enough? point1 point2)
+  (< (segment-length (make-segment point1 point2)) tolerance))
+
+(define diagonal1 (make-segment (make-point 0 5/2)
+				(make-point 0 -5/2)))
+
+(define diagonal2 (make-segment (make-point -12/5 -7/10)
+				(make-point 12/5 7/10)))
+
+(define rect2 (make-rectangle diagonal1 diagonal2))
+
+(perimeter rect2) ; => 14
+(area rect2)      ; => 12
+
+(segment-length (rightside-rectangle rect2)) ; => 4
+(segment-length (topside-rectangle rect2))   ; => 3

2.1/2.04.scm

@@ -0,0 +1,22 @@
+
+(define (mycons x y)
+  (lambda (m) (m x y)))
+
+(define (mycar z)
+  (z (lambda (p q) p)))
+
+(mycar (mycons 3 12)) ; => 3
+
+;; mycons returns a procedure that expects a procedure as its input.
+;; mycar expects a procedure as input and applies it to another procedure.
+
+;; By calling (mycons 3 12) we get anonymous procedure (λ (m) (m 3 12)).
+;; By calling (mycar (mycons 3 12)) we produce the following expression:
+;; ((λ (m) (m 3 12)) (λ (p q) p)), which in turn produces another one:
+;; ((λ (p q) p) 3 12). This returns its first argument and discards second.
+
+;; Like mycar, but the λ-expression returns 2nd argument and discards 1st.
+(define (mycdr z)
+  (z (lambda (p q) q)))
+
+(mycdr (mycons 3 12)) ; => 12

2.1/2.05.scm

@@ -0,0 +1,24 @@
+
+;; Extracts the exponent of given base from product 2ᵅ3ᵇ held in pack
+;; by counting how many times can pack be divided by base without remainder
+(define (extract pack base count)
+  (if (> (remainder pack base) 0)
+      count
+      (extract (quotient pack base) 
+	       base
+	       (add1 count))))
+
+(define (mycons a b)
+  (* (expt 2 a) (expt 3 b)))
+
+(define (mycar x)
+  (extract x 2 0))
+
+(define (mycdr x)
+  (extract x 3 0))
+
+;; Tests
+(mycar (mycons 27 13)) ; => 27
+(mycdr (mycons 27 13)) ; => 13
+
+(mycdr (mycons 70 0))  ; => 0

2.1/2.06.scm

@@ -0,0 +1,33 @@
+(define zero (lambda (f) (lambda (x) x)))
+
+(define (add-1 n)
+  (lambda (f) (lambda (x) (f ((n f) x)))))
+
+;; one = (add-1 zero) = (lambda (f) (lambda (x) (f ((zero f) x)))) =
+;; (lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) x)) f) x)))) =
+;; (lambda (f) (lambda (x) (f ((lambda (x) x) x)))) =
+;; (lambda (f) (lambda (x) (f x))) 
+
+(define one (lambda (f) (lambda (x) (f x))))
+
+;; two = (add-1 one) = (lambda (f) (lambda (x) (f ((one f) x)))) =
+;; (lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) (f x))) f) x)))) =
+;; (lambda (f) (lambda (x) (f ((lambda (x) (f x)) x)))) =
+;; (lambda (f) (lambda (x) (f (f x))))
+
+(define two (lambda (f) (lambda (x) (f (f x)))))
+
+(define (plus m n)
+  (λ (f) (λ (x) ((repeated f (+ m n)) x))))
+
+(define (repeated f times)
+  (λ (x)
+     (define (again n)
+     (if (zero? n)
+	 x
+	 (f (again (sub1 n)))))
+     (again times)))
+
+((two add1) 0) ; => 2
+
+(((plus 3 4) add1) 3) ; => 10

2.1/2.07.scm

@@ -0,0 +1,11 @@
+(define (make-interval a b) (cons a b))
+
+(define (lower-bound interval)
+  (min (car interval) (cdr interval)))
+
+(define (upper-bound interval)
+  (max (car interval) (cdr interval)))
+
+(lower-bound (make-interval 7.2 7.6))
+
+(upper-bound (make-interval 7.2 7.6))

2.1/2.08.scm

@@ -0,0 +1,12 @@
+
+(define (sub-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))))
+
+
+(sub-interval (make-interval 7.2 7.6) (make-interval 4.4 4.9))
+; => '(2.3 . 3.2)