Advertisement
timothy235

sicp-2-1-2-abstraction-barriers

Feb 18th, 2016
116
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 4.84 KB | None | 0 0
  1. #lang racket
  2.  
  3. ;;;;;;;;;
  4. ;; 2.2 ;;
  5. ;;;;;;;;;
  6.  
  7. ;; points
  8.  
  9. (define (make-point x y)
  10.   (cons x y))
  11. (define (x-point pt) (car pt))
  12. (define (y-point pt) (cdr pt))
  13.  
  14. (define (print-point pt)
  15.   (printf "(~a, ~a)~n"
  16.           (x-point pt)
  17.           (y-point pt)))
  18.  
  19. ;; segments
  20.  
  21. (define (make-segment pt1 pt2)
  22.   (cons pt1 pt2))
  23. (define (start-segment segment)
  24.   (car segment))
  25. (define (end-segment segment)
  26.   (cdr segment))
  27.  
  28. (define (average a b)
  29.   (/ (+ a b) 2))
  30.  
  31. (define (midpoint-segment segment)
  32.   (define start-point (start-segment segment))
  33.   (define end-point (end-segment segment))
  34.   (make-point (average (x-point start-point) (x-point end-point))
  35.               (average (y-point start-point) (y-point end-point))))
  36.  
  37. (define pt1 (make-point 1 1))
  38. (define pt2 (make-point -1 3))
  39. (define seg1 (make-segment pt1 pt2))
  40. (print-point (midpoint-segment seg1))
  41. ;; (0, 2)
  42.  
  43. ;;;;;;;;;
  44. ;; 2.3 ;;
  45. ;;;;;;;;;
  46.  
  47. ;; The first representation for rectangles will be as a pair of line segments that
  48. ;; are orthogonal and share a common endpoint.
  49.  
  50. (define (orthogonal? seg1 seg2)
  51.   (zero? (dot-product (get-vector seg1)
  52.                       (get-vector seg2))))
  53.  
  54. (define (get-vector seg) ; identify vectors with points
  55.   (define start-point (start-segment seg))
  56.   (define end-point (end-segment seg))
  57.   (make-point (- (x-point end-point) (x-point start-point))
  58.               (- (y-point end-point) (y-point start-point))))
  59.  
  60. (define (dot-product vec1 vec2)
  61.   (+ (* (x-point vec1) (x-point vec2))
  62.      (* (y-point vec1) (y-point vec2))))
  63.  
  64. (define (common-endpoint? seg1 seg2)
  65.   (define start1 (start-segment seg1))
  66.   (define end1 (end-segment seg1))
  67.   (define start2 (start-segment seg2))
  68.   (define end2 (end-segment seg2))
  69.   (cond [(or (point-equal? start1 start2)
  70.              (point-equal? start1 end2))
  71.          start1]
  72.         [(or (point-equal? end1 start2)
  73.              (point-equal? end1 end2))
  74.          end1]
  75.         [else #f]))
  76.  
  77. (define (point-equal? pt1 pt2)
  78.   (and (= (x-point pt1) (x-point pt2))
  79.        (= (y-point pt1) (y-point pt2))))
  80.  
  81. ;; commented out to avoid name conflicts with the new representation
  82.  
  83. ;; (define (make-rectangle seg1 seg2)
  84.   ;; (if (and (orthogonal? seg1 seg2)
  85.            ;; (common-endpoint? seg1 seg2))
  86.     ;; (cons seg1 seg2)
  87.     ;; (error "rectangle sides must be orthogonal and share a common endpoint")))
  88. ;; (define (first-side rect)
  89.   ;; (car rect))
  90. ;; (define (second-side rect)
  91.   ;; (cdr rect))
  92.  
  93. (define (segment-length seg)
  94.   (point-distance (start-segment seg)
  95.                   (end-segment seg)))
  96.  
  97. (define (point-distance pt1 pt2)
  98.   (sqrt (+ (sqr (- (x-point pt1) (x-point pt2)))
  99.            (sqr (- (y-point pt1) (y-point pt2))))))
  100.  
  101. (define (rectangle-area rect)
  102.   (* (segment-length (first-side rect))
  103.      (segment-length (second-side rect))))
  104.  
  105. (define (rectangle-perimeter rect)
  106.   (* 2 (+ (segment-length (first-side rect))
  107.           (segment-length (second-side rect)))))
  108.  
  109. (define pt3 (make-point 1 1))
  110. (define pt4 (make-point 1 3))
  111. (define pt5 (make-point -2 1))
  112.  
  113. (define seg2 (make-segment pt3 pt4))
  114. (define seg3 (make-segment pt5 pt3))
  115.  
  116. (define rect1 (make-rectangle seg2 seg3))
  117.  
  118. (rectangle-area rect1) ; should be 2 * 3 = 6
  119. ;; 6
  120. (rectangle-perimeter rect1) ; should be 2 * (2 + 3) = 10
  121. ;; 10
  122.  
  123. ;; The second representation for rectangles will be as a list of three points that
  124. ;; determine two orthogonal line segments.  For rectangle-area and
  125. ;; rectangle-perimeter to work unchanged, we need to specify new first-side and
  126. ;; second-side functions for the new representation.
  127.  
  128. (define (make-rectangle pt1 pt2 pt3)
  129.   (if (orthogonal? (make-segment pt1 pt2)
  130.                    (make-segment pt2 pt3))
  131.     (list pt1 pt2 pt3)
  132.     (error "the three points must determine orthogonal line segments")))
  133. (define (first-point rect)
  134.   (first rect))
  135. (define (second-point rect)
  136.   (second rect))
  137. (define (third-point rect)
  138.   (third rect))
  139. (define (first-side rect)
  140.   (make-segment (first-point rect)
  141.                 (second-point rect)))
  142.  
  143. (define (second-side rect)
  144.   (make-segment (second-point rect)
  145.                 (third-point rect)))
  146.  
  147. (define pt6 (make-point 3 4))
  148. (define pt7 (make-point 0 0))
  149. (define pt8 (make-point -4 3))
  150.  
  151. ;; Normally two different representations would be kept in different file/modules
  152. ;; so we could use the same names for the new constructor and selectors without
  153. ;; conflict.  In order to achieve that here, I will simply go back and comment out
  154. ;; the old-style constructor and selectors.  Once I do that, we can use the
  155. ;; new-style constructor and selectors without having to change their names, and
  156. ;; all the rectangle functions like rectangle-area and rectangle-perimeter will
  157. ;; work without change.
  158.  
  159. (define rect2 (make-rectangle pt6 pt7 pt8))
  160.  
  161. (rectangle-area rect2) ; should be 25
  162. ;; 25
  163. (rectangle-perimeter rect2) ; should be 20
  164. ;; 20
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement