sicp(9)m2.12〜m2.20

gaucheにnilがない。( '() で代用)

;;m2.12
(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))

(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

;;昨日作った式をプラス
(define (upper-bound i) (cdr i))
(define (lower-bound i) (car i))
(define (make-interval l u) (cons l u))
(define (mul-interval x y)
  (define (condition z do1 do2 do3)
    (cond ((and (< (lower-bound z) 0) (< (upper-bound z) 0)) do1) ;;--
          ((< (lower-bound z) 0) do2) ;-+
          (else do3))) ;++
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (condition x
               (condition y
                          (make-interval p4 p1)
                          (make-interval p2 p1)
                          (make-interval p2 p3))
               (condition y
                          (make-interval p3 p1)
                          (make-interval (min p2 p3) (max p1 p4))
                          (make-interval p2 p4))
               (condition y
                          (make-interval p3 p2)
                          (make-interval p3 p4)
                          (make-interval p1 p4)))))

(define (div-interval x y)
   (mul-interval x
                (make-interval (/ 1.0 (upper-bound y))
                               (/ 1.0 (lower-bound y)))))
(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))
;;ここから、問いへの回答
(define (make-center-persent c percent)
  (let ((pe (/ percent 100.0)))
  (if (> c 0)
      (cons (* c (- 1.0 pe)) (* c (+ 1.0 pe)))
      (cons (* c (+ 1.0 pe)) (* c (- 1.0 pe))))))
;	gosh> (make-center-persent 0.5 50)
;	(0.25 . 0.75)
;	gosh> (make-center-persent 0.5 150)
;	(-0.25 . 1.25)
;	gosh> (make-center-persent -2 50)
;	(-3.0 . -1.0)
(define (percent interval)
  (abs (* 100.0 (/ (- (cdr interval ) (car interval))
          (+ (cdr interval ) (car interval))))))
;;width と　centerを使うべきかも
(define (percent2 interval)
  (* (/ (width interval) (center interval)) 100.0))
(define (make-center-persent2 c per)
  (make-center-width c (* c (/ per 100.0))))
;;m2.13
;;近似の式(+-＝+ or -),(p1,p2＝%相対許容誤差)
;	 (x+-xp1)(y+-yp2)
;	=(xy+-xyp2+-xyp1+xyp1p2)
;	=xy +xy(+-p2+-p1+p1p2)
;;ここでp1、p2がとても小さいとp1p2はさらにとてつもなく小さいので
;	≒xy(1+-p1+-p2)にできる。
;	=xy(1+-(p1+p2))
;;ということで、許容誤差の和を使って近似できる。

(define (part1 r1 r2)
  (div-interval (mul-interval r1 r2)
                (add-interval r1 r2)))
(define (part2 r1 r2)
  (let ((one (make-interval 1 1)))
    (div-interval one
                  (add-interval (div-interval one r1)
                                (div-interval one r2)))))
;;結果が異なることを示す。
(define (check-same r1 r2)
  (let ((p1 (part1 r1 r2))
        (p2 (part2 r1 r2)))
    (if (and (= (car p1) (car p2))
             (= (cdr p1) (cdr p2)))
        "same"
        "different")))
(define mcp make-center-persent2)
;	(check-same (mcp 1.0 0.001) (mcp 2.0 0.001))
;	"different"
;	gosh> (part1 (mcp 1.0 0.001) (mcp 2.0 0.001))
;	(0.6666466669333306 . 0.666686666933336)
;	gosh> (part2 (mcp 1.0 0.001) (mcp 2.0 0.001))
;	(0.66666 . 0.6666733333333335)

;;m2.15
;;元の入力した値との誤差を考えれば、どちらが良いかわかると思う。
(define (check ac aw bc bw)
  (define orig (/ (* ac bc) (+ ac bc)))
  (let ((p1 (part1 (mcp ac aw) (mcp bc bw)))
        (p2 (part2 (mcp ac aw) (mcp bc bw))))
    (define (diff-orig car-or-cdr p)
      (abs (- orig (car-or-cdr p))))
    (define (test car-or-cdr)
      (if (< (diff-orig car-or-cdr p1) (diff-orig car-or-cdr p2))
              "part1"
              "part2"))
     (display (test car))
     (newline)
     (display (test cdr))))
