ひ(ry

問題 2.3

(define (average x y)
  (/ (+ x y) 2))

(define (make-segment start-point end-point)
  (cons start-point end-point))

(define (start-segment seg)
  (car seg))

(define (end-segment seg)
  (cdr seg))

(define (make-point x y)
  (cons x y))

(define (x-point p)
  (car p))

(define (y-point p)
  (cdr p))

(define (midpoint p1 p2)
  (make-point (average (x-point p1) (x-point p2))
              (average (y-point p1) (y-point p2))))

(define (midpoint-segment segment)
  (midpoint (start-segment segment) (end-segment segment)))

(define (print-point-core p)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))

(define (print-point p)
  (print-point-core p)
  (newline)
  'done.)

(define (print-segment seg)
  (print-point-core (start-segment seg))
  (display "-")
  (print-point-core (end-segment seg))
  (newline)
  'done.)

(define (print-rectangle rec)
  (print-point-core (top-left-point rec))
  (display "-")
  (print-point-core (bottom-right-point rec))
  (newline)
  'done.)

;;

(define (make-rectangle-1 top-left-p bottom-right-p)
  (cons top-left-p bottom-right-p))

(define (make-rectangle-2 top-left-p width height)
  (let ((bottom-right-p (make-point (+ (x-point top-left-p) width)
                                    (+ (y-point top-left-p) height))))
    (cons top-left-p bottom-right-p)))

(define (top-left-point rec)
  (car rec))

(define (top-right-point rec)
  (make-point (x-point (bottom-right-point rec))
              (y-point (top-left-point rec))))

(define (bottom-left-point rec)
  (make-point (x-point (top-left-point rec))
              (y-point (bottom-right-point rec))))

(define (bottom-right-point rec)
  (cdr rec))

(define (perimeter rec)
  (let ((w (abs (- (x-point (top-left-point rec)) (x-point (bottom-right-point rec)))))
        (h (abs (- (y-point (top-left-point rec)) (y-point (bottom-right-point rec))))))
    (* 2 (+ w h))))

(define (area rec)
  (let ((w (abs (- (x-point (top-left-point rec)) (x-point (bottom-right-point rec)))))
        (h (abs (- (y-point (top-left-point rec)) (y-point (bottom-right-point rec))))))
    (* w h)))

make-rectangle 手続きによる長方形の指定方法として、左上と右下の二点を指定する方法と、左上の一点と幅と高さで指定する方法が考えられます。この二つが一般的でしょう。

gosh> (define rec1 (make-rectangle-1 (make-point 5 10) (make-point 10 5)))
rec1
gosh> (define rec2 (make-rectangle-2 (make-point 5 10) 10 20))
rec2
gosh> (print-rectangle rec1)
(5,10)-(10,5)
done.
gosh> (print-rectangle rec2)
(5,10)-(15,30)
done.
gosh> (perimeter rec1)
20
gosh> (perimeter rec2)
60
gosh> (area rec1)
25
gosh> (area rec2)
200

どちらの指定方法であっても perimeter 手続きと area 手続きは同じものが使えます。
システムは良好な抽象の壁で設計されています。