From 2a278157adeed91d716f4c0fc55df484d3b79d2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petar=20Kapri=C5=A1?= Date: Mon, 24 Feb 2025 20:51:57 +0100 Subject: [PATCH] Add solutions to exercises from subsection 2.2.4 --- ex-2.44.scm | 31 ++++++++++++++++++ ex-2.45.scm | 26 +++++++++++++++ ex-2.46.scm | 15 +++++++++ ex-2.47.scm | 25 ++++++++++++++ ex-2.48.scm | 23 +++++++++++++ ex-2.49.scm | 72 +++++++++++++++++++++++++++++++++++++++++ ex-2.50.scm | 36 +++++++++++++++++++++ ex-2.51.scm | 43 +++++++++++++++++++++++++ ex-2.52.scm | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 364 insertions(+) create mode 100644 ex-2.44.scm create mode 100644 ex-2.45.scm create mode 100644 ex-2.46.scm create mode 100644 ex-2.47.scm create mode 100644 ex-2.48.scm create mode 100644 ex-2.49.scm create mode 100644 ex-2.50.scm create mode 100644 ex-2.51.scm create mode 100644 ex-2.52.scm diff --git a/ex-2.44.scm b/ex-2.44.scm new file mode 100644 index 0000000..b1bb95d --- /dev/null +++ b/ex-2.44.scm @@ -0,0 +1,31 @@ +#lang sicp + +(#%require sicp-pict) + +(define ein2 (beside einstein (flip-vert einstein))) +(define ein4 (below ein2 ein2)) +(define (right-split painter n) + (if (= n 0) + painter + (let ((right-split-1 (right-split painter (- n 1)))) + (beside painter + (below right-split-1 right-split-1))))) + +(define (corner-split painter n) + (if (= n 0) + painter + (let ((smaller-r (right-split painter (- n 1))) + (smaller-u (up-split painter (- n 1))) + (smaller-c (corner-split painter (- n 1)))) + (below (beside painter + (below smaller-r smaller-r)) + (beside (beside smaller-u smaller-u) + smaller-c))))) + +; the actual exercise: +(define (up-split painter n) + (if (= n 0) + painter + (let ((smaller (up-split painter (- n 1)))) + (below painter + (beside smaller smaller))))) \ No newline at end of file diff --git a/ex-2.45.scm b/ex-2.45.scm new file mode 100644 index 0000000..b46973a --- /dev/null +++ b/ex-2.45.scm @@ -0,0 +1,26 @@ +#lang sicp + +(#%require sicp-pict) + +(define (corner-split painter n) + (if (= n 0) + painter + (let ((smaller-r (right-split painter (- n 1))) + (smaller-u (up-split painter (- n 1))) + (smaller-c (corner-split painter (- n 1)))) + (below (beside painter + (below smaller-r smaller-r)) + (beside (beside smaller-u smaller-u) + smaller-c))))) + +(define (split main-dir side-dir) + (define (split-function painter n) + (if (= n 0) + painter + (let ((smaller (split-function painter (- n 1)))) + (main-dir painter + (side-dir smaller smaller))))) + split-function) + +(define up-split (split below beside)) +(define right-split (split beside below)) \ No newline at end of file diff --git a/ex-2.46.scm b/ex-2.46.scm new file mode 100644 index 0000000..5e01352 --- /dev/null +++ b/ex-2.46.scm @@ -0,0 +1,15 @@ +#lang sicp + +(define (make-vect x y) (cons x y)) +(define (xcor-vect v) (car v)) +(define (ycor-vect v) (cdr v)) + +(define (add-vect u v) + (make-vect (+ (xcor-vect u) (xcor-vect v)) + (+ (ycor-vect u) (ycor-vect v)))) +(define (sub-vect u v) + (make-vect (- (xcor-vect u) (xcor-vect v)) + (- (ycor-vect u) (ycor-vect v)))) +(define (scale-vect s v) + (make-vect (* s (xcor-vect v)) + (* s (ycor-vect v)))) \ No newline at end of file diff --git a/ex-2.47.scm b/ex-2.47.scm new file mode 100644 index 0000000..ee392a9 --- /dev/null +++ b/ex-2.47.scm @@ -0,0 +1,25 @@ +#lang sicp +(define (make-frame origin edge1 edge2) + (list origin edge1 edge2)) +; selectors for the first: +(define (origin-frame f) + (car f)) + +(define (edge1-frame f) + (cadr f)) + +(define (edge2-frame f) + (caddr f)) + + +(define (make-frame origin edge1 edge2) + (cons origin (cons edge1 edge2))) +; selectors for the second: +(define (origin-frame f) + (car f)) + +(define (edge1-frame f) + (cadr f)) + +(define (edge2-frame f) + (cddr f)) \ No newline at end of file diff --git a/ex-2.48.scm b/ex-2.48.scm new file mode 100644 index 0000000..b6a61d3 --- /dev/null +++ b/ex-2.48.scm @@ -0,0 +1,23 @@ +#lang sicp + +;the setup + +(define (make-vect x y) (cons x y)) +(define (xcor-vect v) (car v)) +(define (ycor-vect v) (cdr v)) + +(define (add-vect u v) + (make-vect (+ (xcor-vect u) (xcor-vect v)) + (+ (ycor-vect u) (ycor-vect v)))) +(define (sub-vect u v) + (make-vect (- (xcor-vect u) (xcor-vect v)) + (- (ycor-vect u) (ycor-vect v)))) +(define (scale-vect s v) + (make-vect (* s (xcor-vect v)) + (* s (ycor-vect v)))) + +;the exercise + +(define (make-segment v1 v2) (cons v1 v2)) +(define (start-segment s) (car s)) +(define (end-segment s) (cdr s)) \ No newline at end of file diff --git a/ex-2.49.scm b/ex-2.49.scm new file mode 100644 index 0000000..914ab18 --- /dev/null +++ b/ex-2.49.scm @@ -0,0 +1,72 @@ +#lang sicp + +(#%require sicp-pict) + +(define outline-painter + (segments->painter + (list (make-segment (make-vect 0 0) + (make-vect 0 1)) + (make-segment (make-vect 0 1) + (make-vect 1 1)) + (make-segment (make-vect 1 1) + (make-vect 1 0)) + (make-segment (make-vect 1 0) + (make-vect 0 0))))) +(define x-painter + (segments->painter + (list (make-segment (make-vect 0 0) + (make-vect 1 1)) + (make-segment (make-vect 0 1) + (make-vect 1 0))))) +(define diamond-painter + (segments->painter + (list (make-segment (make-vect 0.5 0) + (make-vect 1 0.5)) + (make-segment (make-vect 1 0.5) + (make-vect 0.5 1)) + (make-segment (make-vect 0.5 1) + (make-vect 0 0.5)) + (make-segment (make-vect 0 0.5) + (make-vect 0.5 0))))) + +; this will be a roundabout drawing, just to +; make the lines nice and connectable between +; wave painters, I'm not an artist. +(define wave + (segments->painter + (list (make-segment (make-vect 0 0.55) + (make-vect 0.2 0.5)) + (make-segment (make-vect 0.2 0.5) + (make-vect 0.4 0.6)) + (make-segment (make-vect 0.4 0.6) + (make-vect 0.35 0.8)) + (make-segment (make-vect 0.35 0.8) + (make-vect 0.4 1)) + (make-segment (make-vect 0.6 1) + (make-vect 0.65 0.8)) + (make-segment (make-vect 0.65 0.8) + (make-vect 0.6 0.6)) + (make-segment (make-vect 0.6 0.6) + (make-vect 0.8 0.7)) + (make-segment (make-vect 0.8 0.7) + (make-vect 1 0.55)) + (make-segment (make-vect 1 0.45) + (make-vect 0.8 0.6)) + (make-segment (make-vect 0.8 0.6) + (make-vect 0.6 0.5)) + (make-segment (make-vect 0.6 0.5) + (make-vect 0.6 0.3)) + (make-segment (make-vect 0.6 0.3) + (make-vect 0.7 0)) + (make-segment (make-vect 0.6 0) + (make-vect 0.5 0.2)) + (make-segment (make-vect 0.5 0.2) + (make-vect 0.4 0)) + (make-segment (make-vect 0.3 0) + (make-vect 0.4 0.3)) + (make-segment (make-vect 0.4 0.3) + (make-vect 0.4 0.5)) + (make-segment (make-vect 0.4 0.5) + (make-vect 0.2 0.4)) + (make-segment (make-vect 0.2 0.4) + (make-vect 0 0.45))))) \ No newline at end of file diff --git a/ex-2.50.scm b/ex-2.50.scm new file mode 100644 index 0000000..1a55d93 --- /dev/null +++ b/ex-2.50.scm @@ -0,0 +1,36 @@ +#lang sicp + +(#%require sicp-pict) + +; inappropriate for the way racket implemented these vectors +;(define (make-vect x y) (cons x y)) +;(define (xcor-vect v) (car v)) +;(define (ycor-vect v) (cdr v)) +(define (xcor-vect v) (vector-xcor v)) +(define (ycor-vect v) (vector-ycor v)) + +(define (add-vect u v) + (make-vect (+ (xcor-vect u) (xcor-vect v)) + (+ (ycor-vect u) (ycor-vect v)))) +(define (sub-vect u v) + (make-vect (- (xcor-vect u) (xcor-vect v)) + (- (ycor-vect u) (ycor-vect v)))) +(define (scale-vect s v) + (make-vect (* s (xcor-vect v)) + (* s (ycor-vect v)))) + + +(define (transform-painter painter origin corner1 corner2) + (lambda (frame) + (let ((m (frame-coord-map frame))) + (let ((new-origin (m origin))) + (painter (make-frame + new-origin + (sub-vect (m corner1) new-origin) + (sub-vect (m corner2) new-origin))))))) + +(define (flip-horiz painter) + (transform-painter painter + (make-vect 1.0 0.0) + (make-vect 0.0 0.0) + (make-vect 1.0 1.0))) \ No newline at end of file diff --git a/ex-2.51.scm b/ex-2.51.scm new file mode 100644 index 0000000..829bc82 --- /dev/null +++ b/ex-2.51.scm @@ -0,0 +1,43 @@ +#lang sicp + +(#%require sicp-pict) + +(define (xcor-vect v) (vector-xcor v)) +(define (ycor-vect v) (vector-ycor v)) + +(define (add-vect u v) + (make-vect (+ (xcor-vect u) (xcor-vect v)) + (+ (ycor-vect u) (ycor-vect v)))) +(define (sub-vect u v) + (make-vect (- (xcor-vect u) (xcor-vect v)) + (- (ycor-vect u) (ycor-vect v)))) +(define (scale-vect s v) + (make-vect (* s (xcor-vect v)) + (* s (ycor-vect v)))) + + +(define (transform-painter painter origin corner1 corner2) + (lambda (frame) + (let ((m (frame-coord-map frame))) + (let ((new-origin (m origin))) + (painter (make-frame + new-origin + (sub-vect (m corner1) new-origin) + (sub-vect (m corner2) new-origin))))))) + +; remember 1 is BELOW 2 +(define (below-a painter1 painter2) + (lambda (frame) + (let ((paint-lo (transform-painter painter1 + (make-vect 0.0 0.0) + (make-vect 1.0 0.0) + (make-vect 0.0 0.5))) + (paint-hi (transform-painter painter2 + (make-vect 0.0 0.5) + (make-vect 1.0 0.5) + (make-vect 0.0 1.0)))) + (paint-lo frame) + (paint-hi frame)))) + +(define (below-b painter1 painter2) + (rotate270 (beside (rotate90 painter2) (rotate90 painter1)))) \ No newline at end of file diff --git a/ex-2.52.scm b/ex-2.52.scm new file mode 100644 index 0000000..e102b33 --- /dev/null +++ b/ex-2.52.scm @@ -0,0 +1,93 @@ +#lang sicp + +(#%require sicp-pict) + + +; a) modified wave: +(define wave + (segments->painter + (list (make-segment (make-vect 0 0.55) + (make-vect 0.2 0.5)) + (make-segment (make-vect 0.2 0.5) + (make-vect 0.4 0.6)) + (make-segment (make-vect 0.4 0.6) + (make-vect 0.35 0.8)) + (make-segment (make-vect 0.35 0.8) + (make-vect 0.4 1)) + (make-segment (make-vect 0.6 1) + (make-vect 0.65 0.8)) + (make-segment (make-vect 0.65 0.8) + (make-vect 0.6 0.6)) + (make-segment (make-vect 0.6 0.6) + (make-vect 0.8 0.7)) + (make-segment (make-vect 0.8 0.7) + (make-vect 1 0.55)) + (make-segment (make-vect 1 0.45) + (make-vect 0.8 0.6)) + (make-segment (make-vect 0.8 0.6) + (make-vect 0.6 0.5)) + (make-segment (make-vect 0.6 0.5) + (make-vect 0.6 0.3)) + (make-segment (make-vect 0.6 0.3) + (make-vect 0.7 0)) + (make-segment (make-vect 0.6 0) + (make-vect 0.5 0.2)) + (make-segment (make-vect 0.5 0.2) + (make-vect 0.4 0)) + (make-segment (make-vect 0.3 0) + (make-vect 0.4 0.3)) + (make-segment (make-vect 0.4 0.3) + (make-vect 0.4 0.5)) + (make-segment (make-vect 0.4 0.5) + (make-vect 0.2 0.4)) + (make-segment (make-vect 0.2 0.4) + (make-vect 0 0.45)) + (make-segment (make-vect 0.4 0.85) ; modifications to wave: + (make-vect 0.45 0.85)) ; + (make-segment (make-vect 0.55 0.85) ; + (make-vect 0.6 0.85)) ; + (make-segment (make-vect 0.4 0.75) ; + (make-vect 0.5 0.7)) ; + (make-segment (make-vect 0.5 0.7) ; + (make-vect 0.6 0.75)) ; + (make-segment (make-vect 0.6 0.75) ; + (make-vect 0.4 0.75))))) ; + +(define (right-split painter n) + (if (= n 0) + painter + (let ((right-split-1 (right-split painter (- n 1)))) + (beside painter + (below right-split-1 right-split-1))))) + + +(define (up-split painter n) + (if (= n 0) + painter + (let ((smaller (up-split painter (- n 1)))) + (below painter + (beside smaller smaller))))) + +(define (corner-split painter n) + (if (= n 0) + painter + (let ((smaller-r (right-split painter (- n 1))) + (smaller-u (up-split painter (- n 1))) + (smaller-c (corner-split painter (- n 1)))) + (below (beside painter + (below (below smaller-r smaller-r) ; changes to + (below smaller-r smaller-r))) ; corner split + (beside (beside (beside smaller-u smaller-u) ; + (beside smaller-u smaller-u)) ; + smaller-c))))) + +(define (square-of-four tl tr bl br) + (lambda (painter) + (let ((top (beside (tl painter) (tr painter))) + (bottom (beside (bl painter) (br painter)))) + (below bottom top)))) + +(define (square-limit painter n) + (let ((combine4 (square-of-four flip-vert rotate180 ; changes to square-limit + identity flip-horiz))) ; + (combine4 (corner-split painter n)))) \ No newline at end of file