From c4fbf3dabe118150907def3328370d7a8030f645 Mon Sep 17 00:00:00 2001 From: Felix Martin Date: Sun, 25 Oct 2020 21:40:51 -0400 Subject: [PATCH] Implement exercises till 2.6 --- ex-2_01-xx.scm => ex-2_01-06.scm | 85 ++++++++++++++++++++++++++++++-- ex-2_07-16.scm | 20 ++++++++ ex-2_17-xx.scm | 0 util.scm | 3 +- 4 files changed, 103 insertions(+), 5 deletions(-) rename ex-2_01-xx.scm => ex-2_01-06.scm (56%) create mode 100644 ex-2_07-16.scm create mode 100644 ex-2_17-xx.scm diff --git a/ex-2_01-xx.scm b/ex-2_01-06.scm similarity index 56% rename from ex-2_01-xx.scm rename to ex-2_01-06.scm index 2f19c57..9d9bfe1 100644 --- a/ex-2_01-xx.scm +++ b/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) + diff --git a/ex-2_07-16.scm b/ex-2_07-16.scm new file mode 100644 index 0000000..2533fdf --- /dev/null +++ b/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") + diff --git a/ex-2_17-xx.scm b/ex-2_17-xx.scm new file mode 100644 index 0000000..e69de29 diff --git a/util.scm b/util.scm index 06da37e..6e554cf 100644 --- a/util.scm +++ b/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)