SICP 読み (13)

UT なナニは視野に入れつつどうやるか、は考慮中。一応 2 章を読み進めながら問題の検討もしているのでログを。

問題 2.1

問題にある通り、_有理数が正なら、分子、分母とも正、有理数が負なら、分子だけ負とする_という事で、こんな感じで OK??

(define (make-rat n d)
  (if (< d 0) 
      (cons (- n) (- d))
      (cons n d)))

試験を。

gosh> (make-rat -2 -3)
(2 . 3)
gosh> (make-rat 2 -3)
(-2 . 3)
gosh> (make-rat -2 3)
(-2 . 3)
gosh> (make-rat 2 3)
(2 . 3)
gosh> 

問題 2.2

これは順に検討していくのが面白そう。
まず、線分の表現を定義する constructors である make-segment を。(点を表現する構成子は make-point で選択子は x-point と y-point という前提で)

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

cons で連結させるので選択子の start-segment と end-segment は以下。

(define (start-segment s)
  (car s))

(define (end-segment s)
  (cdr s))

次はもう少し下層なレイヤの構成子と選択子の定義を。

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

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

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

なんか微妙かも。例えば (0, 0) から (2, 2) までの直線は

gosh> (make-segment (make-point 0 0) (make-point 2 2))
((0 . 0) 2 . 2)
gosh> 

とゆー感じで良いのかなぁ。
で、midpoint-segment がおもいっきり直球なんですがこんなので良いのか。

(define (midpoint-segment seg)
 (make-point (/ (+ (x-point (start-segment seg))
                   (x-point (end-segment seg)))
                2)
             (/ (+ (y-point (start-segment seg))
                   (y-point (end-segment seg)))
                2)))

こうした方が良いか。

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

(define (midpoint-segment seg)
  (make-point (average (x-point (start-segment seg)) 
		       (x-point (end-segment seg)))
	      (average (y-point (start-segment seg))
		       (y-point (end-segment seg)))))

こうなりました。

gosh> (define test (make-segment (make-point 0 0) (make-point 2 2)))
test
gosh> test
((0 . 0) 2 . 2)
gosh> (midpoint-segment test)
(1 . 1)
gosh> 

点の印字は微妙なので省略してます。

問題 2.3

