sicp-ex-2.49

<< Previous exercise (2.48) | Index | Next exercise (2.50) >>

x3v

Used DrRacket instead of emacs for this chapter as there is an sicp-compatible graphics library. Imports shown below. Use the segments->painter procedure provided by the library, unless you want to implement draw-line yourself. The compatible procedures are vect and segment instead of make-vect and make-segment. Hope this helps. 

 #lang sicp 
 (#%require sicp-pict) 
  
 ;; Exercise 2.49 - Use the segments->painter procedure provided by the library 
 ;; Procedures to use: vect, segment; instead of make-vect and make-segment 
  
 ;; Exercise 2.49a 
 (define outline 
   (segments->painter 
    (list 
     (segment (vect 0.0 0.0) (vect 0.0 1.0)) 
     (segment (vect 0.0 0.0) (vect 1.0 0.0)) 
     (segment (vect 0.0 1.0) (vect 1.0 1.0)) 
     (segment (vect 1.0 0.0) (vect 1.0 1.0))))) 
  
 ;; (paint outline) 
  
 ;; Exercise 2.49b 
 (define x-painter 
   (segments->painter 
    (list 
     (segment (vect 0.0 0.0) (vect 1.0 1.0)) 
     (segment (vect 0.0 1.0) (vect 1.0 0.0))))) 
  
 ;; (paint x-painter) 
  
 ;; Exercise 2.49c 
 (define diamond 
   (segments->painter 
    (list 
     (segment (vect 0.0 0.5) (vect 0.5 1.0)) 
     (segment (vect 0.5 1.0) (vect 1.0 0.5)) 
     (segment (vect 1.0 0.5) (vect 0.5 0.0)) 
     (segment (vect 0.5 0.0) (vect 0.0 0.5))))) 
  
 ;; Exercise 2.49d - Not sure if the below implementation unnecessarily complicates the process 
 ;; Measurements of frame on kindle x: 1.5 y: 1.8 
 (define x 1.5) 
 (define y 1.8) 
  
 ;; Define helper functions 
 ;; takes a list of coords with the format x1 y1 x2 y2 and normalises them wrt measurements 
 (define (normalize coords) 
   (let ((x1 (car coords)) 
         (y1 (cadr coords)) 
         (x2 (caddr coords)) 
         (y2 (cadddr coords))) 
     (list (/ x1 x) (/ y1 y) (/ x2 x) (/ y2 y))))  
  
 ;; symmetry will be useful 
 (define (mirror coords) 
   (list (- x (car coords)) (cadr coords) (- x (caddr coords)) (cadddr coords)))  
  
 ;; takes a list of coords converts to a line segment 
 (define (list->line coords) 
   (let ((x1 (car coords)) 
         (y1 (cadr coords)) 
         (x2 (caddr coords)) 
         (y2 (cadddr coords))) 
     (segment (vect x1 y1) (vect x2 y2)))) 
  
 ;; define wave coords 
 (define wave-coords 
   (list 
    (list 0.5 1.5 0.65 y) 
    (mirror (list 0.5 1.5 0.65 y)) 
    (list 0.5 1.5 0.65 1.2) 
    (mirror (list 0.5 1.5 0.65 1.2)) 
    (list 0.5 1.22 0.65 1.2) ;; left neck (0.65 1.2) 
    (mirror (list 0.5 1.22 0.65 1.2)) 
    (list 0.5 1.22 0.3 1.05) 
    (mirror (list 0.5 1.22 0.3 1.05)) 
    (list 0.3 1.05 0.0 1.35) 
    (list (- x 0.3) 1.05 x 0.65) 
    (list 0.4 0 0.55 1) ;; left armpit (0.55 1) 
    (mirror (list 0.4 0 0.55 1)) 
    (list 0.55 1 0.25 0.85) 
    (mirror (list 0.4 0 0.55 1)) 
    (list 0.25 0.85 0 1.15) 
    (list (- x 0.55) 1 x 0.5) 
    (list 0.6 0 0.7 0.5) 
    (mirror (list 0.6 0 0.7 0.5)) 
    (list 0.7 0.5 (/ x 2) 0.58) 
    (mirror (list 0.7 0.5 (/ x 2) 0.58)))) 
  
 (define wave 
   (segments->painter 
    (map list->line (map normalize wave-coords)))) 
  
 ;; (paint wave) 
 ;; (paint (square-limit wave 10) 
 ;; Image of square limit wave: https://imgur.com/a/rknhedQ 


 ;; Exercise 2.49 
 (let ((tl (make-vect 0 1)) 
       (tr (make-vect 1 1)) 
       (bl (make-vect 0 0)) 
       (br (make-vect 1 0))) 
   ;; a 
   (segments->painter (list 
                       (make-segment bl tl) 
                       (make-segment tl tr) 
                       (make-segment tr br) 
                       (make-segment br bl))) 
   ;; b 
   (segments->painter (list 
                       (make-segment bl tr) 
                       (make-segment br tl)))) 
    
 (let ((l (make-vect 0 0.5)) 
       (t (make-vect 0.5 1)) 
       (r (make-vect 1 0.5)) 
       (b (make-vect 0.5 0))) 
   ;; c 
   (segments->painter (list 
                       (make-segment l t) 
                       (make-segment t r) 
                       (make-segment r b) 
                       (make-segment b l))))

caesarjuly

I think my solution is more accurate 

  
 (define (base frame) (origin frame)) 
 (define (right frame) (add-vector (base frame) (edge1 frame))) 
 (define (left frame) (add-vector (base frame) (edge2 frame))) 
 (define (top frame) (add-vector (right frame) (edge2 frame))) 
  
 (define (frame-painter frame)  
     (let ((b (make-segment (base frame) (right frame))) 
           (l (make-segment (base frame) (left-frame))) 
           (t (make-segment (left-frame) (top-frame))) 
           (r (make-segment (right-frame) (top-frame)))) 
         ((segments->painter (list b l t r)) frame))) 
  
 (define (x-painter frame)  
     (let ((h (make-segment (left frame) (right frame))) 
           (v (make-segment (base frame) (top-frame)))) 
         ((segments->painter (list h v)) frame))) 
  
 (define (middle-painter frame)  
     (let ((b (/ (add-vector (base frame) (right frame)) 2)) 
           (l (/ (add-vector (base frame) (left frame)) 2)) 
           (t (/ (add-vector (left frame) (top frame)) 2)) 
           (r (/ (add-vector (right frame) (top frame)) 2))) 
         ((segments->painter (list (make-segment b r)  
                                   (make-segment b l) 
                                   (make-segment l t) 
                                   (make-segment r t)))  
         frame)))

mathieub

@caesarjuly Unless '/' is overloaded somehow and performs division on pairs, your solution will not work. Also, there's no need to pass the frame argument to your painters, segments->painter returns a lambda that will accept the frame as it's argument.


brave one

  
  
  
 ; sorry no make-<something> and selectors here, too much to type! 
  
 ; a. 
 (define outline 
   (let ((segments '( 
                     ((0 0) (0 1)) 
                     ((0 1) (1 1)) 
                     ((1 1) (1 0)) 
                     ((1 0) (0 0)) 
                    ))) 
     (segments->painter segments))) 
  
 ; b. 
 (define cross 
   (let ((segments '( 
                     ((0 0) (1 1)) 
                     ((0 1) (1 0)) 
                    ))) 
     (segments->painter segments))) 
  
 ; c. 
 (define diamond 
   (let ((segments '( 
                     ((0 0.5) (0.5 1)) 
                     ((0.5 1) (1 0.5)) 
                     ((1 0.5) (0.5 0)) 
                     ((0.5 0) (0 0.5)) 
                    ))) 
     (segments->painter segments)))

