Pasted

#lang racket
 
;;;;;;;;;
;; 2.2 ;;
;;;;;;;;;
 
;; points
 
(define (make-point x y)
  (cons x y))
(define (x-point pt) (car pt))
(define (y-point pt) (cdr pt))
 
(define (print-point pt)
  (printf "(~a, ~a)~n"
          (x-point pt)
          (y-point pt)))
 
;; segments
 
(define (make-segment pt1 pt2)
  (cons pt1 pt2))
(define (start-segment segment)
  (car segment))
(define (end-segment segment)
  (cdr segment))
 
(define (average a b)
  (/ (+ a b) 2))
 
(define (midpoint-segment segment)
  (define start-point (start-segment segment))
  (define end-point (end-segment segment))
  (make-point (average (x-point start-point) (x-point end-point))
              (average (y-point start-point) (y-point end-point))))
 
(define pt1 (make-point 1 1))
(define pt2 (make-point -1 3))
(define seg1 (make-segment pt1 pt2))
(print-point (midpoint-segment seg1))
;; (0, 2)
 
;;;;;;;;;
;; 2.3 ;;
;;;;;;;;;
 
;; The first representation for rectangles will be as a pair of line segments that
;; are orthogonal and share a common endpoint.
 
(define (orthogonal? seg1 seg2)
  (zero? (dot-product (get-vector seg1)
                      (get-vector seg2))))
 
(define (get-vector seg) ; identify vectors with points
  (define start-point (start-segment seg))
  (define end-point (end-segment seg))
  (make-point (- (x-point end-point) (x-point start-point))
              (- (y-point end-point) (y-point start-point))))
 
(define (dot-product vec1 vec2)
  (+ (* (x-point vec1) (x-point vec2))
     (* (y-point vec1) (y-point vec2))))
 
(define (common-endpoint? seg1 seg2)
  (define start1 (start-segment seg1))
  (define end1 (end-segment seg1))
  (define start2 (start-segment seg2))
  (define end2 (end-segment seg2))
  (cond [(or (point-equal? start1 start2)
             (point-equal? start1 end2))
         start1]
        [(or (point-equal? end1 start2)
             (point-equal? end1 end2))
         end1]
        [else #f]))
 
(define (point-equal? pt1 pt2)
  (and (= (x-point pt1) (x-point pt2))
       (= (y-point pt1) (y-point pt2))))
 
;; commented out to avoid name conflicts with the new representation
 
;; (define (make-rectangle seg1 seg2)
  ;; (if (and (orthogonal? seg1 seg2)
           ;; (common-endpoint? seg1 seg2))
    ;; (cons seg1 seg2)
    ;; (error "rectangle sides must be orthogonal and share a common endpoint")))
;; (define (first-side rect)
  ;; (car rect))
;; (define (second-side rect)
  ;; (cdr rect))
 
(define (segment-length seg)
  (point-distance (start-segment seg)
                  (end-segment seg)))
 
(define (point-distance pt1 pt2)
  (sqrt (+ (sqr (- (x-point pt1) (x-point pt2)))
           (sqr (- (y-point pt1) (y-point pt2))))))
 
(define (rectangle-area rect)
  (* (segment-length (first-side rect))
     (segment-length (second-side rect))))
 
(define (rectangle-perimeter rect)
  (* 2 (+ (segment-length (first-side rect))
          (segment-length (second-side rect)))))
 
(define pt3 (make-point 1 1))
(define pt4 (make-point 1 3))
(define pt5 (make-point -2 1))
 
(define seg2 (make-segment pt3 pt4))
(define seg3 (make-segment pt5 pt3))
 
(define rect1 (make-rectangle seg2 seg3))
 
(rectangle-area rect1) ; should be 2 * 3 = 6
;; 6
(rectangle-perimeter rect1) ; should be 2 * (2 + 3) = 10
;; 10
 
;; The second representation for rectangles will be as a list of three points that
;; determine two orthogonal line segments.  For rectangle-area and
;; rectangle-perimeter to work unchanged, we need to specify new first-side and
;; second-side functions for the new representation.
 
(define (make-rectangle pt1 pt2 pt3)
  (if (orthogonal? (make-segment pt1 pt2)
                   (make-segment pt2 pt3))
    (list pt1 pt2 pt3)
    (error "the three points must determine orthogonal line segments")))
(define (first-point rect)
  (first rect))
(define (second-point rect)
  (second rect))
(define (third-point rect)
  (third rect))
(define (first-side rect)
  (make-segment (first-point rect)
                (second-point rect)))
 
(define (second-side rect)
  (make-segment (second-point rect)
                (third-point rect)))
 
(define pt6 (make-point 3 4))
(define pt7 (make-point 0 0))
(define pt8 (make-point -4 3))
 
;; Normally two different representations would be kept in different file/modules
;; so we could use the same names for the new constructor and selectors without
;; conflict.  In order to achieve that here, I will simply go back and comment out
;; the old-style constructor and selectors.  Once I do that, we can use the
;; new-style constructor and selectors without having to change their names, and
;; all the rectangle functions like rectangle-area and rectangle-perimeter will
;; work without change.
 
(define rect2 (make-rectangle pt6 pt7 pt8))
 
(rectangle-area rect2) ; should be 25
;; 25
(rectangle-perimeter rect2) ; should be 20
;; 20