<< Previous exercise (2.2) | Index | Next exercise (2.4) >>
;; ex 2.3. Not bothering with error/sanity checking. ;; Point (define (make-point x y) (cons x y)) (define (x-point p) (car p)) (define (y-point p) (cdr p)) ;; Rectangle - 1st implementation (define (make-rect bottom-left top-right) (cons bottom-left top-right)) ;; "Internal accessors", not to be used directly by clients. Not sure ;; how to signify this in scheme. (define (bottom-left rect) (car rect)) (define (bottom-right rect) (make-point (x-point (cdr rect)) (y-point (car rect)))) (define (top-left rect) (make-point (x-point (car rect)) (y-point (cdr rect)))) (define (top-right rect) (cdr rect)) (define (width-rect rect) (abs (- (x-point (bottom-left rect)) (x-point (bottom-right rect))))) (define (height-rect rect) (abs (- (y-point (bottom-left rect)) (y-point (top-left rect))))) ;; Public methods. (define (area-rect rect) (* (width-rect rect) (height-rect rect))) (define (perimeter-rect rect) (* (+ (width-rect rect) (height-rect rect)) 2)) ;; Usage: (define r (make-rect (make-point 1 1) (make-point 3 7))) (area-rect r) (perimeter-rect r) ;; --------- ;; Alternate implementation of rectangle. Note that this would screw ;; up clients that call make-rect directly, since it uses a different ;; number of args and different arg meanings, but it's generally bad ;; form for clients to call constructors directly anyway, they should ;; call some kind of factory method (cf "Domain Driven Design"). ;; assuming, not checking width, height > 0. (define (make-rect bottom-left width height) (cons bottom-left (cons width height))) (define (height-rect rect) (cdr (cdr rect))) (define (width-rect rect) (car (cdr rect))) ;; area and perimeter ops remain unchanged. The internal methods from ;; the first implementation won't work now. ;; Usage for second implementation: (define r (make-rect (make-point 1 1) 2 6)) (area-rect r) (perimeter-rect r) ;; Alternative Implementation II ;; ----------------------------- ;; ;; The above implementations are limited to rectangles that have sides ;; parallel to the major axes of the plane. This implementation generalizes ;; to allow all rectangles. Conveniently enough, you can still use the above ;; area and perimeter definitions. Abstraction barrier for the win! ;; ;; DO NOTE -- As above all sanity/error checking has been ignored. IRL, you ;; you would want to ensure that parallel sides are actually parallel, etc. ;; Helpful to have this (define (square x) (* x x)) ;; Point library (define (make-point x y) (cons x y)) (define (x-point p) (car p)) (define (y-point p) (cdr p)) (define (point-dist p1 p2) (sqrt (+ (square (- (x-point p1) (x-point p2))) (square (- (y-point p1) (y-point p2)))))) ;; Segment library (define (make-segment p1 p2) (cons p1 p2)) (define (start-seg p) (car p)) (define (end-seg p) (cdr p)) (define (seg-len seg) (point-dist (start-seg seg) (end-seg seg))) ;; Rectangle library (define (make-rect side parallel-side) (cons side parallel-side)) (define (side1 rect) (car rect)) (define (side2 rect) (cdr rect)) (define (side-legths rect) (cons (seg-len (side1 rect)) (min (abs (point-dist (start-seg (side1 rect)) (start-seg (side2 rect)))) (abs (point-dist (start-seg (side1 rect)) (end-seg (side2 rect))))))) ;; Same as above (define (width-rect rect) (car (side-legths rect))) (define (height-rect rect) (cdr (side-legths rect))) ;; Usage (define r (make-rect (make-segment (make-point 0 1) (make-point 0 0)) (make-segment (make-point 1 0) (make-point 1 1)))) ;; As an alternative to this alternative, You can define you rectangles ;; as a pair of perpendicular segments: (define (make-rect side perpendicular-side) (cons side perpendicular-side)) (define (side-legths rect) (cons (seg-len (side1 rect)) (seg-len (side2 rect)))) ;; And everything should still work. ;; Thus we now have 4 representations for rectangles, all of which can use the ;; same area and perimeter functions.
This implementation does not allow arbitrary rectangles in the plane. It is restricted to ones with sides parallel to the major axes. I am working on one that allows cockeyed rectangles. Was this feature intentionally left out?
Basically, you can give two parallel sides, or two intersecting (in the case of a rectangle perpendicular) sides. You then need "accessors" to compute heights and widths. Thus giving us two more ways to implement rectangles with the same area and perimeter calculations.
;; Here's another one: This allows arbitrary rotated rectangles, and the representation is the easiest in my opinion. The rectangle is represented by the "base" - i.e. the segment with 2 bottom points, and the left side. To keep it simple, the input is the base, and the "height" from the base. Here height is in the direction perpendicular to the base, and not along Y-axis. ;; This doesn't require error-checking as these parameters can't go wrong (base and height) and a rectangle is uniquely defined by them. (define (perimeter-r r) (let ((width (width-r r)) (height (height-r r))) (* 2 (+ height width)))) (define (area-r r) (let ((width (width-r r)) (height (height-r r))) (* width height))) (define (width-r r) (length-seg (base-seg r))) (define (height-r r) (length-seg (left-side r))) (define (length-seg seg) (let ((p1 (start-segment seg)) (p2 (end-segment seg))) (let ((x1 (x-point p1)) (y1 (y-point p1)) (x2 (x-point p2)) (y2 (y-point p2))) (sqrt (+ (square (- x1 x2)) (square (- y1 y2))))))) (define (square x) (* x x)) (define (base-seg r) (car r)) (define (left-side r) (cdr r)) (define (make-rectangle base-seg height) (let ((p1 (start-segment base-seg)) (p2 (end-segment base-seg))) (let ((x1 (x-point p1)) (y1 (y-point p1)) (x2 (x-point p2)) (y2 (y-point p2))) (let ((theta (atan (/ (- y2 y1) (- x2 x1))))) (let ((new-x (- x1 (* height (sin theta)))) (new-y (+ y1 (* height (cos theta))))) (cons base-seg (make-segment p1 (make-point new-x new-y))))))))
Here's two more implementations, which assume axis-aligned rectangles, but allow users to enter any two points (i.e. they don't require bottom-left/top-right points as input), and satisfy identical signatures:
;; Representation 1: (cons (bottom-left point) (top-right point)) (define (make-rect p1 p2) (let ((x1 (x-point p1)) (x2 (x-point p2)) (y1 (y-point p1)) (y2 (y-point p2))) (cond ((and (< x1 x2) (< y1 y2)) (cons p1 p2)) ((and (> x1 x2) (> y1 y2)) (cons p2 p1)) ((and (< x1 x2) (> y1 y2)) (cons (make-point x1 y2) (make-point x2 y1))) (else (cons (make-point x2 y1) (make-point x1 y2)))))) (define (bottom-left r) (car r)) (define (top-right r) (cdr r)) ;; Representation 2: (cons (bottom-left point) (cons width height)) (define (make-rect p1 p2) (let ((x1 (x-point p1)) (x2 (x-point p2)) (y1 (y-point p1)) (y2 (y-point p2))) (let ((width (abs (- x1 x2))) (height (abs (- y1 y2)))) (cond ((and (< x1 x2) (< y1 y2)) (cons p1 (cons width height))) ((and (> x1 x2) (> y1 y2)) (cons p2 (cons width height))) ((and (< x1 x2) (> y1 y2)) (cons (make-point x1 y2) (cons width height))) (else (cons (make-point x2 y1) (cons width height))))))) (define (bottom-left r) (car r)) (define (top-right r) (let ((x (x-point (car r))) (y (y-point (car r))) (w (car (cdr r))) (h (cdr (cdr r)))) (make-point (+ x w) (+ y h))))
Either implementation can be used as follows:
(define (print-rect r) (print-point (bottom-left r)) (print-point (top-right r))) (define (perimeter r) (let ((p1 (bottom-left r)) (p2 (top-right r))) (let ((x1 (x-point p1)) (x2 (x-point p2)) (y1 (y-point p1)) (y2 (y-point p2))) (* 2 (+ (- x2 x1) (- y2 y1)))))) (define (area r) (let ((p1 (bottom-left r)) (p2 (top-right r))) (let ((x1 (x-point p1)) (x2 (x-point p2)) (y1 (y-point p1)) (y2 (y-point p2))) (* (- x2 x1) (- y2 y1)))))
I'm not sure if it's a drawback that you can't have public/private methods for the rectangle object or not. Smalltalk doesn't have such things either, but many other languages do. Anyway, the above works fine.