SophiaG

The wording of the exercise seems to imply these functions should take a frame as input and calculate the segments based on that, which would also be much more useful should one intend to actually use them for drawing. Here's my answer given that:

(Also including coordinates for wave, aka George, pulled from a comment on Weiqun Zhang's blog by someone calling themselves "physjam") 

 (define (outline->painter frame) 
   (let ((origin2 (make-vect  
                   (- (xcor-vect (edge2-frame frame))  
                      (xcor-vect (origin-frame frame))) 
                   (- (ycor-vect (edge1-frame frame))  
                      (ycor-vect (origin-frame frame)))))) 
     (segments->painter  
      (list           
       (make-segment (origin-frame frame) (edge1-frame frame)) 
       (make-segment (edge1-frame frame) origin2) 
       (make-segment origin2 (edge2-frame frame)) 
       (make-segment (edge2-frame frame) (origin-frame frame)))))) 
  
 (define (X->painter frame) 
   (let ((origin2 (make-vect  
                   (- (xcor-vect (edge2-frame frame))  
                      (xcor-vect (origin-frame frame))) 
                   (- (ycor-vect (edge1-frame frame))  
                      (ycor-vect (origin-frame frame)))))) 
     (segments->painter  
      (list           
       (make-segment (origin-frame frame) origin2) 
       (make-segment (edge1-frame frame) (edge2-frame frame)))))) 
  
 (define (diamond->painter frame) 
   (let ((midpoint1 (sub-vect (edge1-frame frame) (origin-frame frame)))  
         (midpoint2 (sub-vect origin2 (edge1-frame frame)))  
         (midpoint3 (sub-vect origin2 (edge2-frame frame))) 
         (midpoint4 (sub-vect (edge2-frame frame) (origin-frame frame)))) 
     (segments->painter  
      (list           
       (make-segment midpoint1 midpoint2) 
       (make-segment midpoint2 midpoint3) 
       (make-segment midpoint3 midpoint4) 
       (make-segment midpoint4 midpoint1))))) 
  
 (define wave 
   (segments->painter (list 
                       (make-segment (make-vect .25 0) (make-vect .35 .5)) 
                       (make-segment (make-vect .35 .5) (make-vect .3 .6)) 
                       (make-segment (make-vect .3 .6) (make-vect .15 .4)) 
                       (make-segment (make-vect .15 .4) (make-vect 0 .65)) 
                       (make-segment (make-vect 0 .65) (make-vect 0 .85)) 
                       (make-segment (make-vect 0 .85) (make-vect .15 .6)) 
                       (make-segment (make-vect .15 .6) (make-vect .3 .65)) 
                       (make-segment (make-vect .3 .65) (make-vect .4 .65)) 
                       (make-segment (make-vect .4 .65) (make-vect .35 .85)) 
                       (make-segment (make-vect .35 .85) (make-vect .4 1)) 
                       (make-segment (make-vect .4 1) (make-vect .6 1)) 
                       (make-segment (make-vect .6 1) (make-vect .65 .85)) 
                       (make-segment (make-vect .65 .85) (make-vect .6 .65)) 
                       (make-segment (make-vect .6 .65) (make-vect .75 .65)) 
                       (make-segment (make-vect .75 .65) (make-vect 1 .35)) 
                       (make-segment (make-vect 1 .35) (make-vect 1 .15)) 
                       (make-segment (make-vect 1 .15) (make-vect .6 .45)) 
                       (make-segment (make-vect .6 .45) (make-vect .75 0)) 
                       (make-segment (make-vect .75 0) (make-vect .6 0)) 
                       (make-segment (make-vect .6 0) (make-vect .5 .3)) 
                       (make-segment (make-vect .5 .3) (make-vect .4 0)) 
                       (make-segment (make-vect .4 0) (make-vect .25 0)) 
                       ))) 
 ;George!

Lera

Here is only d-solution 

  
 (define (do-many-vectors x-coords y-coords) 
   (let ((coeff (/ 1 4.8)))  
     (map (lambda (x y) (vector-scale  coeff (make-vect x y))) x-coords y-coords))) 
     ;; I just measured  with a ruler all distances on the screen and then divided by side of frame all measured distances  
  
 (define (make-many-segments start-vectors end-vectors) 
   (map (lambda (start-vector end-vector) (make-segment start-vector end-vector)) 
        start-vectors 
        end-vectors)) 
  
 (define start-vectors (do-many-vectors 
                        (list 1.2 1.7 1.5 0.7 0 0.7 1.5 1.9 1.7 2.9 3.1 2.9 3.6 2.9 2.9 2.9 2.4) 
                        (list 0 2.35 2.7 1.9 4.0 2.8 3.05 3.05 3.9 4.8 3.9 3.05 3.05 2.1 2.1 0 1.4))) 
 (define end-vectors (do-many-vectors 
                      (list 1.7 1.5 0.7 0 0.7 1.5 1.9 1.7 1.9 3.1 2.9 3.6 4.8 4.8 3.6 2.4 2.0) 
                      (list 2.35 2.7 1.9 3.1 2.8 3.05 3.05 3.9 4.8 3.9 3.05 3.05 1.8 0.75 0 1.4 0))) 
  
 (define list-of-wave (make-many-segments start-vectors end-vectors)) 
  
 (define wave (segments->painter list-of-wave))


Last modified : 2021-11-05 11:40:06
WiLiKi 0.5-tekili-7 running on Gauche 0.9