Open Source WEB

##(link2sicp "book-Z-H-14.html#%_thm_2.3" "Exercise 2.3")

解答例

長辺の線分と、短辺の長さを引数とする、構築子および、 長辺の長さ(bottom)を、短辺の長さ(height)を取り出す選択子で構成した長方形データ

(define (make-rectangle seg height)
  (cons seg height))

(define (bottom rect)
  (let ((seg (car rect)))
    (let ((sp (start-point seg))
          (ep (end-point seg)))
      (let ((x1 (x-point sp))
            (y1 (y-point sp))
            (x2 (x-point ep))
            (y2 (y-point ep)))
        (sqrt (+ (square (- x2 x1)) (square (- y2 y1))))))))

(define (height rect) (cdr rect))

周囲長(perimeter)および面積(area)を計算するアプリケーション

;; application
(define (perimeter rect)
  (* 2 (+ (bottom rect) (height rect))))

(define (area rect)
  (* (bottom rect) (height rect)))

もうひとつ別の長方形の実装 重心の位置(position)、長辺の(X軸からの)傾き(theta)、 長辺の長さ、短辺の長さ、を引数としてとる構築子。 および選択子

;; constructor
(define (make-rectangle position theta bottom height)
  (list point thetha bottom height))

;; selectors
(define (bottom rect)
  (caddr rect))

(define (heitht rect)
  (cadddr rect))

こちらの長方形の実装でも、perimeter および area は変更なしで利用できる。


構築子と選択子のペアでひとつのデータを表現しているとするなら、 アプリケーション側に変更を強制することはないので、上のような解答が 成立する。一方、上の二つの実装は、どちらか一方のみしか使えない。 共存させる一つの方法は、内部構造を統一しておいて、選択子は変更なしで 利用でき、構築子のみ 2 種類用意するという方法である。

たとえば、以下のような二つの実装を考えると、これは共存可能である。

長方形はその4つの頂点の反時計まわり列挙したものと規定されているとする。

(define (make-rectangle-vetices p1 p2 p3 p4)
  (let ((mp1 (midpoint-segment (make-segment p1 p3)))
        (mp2 (midpoint-segment (make-segment p2 p4))))
    (if (not (same-point? mp1 mp2))
        (error "Invalid data")
        (list p1 p2 p3 p4))))

(define (same-point? p q)
  (and (= (x-point p) (x-point q))
       (= (y-point p) (y-point q))))

(define (point-1-rectangle rect) (car rect))
(define (point-2-rectangle rect) (cadr rect))
(define (point-3-rectangle rect) (caddr rect))
(define (point-4-rectangle rect) (cadddr rect))

perimeter と area の定義

(define (perimeter rect)
  (* 2 (+ (segment-length (make-segment (point-1-rectangle rec)
                                        (point-2-rectangle rec)))
          (segment-length (make-segment (point-1-rectangle rec)
                                        (point-4-rectangle rec))))))

(define (area rect)
  (* (segment-length (make-segment (point-1-rectangle rec)
                                   (point-2-rectangle rec)))
     (segment-length (make-segment (point-1-rectangle rec)
                                   (point-4-rectangle rec)))))

(define (segment-length seg)
  (let ((sp (start-segment seg))
        (ep (end-segment seg)))
    (sqrt (+ (square (- (x-point ep) (x-point sp)))
             (square (- (y-point ep) (y-point sp)))))))

もうひとつの長方形の構築子 make-rectangle-edges は一つの頂点の両側 にある辺を線分で与えるものとする。

(define (make-rectangle-edges e1 e2)
  (if (not (same-point? (start-segment e1) (start-segment e2)))
      (error "Invalid data")
      (let ((sp1 (start-segment e1))
            (ep1 (end-segment e1))
            (sp2 (start-segment e2))
            (ep2 (end-segment e2)))
        (let ((p3 (make-point (+ (x-point ep1) (- (x-point ep2) (x-point sp1)))
                              (+ (y-point ep1) (- (y-point ep2) (y-point sp1))))))
          (list sp1 ep1 p3 ep2)))))

コード

##(sicp-answer-code "ex-2.3.scm")

このサイトは、 IPA の「平成15年度オープンソフトウエア活用基盤整備事業」 の委託事業として開発されたKahuaで試験的に運用しております。

Copyright (c) 2004-2007 株式会社タイムインターメディア About Us