1 665c255d 2023-08-04 jrmu (define (make-point x y)
  2 665c255d 2023-08-04 jrmu   (cons x y))
  3 665c255d 2023-08-04 jrmu (define (x-point p)
  4 665c255d 2023-08-04 jrmu   (car p))
  5 665c255d 2023-08-04 jrmu (define (y-point p)
  6 665c255d 2023-08-04 jrmu   (cdr p))
  7 665c255d 2023-08-04 jrmu 
  8 665c255d 2023-08-04 jrmu (define (make-segment start end)
  9 665c255d 2023-08-04 jrmu   (cons start end))
 10 665c255d 2023-08-04 jrmu (define (start-segment seg)
 11 665c255d 2023-08-04 jrmu   (car seg))
 12 665c255d 2023-08-04 jrmu (define (end-segment seg)
 13 665c255d 2023-08-04 jrmu   (cdr seg))
 14 665c255d 2023-08-04 jrmu (define (midpoint-segment seg)
 15 665c255d 2023-08-04 jrmu   (define (average x y)
 16 665c255d 2023-08-04 jrmu     (/ (+ x y) 2))
 17 665c255d 2023-08-04 jrmu   (let ((x1 (x-point (start-segment seg)))
 18 665c255d 2023-08-04 jrmu 	(x2 (x-point (end-segment seg)))
 19 665c255d 2023-08-04 jrmu 	(y1 (y-point (start-segment seg)))
 20 665c255d 2023-08-04 jrmu 	(y2 (y-point (end-segment seg))))
 21 665c255d 2023-08-04 jrmu     (make-point (average x1 x2)
 22 665c255d 2023-08-04 jrmu 		(average y1 y2))))
 23 665c255d 2023-08-04 jrmu 
 24 665c255d 2023-08-04 jrmu (define (print-point p)
 25 665c255d 2023-08-04 jrmu   (newline)
 26 665c255d 2023-08-04 jrmu   (display "(")
 27 665c255d 2023-08-04 jrmu   (display (x-point p))
 28 665c255d 2023-08-04 jrmu   (display ",")
 29 665c255d 2023-08-04 jrmu   (display (y-point p))
 30 665c255d 2023-08-04 jrmu   (display ")"))
 31 665c255d 2023-08-04 jrmu 
 32 665c255d 2023-08-04 jrmu (define x1y2 (make-point 1 2))
 33 665c255d 2023-08-04 jrmu (define x-4y-3 (make-point -4 -3))
 34 665c255d 2023-08-04 jrmu (define x1y2tox-4y-3 (make-segment x1y2 x-4y-3))
 35 665c255d 2023-08-04 jrmu (print-point (midpoint-segment x1y2tox-4y-3))
 36 665c255d 2023-08-04 jrmu (display "=(-3/2,-1/2)")
 37 665c255d 2023-08-04 jrmu 
 38 665c255d 2023-08-04 jrmu ;; Exercise 2.3.  Implement a representation for rectangles in a plane. (Hint: You may want to make use of exercise 2.2.) In terms of your constructors and selectors, create procedures that compute the perimeter and the area of a given rectangle. Now implement a different representation for rectangles. Can you design your system with suitable abstraction barriers, so that the same perimeter and area procedures will work using either representation? 
 39 665c255d 2023-08-04 jrmu 
 40 665c255d 2023-08-04 jrmu ;; makes rectangle given 2 points: top-left and bottom-right
 41 665c255d 2023-08-04 jrmu (define (make-rect tl br)
 42 665c255d 2023-08-04 jrmu   (let ((tr (make-point (x-point br) (y-point tl)))
 43 665c255d 2023-08-04 jrmu 	(bl (make-point (x-point tl) (y-point br))))
 44 665c255d 2023-08-04 jrmu     (cons (cons tl tr)
 45 665c255d 2023-08-04 jrmu 	  (cons bl br))))
 46 665c255d 2023-08-04 jrmu (define (top-left rect)
 47 665c255d 2023-08-04 jrmu   (caar rect))
 48 665c255d 2023-08-04 jrmu (define (bot-right rect)
 49 665c255d 2023-08-04 jrmu   (cddr rect))
 50 665c255d 2023-08-04 jrmu (define (top-right rect)
 51 665c255d 2023-08-04 jrmu   (cdar rect))
 52 665c255d 2023-08-04 jrmu (define (bot-left rect)
 53 665c255d 2023-08-04 jrmu   (cadr rect))
 54 665c255d 2023-08-04 jrmu 
 55 665c255d 2023-08-04 jrmu (define (width rect)
 56 665c255d 2023-08-04 jrmu   (- (x-point (top-right rect)) (x-point (top-left rect))))
 57 665c255d 2023-08-04 jrmu (define (height rect)
 58 665c255d 2023-08-04 jrmu   (- (y-point (top-left rect)) (y-point (bot-left rect))))
 59 665c255d 2023-08-04 jrmu 
 60 665c255d 2023-08-04 jrmu (define (perimeter rect)
 61 665c255d 2023-08-04 jrmu   (+ (* 2 (width rect))
 62 665c255d 2023-08-04 jrmu      (* 2 (height rect))))
 63 665c255d 2023-08-04 jrmu (define (area rect)
 64 665c255d 2023-08-04 jrmu   (* (width rect) (height rect)))
 65 665c255d 2023-08-04 jrmu 
 66 665c255d 2023-08-04 jrmu (define (test-case actual expected)
 67 665c255d 2023-08-04 jrmu   (load-option 'format)
 68 665c255d 2023-08-04 jrmu   (newline)
 69 665c255d 2023-08-04 jrmu   (format #t "Actual: ~A Expected: ~A" actual expected))
 70 665c255d 2023-08-04 jrmu 
 71 665c255d 2023-08-04 jrmu (define tl (make-point 1 6))
 72 665c255d 2023-08-04 jrmu (define br (make-point 10 3))
 73 665c255d 2023-08-04 jrmu (define rect (make-rect tl br))
 74 665c255d 2023-08-04 jrmu (test-case (perimeter rect) 24)
 75 665c255d 2023-08-04 jrmu (test-case (area rect) 27)
 76 665c255d 2023-08-04 jrmu 
 77 665c255d 2023-08-04 jrmu ;; makes rectangle given top-left corner, width, and height
 78 665c255d 2023-08-04 jrmu (define (make-rect top-left width height)
 79 665c255d 2023-08-04 jrmu   (cons top-left (cons width height)))
 80 665c255d 2023-08-04 jrmu (define (top-left rect)
 81 665c255d 2023-08-04 jrmu   (car rect))
 82 665c255d 2023-08-04 jrmu (define (bot-right rect)
 83 665c255d 2023-08-04 jrmu   (make-rect (+ (x-point (top-left rect))
 84 665c255d 2023-08-04 jrmu 		(width rect))
 85 665c255d 2023-08-04 jrmu 	     (- (y-point (top-left rect))
 86 665c255d 2023-08-04 jrmu 		(height rect))))
 87 665c255d 2023-08-04 jrmu (define (top-right rect)
 88 665c255d 2023-08-04 jrmu   (make-rect (+ (x-point (top-left rect))
 89 665c255d 2023-08-04 jrmu 		(width rect))
 90 665c255d 2023-08-04 jrmu 	     (y-point (top-left rect))))
 91 665c255d 2023-08-04 jrmu (define (bot-left rect)
 92 665c255d 2023-08-04 jrmu   (make-rect (x-point (top-left rect))
 93 665c255d 2023-08-04 jrmu 	     (- (y-point (top-left rect))
 94 665c255d 2023-08-04 jrmu 		(height rect))))
 95 665c255d 2023-08-04 jrmu 
 96 665c255d 2023-08-04 jrmu (define (width rect)
 97 665c255d 2023-08-04 jrmu   (cadr rect))
 98 665c255d 2023-08-04 jrmu (define (height rect)
 99 665c255d 2023-08-04 jrmu   (cddr rect))
100 665c255d 2023-08-04 jrmu 
101 665c255d 2023-08-04 jrmu (define rect (make-rect tl 9 3))
102 665c255d 2023-08-04 jrmu (test-case (perimeter rect) 24)
103 665c255d 2023-08-04 jrmu (test-case (area rect) 27)