Implement exercises till 2.6

ex-2_01-06.scm

@@ -51,6 +51,11 @@
 (print-rat (make-rat 3 -9))
 (print-rat (make-rat -3 -9))
 
+; More elegant (but harder to read?) solution
+(define (make-rat n d)
+  (let ((g ((if (< d 0) - +) (abs (gcd n d)))))
+    (cons (/ n g) (/ d g))))
+
 (display "\n\nex-2.2")
 
 (define (make-point x y) (cons x y))
@@ -79,17 +84,26 @@
 (display "\n\nex-2.3\n")
 
 ; The first representation takes the two opposite corners of the rectangle.
+; This assumes that the rectangle is aligned in parallel to the X and Y axis.
+; If we use segments to represent two sides originating from the same point we
+; would first have to calculate the length of each of these sides. I am not
+; changing the code now but it shows how engineering decisions limit what can
+; be accomplished, but also make the problem more trivial.
 (define (make-rectangle p1 p2) (cons p1 p2))
 (define (corner-1-rectangle r) (car r))
 (define (corner-2-rectangle r) (cdr r))
 
+(define (x-length-rectangle r)
+  (abs (- (x-point (corner-1-rectangle r)) (x-point (corner-2-rectangle r)))))
+
+(define (y-length-rectangle r)
+  (abs (- (y-point (corner-1-rectangle r)) (y-point (corner-2-rectangle r)))))
+
 (define (area-rectangle r)
-  (abs (* (- (x-point (corner-1-rectangle r)) (x-point (corner-2-rectangle r)))
-          (- (y-point (corner-1-rectangle r)) (y-point (corner-2-rectangle r))))))
+  (* (x-length-rectangle r) (y-length-rectangle r)))
 
 (define (perimeter-rectangle r)
-  (* 2 (+ (abs (- (x-point (corner-1-rectangle r)) (x-point (corner-2-rectangle r))))
-          (abs (- (y-point (corner-1-rectangle r)) (y-point (corner-2-rectangle r)))))))
+  (* 2 (+ (x-length-rectangle r) (y-length-rectangle r))))
 
 (define r (make-rectangle (make-point -2 -2) (make-point -8 -10)))
 (display (area-rectangle r)) (newline)
@@ -111,3 +125,66 @@
 (display (perimeter-rectangle r)) (newline)
 
 (display "\nex-2.4\n")
+
+(define (cons x y)
+  (lambda (m) (m x y)))
+
+(define (car z)
+  (z (lambda (p q) p)))
+
+(define (cdr z)
+  (z (lambda (p q) q)))
+
+; Process with substitution model.
+(let ((x 1) (y 2))
+  (car (cons x y))
+  (car (lambda (m) (m x y)))
+  ((lambda (m) (m x y)) (lambda (p q) p))
+  ((lambda (p q) p) x y)
+  x)
+
+(display (car (cons 1 2))) (newline)
+(display (cdr (cons 1 2))) (newline)
+
+(display "\nex-2.5\n")
+
+(define (cons-ari a b)
+  (cond ((and (>= a 0) (>= b 0))
+          (* (expt 2 a) (expt 3 b)))
+        (else (error "Negative integers not allowed" a b))))
+
+(define (count-factor n f)
+  (if (and (> n 0) (= (remainder n f) 0))
+    (+ 1 (count-factor (/ n f) f))
+    0))
+
+(define (car-ari p) (count-factor p 2))
+(define (cdr-ari p) (count-factor p 3))
+
+(define p (cons-ari 13 3))
+
+(display (car-ari p)) (newline)
+(display (cdr-ari p)) (newline)
+
+(display "\nex-2.6\n")
+
+(define zero (lambda (f) (lambda (x) x)))
+(define one (lambda (f) (lambda (x) (f x))))
+(define two (lambda (f) (lambda (x) (f (f x)))))
+(define (add-1 n) (lambda (f) (lambda (x) (f ((n f) x)))))
+
+(display (((add-1 zero) inc) 0)) (newline)
+(display (((add-1 one) inc) 0)) (newline)
+(display (((add-1 (add-1 two)) inc) 0)) (newline)
+
+(define (add-church n m)
+  (lambda (f) (lambda (x) ((n f) ((m f) x)))))
+
+(define (mul-church n m)
+  (lambda (f) (lambda (x) ((n (m f)) x))))
+
+(define church-five (add-1 (add-church two two)))
+
+(display (((add-church church-five two) inc) 0)) (newline)
+(display (((mul-church church-five two) inc) 0)) (newline)
+

ex-2_07-16.scm

@@ -0,0 +1,20 @@
+(display "ex-2.7 - Start of extended exercise interval arithmetic\n")
+
+(display "\nex-2.8\n")
+
+(display "\nex-2.9\n")
+
+(display "\nex-2.10\n")
+
+(display "\nex-2.11\n")
+
+(display "\nex-2.12\n")
+
+(display "\nex-2.13\n")
+
+(display "\nex-2.14\n")
+
+(display "\nex-2.15\n")
+
+(display "\nex-2.16\n")
+

util.scm

@@ -11,5 +11,6 @@
   (if (= b 0) (abs a) (gcd b (remainder a b))))
 
 (define (average a b) (/ (+ a b) 2.0))
+(define (id n) n)
+(define (inc n) (+ n 1))
 
-;(assert (gcd 93 15) 3)