長方形の表現ですか。縦横二本の線分、あるいは対角な二点でも大丈夫か。ナナメった長方形の辺の長さをナニするのが面倒臭いな。(を

一番単純な線分での実装は 2.2 を流用して

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

(define (height rect)
  (let ((h (car rect)))
    (abs (- (cdr (car h)) (cdr (cdr h))))))

(define (width rect)
  (let ((w (cdr rect)))
    (abs (- (car (car w)) (car (cdr w))))))

(define (perimeter rect)
  (+ (* 2 (height rect)) (* 2 (width rect))))

(define (area rect)
  (* (height rect) (width rect)))

みたいになるんだけど、これではナナメ対応してないな。でも height と width という選択子を修正すれば大丈夫っぽい。ってか、make-rectangle においてタテヨコの線分を固定で指定ってのもナニ。
線分の選択子も必要かも。とりあえず、機械の前を離れるので続きは別途。

追記

復帰してエントリを見るに、なんか微妙だなと思ったら

(define (make-rectangle h w)
  (cons h w))

(define (height-seg r)
  (car r))
(define (width-seg r)
  (cdr r))

(define (height rect)
  (let ((h (height-seg rect)))
    (abs (- (y-point (start-segment h)) 
	    (y-point (end-segment h))))))

(define (width rect)
  (let ((w (width-seg rect)))
    (abs (- (x-point (start-segment w)) 
	    (x-point (end-segment w))))))

(define (perimeter rect)
  (+ (* 2 (height rect)) (* 2 (width rect))))

(define (area rect)
  (* (height rect) (width rect)))

こうですな。意味は一緒なんですが。(と言いつつ手続き追加してるし
これからナナメを意識して修正を検討してみます。

蛇足ながら以下が試験ッス。

gosh> (define test (make-rectangle (make-segment (make-point 0 0) (make-point 0 3)) (make-segment (make-point 0 0) (make-point 2 0))))
test
gosh> test
(((0 . 0) 0 . 3) (0 . 0) 2 . 0)
gosh> (perimeter test)
10
gosh> (area test)
6
gosh> 

追記 2

三平方の定理 ... (絶句
忘れてます。

と思ったら検算する時に数字が合ってなかっただけで、プログラムは合ってた (本当か??
しかもしょっぱちに「対角な二点」等と言ってますが結構微妙。面倒なので_直線_は表現しない事にして点のみで勝負してみるか。とその前にナナメ込みな解を以下に。(make-segment とか make-point がらみのナニは略してます

(define (make-rectangle h w)
  (cons h w))

(define (height-seg r)
  (car r))
(define (width-seg r)
  (cdr r))

(define (square x)
  (* x x))

(define (height rect)
  (let ((h (height-seg rect)))
    (sqrt (+ (square (- (x-point (start-segment h))
			(x-point (end-segment h))))
	     (square (- (y-point (start-segment h))
			(y-point (end-segment h))))))))

(define (width rect)
  (let ((w (width-seg rect)))
    (sqrt (+ (square (- (x-point (start-segment w))
			(x-point (end-segment w))))
	     (square (- (y-point (start-segment w))
			(y-point (end-segment w))))))))

(define (perimeter rect)
  (+ (* 2 (height rect)) (* 2 (width rect))))

(define (area rect)
  (* (height rect) (width rect)))

試験を以下に。

gosh> (define test (make-rectangle (make-segment (make-point 0 0) (make-point 0 3)) (make-segment (make-point 0 0) (make-point 2 0))))
test
gosh> test
(((0 . 0) 0 . 3) (0 . 0) 2 . 0)
gosh> (perimeter test)
10.0
gosh> (area test)
6.0
gosh> (define test (make-rectangle (make-segment (make-point 1 0) (make-point 0 2)) (make-segment (make-point 1 0) (make-point 5 2))))
test
gosh> test
(((1 . 0) 0 . 2) (1 . 0) 5 . 2)
gosh> (perimeter test)
13.416407864998739
gosh> (* 6 (sqrt 5))
13.416407864998739
gosh> (area test)
10.000000000000002
gosh> (* (sqrt 5) (* 2 (sqrt 5)))
10.000000000000002
gosh> 

うーん ...

続き (問題 2.3)

えーと、perimeter と area の実装はそのまんまで、か。

(define (perimeter rect)
  (+ (* 2 (height rect)) (* 2 (width rect))))

(define (area rect)
  (* (height rect) (width rect)))

インターフェースとしては、height と width ですか。
てーかよく見ると perimeter の実装は

(define (perimeter rect)
  (* 2 (+ (height rect) (width rect))))

の方が良いのかな。ま、いいや。

で、二点だの三点だの言ってましたが面倒なので構成子には始点の座標と幅と高さを渡すコトにしました (こらー

ナナメはまるで無視だよ、これじゃ。

(define (make-r-property h w)
  (cons h w))
(define (rect-height r-p)
  (car r-p))
(define (rect-width r-p)
  (cdr r-p))

;;
;; (make-rectangle (make-point 1 0)
;;                 (make-r-property 5 10))
;;
(define (make-rectangle x y)
  (cons x y)
  )

(define (rectangle-property rect)
  (cdr rect))
(define (rectangle-start-point rect)
  (car rect))

(define (height rect)
  (rect-height (rectangle-property rect))
  )
(define (width rect)
  (rect-width (rectangle-property rect))
  )

(define (perimeter rect)
  (+ (* 2 (height rect)) (* 2 (width rect))))

(define (area rect)
  (* (height rect) (width rect)))

もう少しヒネりを入れた方が良いのかなぁ。ちなみに試験は略。

と言いつつ適当にでっち上げたら、すごい微妙なのができたぞ。(試験は略

;;; 三点で??
(define (square x)
  (* x x))
(define (make-point x y)
  (cons x y))

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

(define (y-point p)
  (cdr p))
;;
;; (make-rectangle (make-point 0 2)
;;                 (make-point 1 0)
;;                 (make-point 5 2))
;;
(define (make-rectangle x y z)
  (list x y z))

;; 二点間の線分の長さ
(define (interval x y)
  (sqrt (+ (square (- (x-point x)
		      (x-point y)))
	   (square (- (y-point x)
		      (y-point y))))))

;; 長い方 (本当は length) しかも二番目
(define (height rect)
  (let ((xy (interval (car rect) (car (cdr rect))))
	(yz (interval (car (cdr rect)) (car (cdr (cdr rect)))))
	(xz (interval (car rect) (car (cdr (cdr rect))))))
    (cond ((and (> xy yz) (> xy xz)) ;; xy が対角線
	   (cond ((> yz xz) yz)
		 (else xz)))
	  ((and (> yz xy) (> yz xz)) ;; yz が対角線
	   (cond ((> xy xz) xy)
		 (else xz)))
	  (else                      ;; xz が対角線
	   (cond ((> xy yz) xy)
		 (else yz))))))

;; 短い方 (width)
(define (width rect)
  (let ((xy (interval (car rect) (car (cdr rect))))
	(yz (interval (car (cdr rect)) (car (cdr (cdr rect)))))
	(xz (interval (car rect) (car (cdr (cdr rect))))))
    (cond ((and (< xy yz) (< xy xz)) xy)
	  ((and (< yz xy) (< yz xz)) yz)
	  (else xz))))

(define (perimeter rect)
  (+ (* 2 (height rect)) (* 2 (width rect))))

(define (area rect)
  (* (height rect) (width rect)))

三点を list で管理しようとしているあたりが敗因かも。
微妙さ満点。

続き

height はあまりに見苦しいんで、卑怯なナニを。

(define (height rect)
  (let ((xy (interval (car rect) (car (cdr rect))))
	(yz (interval (car (cdr rect)) (car (cdr (cdr rect)))))
	(xz (interval (car rect) (car (cdr (cdr rect)))))
	(l (list xy yz xz)))
    (sort! l)
    (car (cdr l))))

これはこれで違う意味で非道だなぁ。

問題 2.4

どんどんヤッツける。とゆーのも問題 2.7 以降が微妙なんで。
とは言え、これも微妙かも。

ええと、中ヌキでこんな感じに展開される。

((lambda (m) (m x y)) (lambda (p q) p))

仮引数の m が展開されると

((lambda (p q) p) x y)

で、x が返却、みたいな感じでしょうか。一応直上のλ式は x と y にリストを割当ててみて試したら動いた。

問題 2.5

a と b の対を 2 の a 乗 * 3 の b 乗に直せば良いのな、という理解の元に以下。

(define (cons a b)
  (* (expt 2 a) (expt 3 b)))

(define (car p)
  (let f ((c 0) (n p))
    (if (= 1 (remainder n 2))
	c
	(f (+ c 1) (/ n 2)))))

(define (cdr p)
  (let f ((c 0) (n p))
    (if (not (= 0 (remainder n 3)))
	c
	(f (+ c 1) (/ n 3)))))

試験ログは略しますが、一応動いている模様。(ut 作らんとのぅ