#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