diff options
| author | Mike Vink <mike1994vink@gmail.com> | 2023-03-05 20:58:20 +0100 |
|---|---|---|
| committer | Mike Vink <mike1994vink@gmail.com> | 2023-03-05 20:58:20 +0100 |
| commit | 592ef89cb282ab33d6b10cacae711a4a8e6b1212 (patch) | |
| tree | e945b18ad80cd466639ee2beee3de77da09f1144 | |
| parent | ad461cbbbf839d040cda5d38f72072bbc20b5e4f (diff) | |
start ch2
| -rw-r--r-- | coding-exercises/2/1.rkt | 10 | ||||
| -rw-r--r-- | coding-exercises/2/10.rkt | 14 | ||||
| -rw-r--r-- | coding-exercises/2/2.rkt | 42 | ||||
| -rw-r--r-- | coding-exercises/2/3.rkt | 59 | ||||
| -rw-r--r-- | coding-exercises/2/4.rkt | 13 | ||||
| -rw-r--r-- | coding-exercises/2/5.rkt | 25 | ||||
| -rw-r--r-- | coding-exercises/2/6.rkt | 22 | ||||
| -rw-r--r-- | coding-exercises/2/7.rkt | 45 | ||||
| -rw-r--r-- | coding-exercises/2/8.rkt | 14 | ||||
| -rw-r--r-- | coding-exercises/2/9.rkt | 38 | ||||
| -rw-r--r-- | shared/rationals.rkt | 0 |
11 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) diff --git a/shared/rationals.rkt b/shared/rationals.rkt new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/shared/rationals.rkt |