;	gosh> (check 1.0 0.001 2.0 0.001)
;	part2
;	part2#<undef>
;;ということで、part2の方が良いプログラム。
;;（でも、これだとpart2の方が良いプログラムだと
;;一般的に示せたわけじゃないからダメかも）
;;まじめにやるんなら、不確かな値が出現する回数をコードを追って数える。
;;めんどうなので、これでいいことにする。
;;m2.16
;;非常に難しいらしいのでパス。

;;2.2.1
(cons 1 (cons 2 (cons 3 (cons 4 'nil))))
;;(list 1 2 3 4)という書き方もある？
;;nilだとerrorになった。
;;シンボルにして暫定的に対処しておく。

;;(後で調べた結果によると、'()にすればいいみたい。)

(define one-through-four (list 1 2 3 4))
;	gosh> (cons 10 one-through-four)
;	(10 1 2 3 4)
;;(list 1 2 3 4) ≠ (1 2 3 4)
;;cdr=car先頭の項以外からなる部分リスト

;;リスト演算
(define (list-ref items n)
  (if (= n 0)
      (car items)
      (list-ref (cdr items) (- n 1))))
;;これで配列と同じ感じで使えるようになったかも。

(define (length items)
  (if (null? items)
      0
      (+ 1 (length (cdr items)))))
;;この辺の演算はなんだか新鮮。
;;gaucheにもnull?が合った。（なんでnil?じゃないんだろ？)

(define (length2 items)
  (define (length-iter a count)
    (if (null? a)
        count
        (length-iter (cdr a) (+ count 1))))
  (length-iter items 0))
;;これが反復版（中に関数を定義しなければならないあたりが再帰よりめんどう）

(define (append list list2)
  (if (null? list1)
      list2
      (cons (car list1) (append (cdr list1) (list2)))))
;	(append one-through-four '( 1 4 9 16))
;	=>(1 2 3 4 1 4 9 16)

;;m2.17
(define (lastpair lst)
  (let ((next (cdr lst)))
    (if (null? next)
        lst
        (lastpair next))))
;;完成。(listと間違えそうなのでlstにしてます＞＜)

;;m2.18
(define (reverse lst)
  (if (null? (cdr lst))
      (car lst)
      (cons (reverse (cdr lst)) (cons (car lst) '()))))
;;再帰だと上手く行かない。
;	gosh> (reverse one-through-four)
;	(((4 3) 2) 1)

(define (reverse2 lst)
  (define (iter lst tmps)
    (if (null? lst)
        tmps
        (iter (cdr lst) (cons (car lst) tmps))))
  (iter lst '()))
;;反復だと楽
;	gosh> (reverse2 (reverse2 one-through-four))
;	(1 2 3 4)
;	gosh> (reverse2 one-through-four)
;	(4 3 2 1)
;;m2.19
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))

(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
          (+ (cc amount (except-first-denomination coin-values))
             (cc (- amount (first-denomination coin-values)) coin-values)))))
;;ここから加えたもの
(define (first-denomination coin-values)
  (car coin-values))
(define (except-first-denomination coin-values)
  (cdr coin-values))
(define (no-more? coin-values)
  (null? coin-values))
;	gosh> (cc 100 uk-coins)
;	104561
;	gosh> (cc 199 us-coins)
;	2240
;;coin-valuesの順序はccの答えに影響を与えない。
;ruby -e '(1..10).to_a.inject(0){|s,n| s+n}'
;ruby -e '(1..10).to_a.reverse!.inject(0){|s,n| s+n}'
;;上のふたつの計算結果が同じなのと同様。
;;（単に最初に何の数字から行うかの違いだけ）

;;m2.20
;;もうちょっと早く知りたかった。＞ドット末尾記法

(define (same-parity x . y)
  (define (push? n)
    (= (remainder (- n x) 2) 0))
  (define (f lst)
    (let ((this (car lst)))
      (if (null? (cdr lst))
          (if (push? this)
              (cons this '())
              '())
          (if (push? this)
              (cons this (f (cdr lst)))
              (f (cdr lst))))))
  (cons x (f y)))
;	gosh> (same-parity 1 2 3 4 5 6 7 8 9)
;	(1 3 5 7 9)
;	gosh> (same-parity 2 3 4 5 6 7)
;	(2 4 6)
;;できた！でも、あんまりきれいじゃないなー