kayprish/sicp-solutions
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add solutions to exercises from subsection 2.2.4

Browse source
This commit is contained in:
Petar Kapriš 2025-02-24 20:51:57 +01:00
parent 2ca5e73a27
commit 2a278157ad
9 changed files with 364 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
ex-2.44.scm Normal file
View file

@ -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)))))

26
ex-2.45.scm Normal file
View file

@ -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))

15
ex-2.46.scm Normal file
View file

@ -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))))

25
ex-2.47.scm Normal file
View file

@ -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))

23
ex-2.48.scm Normal file
View file

@ -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))

72
ex-2.49.scm Normal file
View file

@ -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)))))

36
ex-2.50.scm Normal file
View file

@ -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)))

43
ex-2.51.scm Normal file
View file

@ -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))))

93
ex-2.52.scm Normal file
View file

@ -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))))