2 (練習問題2.1~2.3)
2 データを用いた抽象化の構築
2.1 データ抽象化入門
セレクタ (selector) とコンストラクタ (constructor).
コンストラクタは普段と同じだけど, アクセッサのことはセレクタっていうらしい.
2.1.1 例: 有理数の数値演算
cons
! car
!! cdr
!!!
cons-cell っていう名前かとおもってけれどペア (pair) っていうらしい.
; [sec-2.1.1-a.scm]
(define (sec-2.1.1-a)
(display "(print-rat one-half) ; 1/2")
(print-rat one-half)
(newline)
(display "(print-rat one-third) ; 1/3")
(print-rat one-third)
(newline)
(display "(print-rat (add-rat one-half one-third)) ; 5/6")
(print-rat (add-rat one-half one-third))
(newline)
(display "(print-rat (mul-rat one-half one-third)) ; 1/6")
(print-rat (mul-rat one-half one-third))
(newline)
(display "(print-rat (add-rat one-third one-third)); 6/9")
(print-rat (add-rat one-third one-third))
(newline)
#t)
; arithmetic operations
;
(define (add-rat x y)
(make-rat
(+
(* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (sub-rat x y)
(make-rat
(-
(* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (mul-rat x y)
(make-rat
(* (numer x) (numer y))
(* (denom x) (denom y))))
(define (div-rat x y)
(make-rat
(* (numer x) (denom y))
(* (denom x) (numer y))))
(define (equal-rat? x y)
(=
(* (numer x) (denom y)
(* (numer y) (denom x)))))
; representing rational numbers.
(define (make-rat n d) (cons n d))
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (print-rat x)
(newline)
(display (numer x))
(display "/")
(display (denom x)))
(define one-half (make-rat 1 2))
(define one-third (make-rat 1 3))
実行結果:
gosh> (sec-2.1.1-a)
(print-rat one-half) ; 1/2
1/2
(print-rat one-third) ; 1/3
1/3
(print-rat (add-rat one-half one-third)) ; 5/6
5/6
(print-rat (mul-rat one-half one-third)) ; 1/6
1/6
(print-rat (add-rat one-third one-third)); 6/9
6/9
#t
既約分数化に対応:
; [sec-2.1.1-b.scm]
(define (sec-2.1.1-b)
(display "(print-rat one-half) ; 1/2")
(print-rat one-half)
(newline)
(display "(print-rat one-third) ; 1/3")
(print-rat one-third)
(newline)
(display "(print-rat (add-rat one-half one-third)) ; 5/6")
(print-rat (add-rat one-half one-third))
(newline)
(display "(print-rat (mul-rat one-half one-third)) ; 1/6")
(print-rat (mul-rat one-half one-third))
(newline)
(display "(print-rat (add-rat one-third one-third)); 2/3")
(print-rat (add-rat one-third one-third))
(newline)
#t)
(load "./sec-2.1.1-a")
(define (make-rat n d)
(let ((g (gcd n d)))
(cons (/ n g) (/ d g))))
実行結果:
gosh> (sec-2.1.1-b)
(print-rat one-half) ; 1/2
1/2
(print-rat one-third) ; 1/3
1/3
(print-rat (add-rat one-half one-third)) ; 5/6
5/6
(print-rat (mul-rat one-half one-third)) ; 1/6
1/6
(print-rat (add-rat one-third one-third)); 2/3
2/3
#t
ex-2.1. 有理数の符号対応
; [ex-2.1.scm]
(define (ex-2.1)
(display "(print-rat (make-rat 1 3)) ; 1/3")
(print-rat (make-rat 1 3))
(newline)
(display "(print-rat (make-rat -1 3)) ; -1/3")
(print-rat (make-rat -1 3))
(newline)
(display "(print-rat (make-rat 1 -3)) ; -1/3")
(print-rat (make-rat 1 -3))
(newline)
(display "(print-rat (make-rat -1 -3)) ; 1/3")
(print-rat (make-rat -1 -3))
(newline)
#t)
(load "./sec-2.1.1-a")
(define (make-rat n d)
(define (make-rat-1 n d)
(let ((g (gcd n d)))
(cons (/ n g) (/ d g))))
(cond
((and (negative? n) (negative? d))
(make-rat-1 (- n) (- d)))
((and (negative? n) (not (negative? d)))
(make-rat-1 n d))
((and (not (negative? n)) (negative? d))
(make-rat-1 (- n) (- d)))
((and (not (negative? n)) (not (negative? d)))
(make-rat-1 n d))))
実行結果:
gosh> (ex-2.1)
(print-rat (make-rat 1 3)) ; 1/3
1/3
(print-rat (make-rat -1 3)) ; -1/3
-1/3
(print-rat (make-rat 1 -3)) ; -1/3
-1/3
(print-rat (make-rat -1 -3)) ; 1/3
1/3
#t
2.1.2 抽象化の壁
wall じゃなくて barrier なのね・ω・
ex-2.2. 点と線分の表現
; [ex-2.2.scm]
(define (ex-2.2)
(let
(
(start (make-point 10 20))
(end (make-point 30 40))
)
(display "; start:")
(print-point start)
(newline)
(display "; end:")
(print-point end)
(newline)
(display "; midpoint:")
(print-point (midpoint-segment (make-segment start end)))
(newline)
)
#t)
(define (make-point x y)
(cons x y))
(define (x-point p)
(car p))
(define (y-point p)
(cdr p))
(define (print-point p)
(newline)
(display "(")
(display (x-point p))
(display ",")
(display (y-point p))
(display ")"))
(define (make-segment start end)
(cons start end))
(define (start-segment segment)
(car segment))
(define (end-segment segment)
(cdr segment))
(define (average a b)
(/ (+ a b) 2))
; segment -> segment -> point
(define (midpoint-segment segment)
(make-point
(average
(x-point (start-segment segment))
(x-point (end-segment segment)))
(average
(y-point (start-segment segment))
(y-point (end-segment segment)))))
実行結果:
gosh> (ex-2.2)
; start:
(10,20)
; end:
(30,40)
; midpoint:
(20,30)
#t
ex-2.3. 長方形の表現
(左上座標, 右下座標) による表現 ((x1,y1)-(x2,y2)
):
'
って識別子の一部かと思ってたけどそうでもなかったぽい.
変なコンパイルエラーになって悩んじゃった・ω・`
; [ex-2.3-a.scm]
(define (ex-2.3-a)
(define top-left (make-point 10 100))
(define bottom-right (make-point 30 300))
(define rect (make-rect top-left bottom-right))
(display "; rect:")
(print-rect rect)
(newline)
(display "; width:")
(print-value (width-rect rect))
(newline)
(display "; height:")
(print-value (height-rect rect))
(newline)
(display "; perimeter:")
(print-value (perimeter-rect rect))
(newline)
(display "; area:")
(print-value (area-rect rect))
(newline)
#t)
; {{{ point.
(define (print-value value)
(newline)
(display value))
(define (make-point x y)
(cons x y))
(define (x-point p)
(car p))
(define (y-point p)
(cdr p))
; }}} point.
; {{{ rect
; make-rect :: point -> point -> rect
; print-rect :: rect -> #t
; width :: rect -> non-neg-integer
; height :: rect -> non-neg-integer
;
(define (make-rect top-left-point bottom-right-point)
(cons top-left-point bottom-right-point))
(define (top-left-rect_ rect)
(car rect))
(define (bottom-right-rect_ rect)
(cdr rect))
(define (print-rect rect)
(newline)
(display "(")
(display (x-point (top-left-rect_ rect)))
(display ",")
(display (y-point (top-left-rect_ rect)))
(display ")-(")
(display (x-point (bottom-right-rect_ rect)))
(display ",")
(display (y-point (bottom-right-rect_ rect)))
(display ")"))
(define (width-rect rect)
(abs
(-
(x-point (top-left-rect_ rect))
(x-point (bottom-right-rect_ rect)))))
(define (height-rect rect)
(abs
(-
(y-point (top-left-rect_ rect))
(y-point (bottom-right-rect_ rect)))))
; }}} rect
(define (perimeter-rect rect)
(* 2 (+ (width-rect rect) (height-rect rect))))
(define (area-rect rect)
(* (width-rect rect) (height-rect rect)))
実行結果:
gosh> (ex-2.3-a)
; rect:
(10,100)-(30,300)
; width:
20
; height:
200
; perimeter:
440
; area:
4000
#t
(左上座標, 矩形の大きさ) による表現 (x0,y0)+(width,height)
:
(この実装だと左上座標と右下座標が入れ替わってしていされてるとだめかも>ω<;)
; [ex-2.3-b.scm]
(define (ex-2.3-b)
(define top-left (make-point 10 100))
(define bottom-right (make-point 30 300))
(define rect (make-rect top-left bottom-right))
(display "; rect:")
(print-rect rect)
(newline)
(display "; width:")
(print-value (width-rect rect))
(newline)
(display "; height:")
(print-value (height-rect rect))
(newline)
(display "; perimeter:")
(print-value (perimeter-rect rect))
(newline)
(display "; area:")
(print-value (area-rect rect))
(newline)
#t)
(load "./ex-2.3-a")
; {{{ size.
(define (make-size top-left-point bottom-right-point)
(define width_
(abs (-
(x-point top-left-point)
(x-point bottom-right-point))))
(define height_
(abs (-
(y-point top-left-point)
(y-point bottom-right-point))))
(cons width_ height_))
(define (width-size size)
(car size))
(define (height-size size)
(cdr size))
; }}} size.
; {{{ rect
; make-rect :: point -> point -> rect
; print-rect :: rect -> #t
; width :: rect -> non-neg-integer
; height :: rect -> non-neg-integer
;
(define (make-rect top-left-point bottom-right-point)
(define size (make-size top-left-point bottom-right-point))
(cons top-left-point size))
(define (top-left-rect_ rect)
(car rect))
(define (size-rect_ rect)
(cdr rect))
(define (print-rect rect)
(newline)
(display "(")
(display (x-point (top-left-rect_ rect)))
(display ",")
(display (y-point (top-left-rect_ rect)))
(display ")+(")
(display (width-size (size-rect_ rect)))
(display ",")
(display (height-size (size-rect_ rect)))
(display ")"))
(define (width-rect rect)
(width-size (size-rect_ rect)))
(define (height-rect rect)
(height-size (size-rect_ rect)))
; }}} rect
実行結果:
gosh> (ex-2.3-b)
; rect:
(10,100)+(20,200)
; width:
20
; height:
200
; perimeter:
440
; area:
4000
#t