Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement