add-ratの定義にならって、引き算・掛け算・割り算と、同値性を調べる関数 sub-rat mul-rat div-rat equal-rat? を定義せよ。定義は、例えば rat-simple.scm という名前で一つのファイルにしておくと後々便利である。
;; n1/d1 - n2/d2 = (n1d2-n2d1)/d1d2
(define (sub-rat r1 r2)
(let ((n1 (numer r1)) (d1 (denom r1))
(n2 (numer r2)) (d2 (denom r2)))
(make-rat (- (* n1 d2) (* n2 d1))
(* d1 d2))))
;; n1/d1 * n2/d2 = n1n2/d1d2
(define (mul-rat r1 r2)
(let ((n1 (numer r1)) (d1 (denom r1))
(n2 (numer r2)) (d2 (denom r2)))
(make-rat (* n1 n2) (* d1 d2))))
;; n1/d1 / n2/d2 = n1d2/d1n2
(define (div-rat r1 r2)
(let ((n1 (numer r1)) (d1 (denom r1))
(n2 (numer r2)) (d2 (denom r2)))
(make-rat (* n1 d2) (* d1 n2))))
;; n1/d1 equals n2/d2 = n1 equals n2 and d1 equals d2
(define (equal-rat? r1 r2)
(let ((n1 (numer r1)) (d1 (denom r1))
(n2 (numer r2)) (d2 (denom r2)))
(and (= n1 n2) (d1 d2))))
上の定義のままだと、既約分数でないものができてしまう。そこで、 (make-rat n d)を、nとdの最大公約数でそれぞれを割った商どうしで対を作る ようにmake-ratの定義を改良せよ。ただし、 nとdの最大公約数(Greatest Common Divisor)は、関数 (gcd n d) によって求められるものとする。
(define (make-rat n d)
(let ((g (gcd n d)))
(cons (/ n g) (/ d g))))
さらに、(1) 負の分数を表現する場合に、必ず分子を負にして分母を正にする、 (2) ゼロは 0/1 で表現する、のように改良せよ。改良した定義は例えばファ イルrat-normal.scmに保存しておくと便利である。
;; 正規化: 分母は必ず正数 ;; 0/d は 0/1 ;; n/0 は 1/0 のように表現する (define (make-rat n d) (cond ((= n 0) (cons 0 1)) ((= d 0) (cons 1 0)) ((< 0 d) (let ((g (gcd n d))) (cons (/ n g) (/ d g)))) ((< d 0) ; 分母が負数の場合、符号を反転させる (make-rat (- n) (- d)))))
先の課題では、分数を作る度に既約分数化していた。別の方法としては、 make-rat で分数を作る際には、そのままの値を対にしておき、numer, denom で分母・分子をとり出す際に既約分数化する、というものが考えられる。 このアイデアに従って make-rat, numer, denom を定義し直せ。さらに、この 定義を用いても add-rat の定義を変更する必要がないことを確認せよ。
;;; 注: ゼロ数や負数に関する正規化は行っていない
(define (make-rat n d)
(cons n d))
(define (numer r)
(let ((n (car r)) (d (cdr r)))
(/ n (gcd n d))))
(define (denom r)
(let ((n (car r)) (d (cdr r)))
(/ d (gcd n d))))
;;; 確認
> (load "rat-ops.scm") ; add-ratなどの演算
> (load "rat-normal.scm") ; 課題4-3の定義
> (define one-half (make-rat 1 2))
> (print-rat one-half)
1/2
> (define one-third (make-rat 1 3))
> (print-rat (mul-rat one-half one-third))
1/6
> (print-rat (add-rat one-third one-third))
2/3
> (load "rat-lazy.scm") ; この課題の定義
> (define one-half (make-rat 1 2))
> (print-rat one-half)
1/2
> (define one-third (make-rat 1 3))
> (print-rat (mul-rat one-half one-third))
1/6
> (print-rat (add-rat one-third one-third))
2/3
>
上の課題で定義した分母による四則演算の関数を使って、ニュートン法によっ て平方根を求める関数 sqrt を、分数で計算するように定義を変更せよ。 ただし、四則演算のほかに、 o 分数の符号が正であることを調べる関数 (positive-rat? x) o 分数 x, y が x < y であることを調べる関数(less-than-rat? x y) o 分数 x の絶対値を求める (abs-rat x) などを必要に応じて定義せよ。また、いままでに作った分数の内部表現のどれ を使っても、 sqrt の結果が同じになるかどうかを調べてみよ。
;;; supplemental arithmetics
(define (positive-rat? x)
(< 0 (numer x)))
(define (less-than-rat? x y)
(positive-rat? (sub-rat y x)))
(define (abs-rat x)
(make-rat (abs (numer x)) (denom x)))
;;; square root by Newton's method.
(define delta (make-rat 1 100000000000))
(define (square x) (mul-rat x x))
(define (average x y) (mul-rat (add-rat x y) (make-rat 1 2)))
;;; The following algorithm is almost identical to the
;;; one defined for real numbers except for several functions
;;; have different names.
(define (sqrt x)
(define (good-enough? guess)
(less-than-rat? (abs-rat
(sub-rat (square guess) x))
delta))
(define (improve guess)
(average guess (div-rat x guess)))
(define (sqrt-iter guess)
(if (good-enough? guess)
guess
(sqrt-iter (improve guess))))
(sqrt-iter (make-rat 1 1)))
;;; 実行例:
> (load "rat-normal.scm") ; 課題4-3版
> (define (test)
(let ((two (make-rat 2 1)))
(let ((sqrt-two (sqrt two)))
(print-rat sqrt-two)
(print-rat (sub-rat (square sqrt-two) two)))))
> (test)
665857/470832 ; sqrt(2) の結果
1/221682772224 ; 誤差: sqrt(2)**2 - 2
> (load "rat-lazy.scm") ; 課題4-4版
> (test)
665857/470832
1/221682772224
> (load "rat-simple.scm") ; 正規化をしない版
> (test)
665857/470832
1/221682772224
> (define delta (mul-rat delta delta)) ; 精度の桁数を2倍にする
> (test)
886731088897/627013566048
1/393146012008229658338304 ; 誤差が小さくなっている
>
対の内部表現として、さらに違った方法もあり得る。 (define (cons x y) (lambda (f) (f x y))) (define (car z) (z (lambda (a b) a))) 同様にして cdr を定義せよ。 さらに、これが対としての性質を満たしていることを確かめよ。
carの定義の類推から、
(define (cdr z)
(z (lambda (a b) b)))
とする。
この定義が対としての性質を満たしていることを確める。
いま、任意のデータ x, y に対する (cons x y) の結果が z であるとして、
(car z) が x に、(cdr z) が y になることを示せばよい。
(car z) = (car (cons x y))
= (car (lambda (f) (f x y)))
= ((lambda (f) (f x y)) (lambda (a b) a))
= ((lambda (a b) a) x y)
= x
となるので、確かに (car z) は x になっている。同様にして (cdr z) が y
になることも確められる。
リストの最後の要素だけを返すlast-pair: > (last-pair (list 23 72 149 34)) (34) を定義せよ。(但し、引数として空でないリストを受け取るとする。)
;; 「引数として空でないリストを受け取るとする」ので、与えられたリスト
;; のcdr部が空の場合、そのリストそのものを返せばよい。
(define (last-pair sequence)
(if (null? (cdr sequence))
sequence
(last-pair (cdr sequence))))
リストを逆順にする関数reverse: > (reverse (list 1 4 9 16 25)) (25 16 9 4 1) を定義せよ。
;; sを逆順にするには、
;; sの二番目以降を逆順にしたものの末尾に
;; sの先頭要素を追加すればよい
(define (reverse sequence)
(if (null? sequence)
'()
(append (reverse (cdr sequence))
(list (car sequence)))))
数の列を受け取って、それぞれの要素を二乗した列を返す square-listを定義
せよ。例えば、 (square-list (list 1 2 3 4))は (1 4 9 16)となる。
;;; 定義1
(define (square-list items)
(if (null? items)
'()
(cons <?> <?>)))
;;; 定義2
(define (square-list items)
(map <?> <?>))
;;; 定義1
(define (square-list items)
(if (null? items)
'()
(cons (square (car items))
(square-list (cdr items)))))
;;; 定義2
(define (square-list items)
(map square items))
関数 reverse に、各要素が列であるような列を与えても、内側の列の順序は そのままである。要素が列であった場合、それも逆順にするような deep-reverse を定義せよ。 > (define x (list (list 1 2) (list 3 4))) > x ((1 2) (3 4)) > (reverse x) ((3 4) (1 2)) > (deep-reverse x) ((4 3) (2 1))
;; 列をdeep-reverseする場合、
;; 1番上のレベルを reverse した上で、
;; 1番上のレベルの各要素に deep-reverse すればよい
(define (deep-reverse tree)
(if (pair? tree)
(map deep-reverse (reverse tree))
tree))
木構造を引数として受け取り、木の各要素が順番に並んだ列を返す関数 fringe を定義せよ。 > (define x (list (list 1 2) (list 3 4))) > (fringe x) (1 2 3 4) > (fringe (list x x)) (1 2 3 4 1 2 3 4)
;; ある列をfringeするには、
;; 列の先頭要素を fringe したリストと
;; 残りの要素を fringe したリストを結合するので、
;; 以下のようになる
(define (fringe tree)
(cond ((pair? tree)
(append (fringe (car tree)) ; appendで結合する
(fringe (cdr tree))))
((null? tree) '()) ; 空リストの場合は空リスト
(else (list tree)))); 非リスト要素の場合は、1要素のリストにする