naga:1-29 > 1-46

naga

Todo

1.40

Exercise 1.29

(define (integral f a b n)
  (let ((h (/ (- b a) n)))
    (define (next x) (+ x (* h 2)))
    (* (/ h 3) (+ (f a)
                  (f b)
                  (* 4 (sum f (+ a h) next (- b h)))
                  (* 2 (sum f (+ a (* h 2)) next (- b (* h 2))))))))

;;gosh> (define (cube x) (* x x x))
;;cube
;;gosh> (integral cube 0 1 100)
;;1/4
;;gosh> (integral cube 0 1 1000)
;;1/4

Exercise 1.30

(define (sum term a next b)
  (define (iter a result)
    (if (> a b)
        result
        (iter (next a) (+ (term a) result))))
  (iter a 0))

Exercise 1.31

(define (product-r term a next b)
  (if (> a b)
      1.0
      (* (term a) (product-r term (next a) next b))))
(define (product-i term a next b)
  (define (iter a result)
    (if (> a b)
        (* result 1.0)
        (iter (next a) (* (term a) result))))
  (iter a 1))

(define (factorial n)
  (product-r (lambda (x) x) 1 (lambda (x) (+ x 1)) n))
;
; 2/3*4/3が１項目,4/5*6/5が2項目
(define (pi-term x)
  (let ((x (* x 2))
        (y (+ (* x 2) 1)))
    (/ (* x (+ x 2)) (* y y))))
(define (pi-next x)
  (+ x 1))
(define (pi-r n)
  (* 4 (product-r pi-term 1 pi-next n)))
(define (pi-i n)
  (* 4 (product-i pi-term 1 pi-next n)))

;;gosh> (factorial 6)
;;720.0
;;gosh> (time (pi-r 1000))
;;;(time (pi-r 1000))
;;; real   0.010
;;; user   0.010
;;; sys    0.000
;;3.142377365093882
;;gosh> (time (pi-i 1000))
;;;(time (pi-i 1000))
;;; real  26.578
;;; user  26.548
;;; sys    0.010
;;3.142377365093878

;; iterativeは遅い？？？

(define (product-r term a next b)
  (if (> a b)
      1
      (* (term a) (product-r term (next a) next b))))
(define (product-i term a next b)
  (define (iter a result)
    (if (> a b)
        result
        (iter (next a) (* (term a) result))))
  (iter a 1))
; 2/3*4/3が１項目,4/5*6/5が2項目
(define (pi-term x)
  (let ((x (* x 2))
        (y (+ (* x 2) 1)))
    (/ (* x (+ x 2)) (* y y))))
(define (pi-next x)
  (+ x 1))
(define (pi-r n)
  (* 4.0 (product-r pi-term 1.0 pi-next n)))
(define (pi-i n)
  (* 4.0 (product-i pi-term 1.0 pi-next n)))
;;gosh> (time (pi-r 1000))
;;;(time (pi-r 1000))
;;; real   0.010
;;; user   0.010
;;; sys    0.000
;;3.142377365093882
;;gosh> (time (pi-i 1000))
;;;(time (pi-i 1000))
;;; real   0.010
;;; user   0.010
;;; sys    0.000
;;3.1423773650938855
;;pi-r,pi-nを次のように変更すると
(define (pi-r n)
  (* 4.0 (product-r pi-term 1 pi-next n)))
(define (pi-i n)
  (* 4.0 (product-i pi-term 1 pi-next n)))
;;gosh> (time (pi-r 1000))
;;;(time (pi-r 1000))
;;; real  40.478
;;; user  40.469
;;; sys    0.000
;;3.142377365093878
;;gosh> (time (pi-i 1000))
;;;(time (pi-i 1000))
;;; real  25.487
;;; user  25.486
;;; sys    0.000
;;3.142377365093878

Exercise 1.32

; recursive
(define (accumlate-r combiner null-value term a next b)
  (define (op a)
    (if (> a b)
        null-value
        (combiner (term a) (op (next a)))))
  (op a))
 ; iterative
(define (accumlate-i combiner null-value term a next b)
  (define (iter a result)
    (if (> a b)
        result
        (iter (next a) (combiner result (term a)))))
  (iter a null-value))
 ; product & sum
(define (product-r term a next b)
  (accumlate-r * 1 term a next b))
(define (product-i term a next b)
  (accumlate-i * 1 term a next b))
(define (sum-r term a next b)
  (accumlate-r + 0 term a next b))
(define (sum-i term a next b)
  (accumlate-i + 0 term a next b)) 

Exercise 1.33

(define (filterd-accumulate combiner null-value term a next b filter)
  (define (re a)
    (cond ((> a b) null-value)
          ((filter a) (combiner (term a) (re (next a))))
          (else (re (next a)))))
  (re a))
; a
(define (sum-square-prime a b)
  (filterd-accumulate + 0 (lambda (x) (* x x)) a (lambda (x) (+ x 1)) b prime?))
; b
(define (product-relatively-prime n)
  (define (rprime? i)
    (= (gcd i n) 1))
  (filterd-accumulate * 1 (lambda (x) x) 1 (lambda (x) (+ x 1)) n rprime?))

;;gosh> (sum-square-prime 1 10)
;;88
;;gosh> (product-relatively-prime 10)
;;189

Exercise 1.34

(define (f g)
  (g 2))
;
;(f f)->(f 2)->(2 2)...手続きでないエラー
;;gosh> (f f)
;;*** ERROR: invalid application: (2 2)
;;Stack Trace:
;;_______________________________________   

Exercise 1.35

;; 黄金比は x^2 = x+1 を満足するということから
;; x->1+1/x
;;gosh> ([[fixed-point]] (lambda (x) (+ 1 (/ 1 x))) 1.0)
;;1.6180327868852458

Exercise 1.36

(define tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess step)
    (let ((next (f guess)))
      (display step) (display "::") (display guess) (newline)
      (if (close-enough? guess next)
          next
          (try next (+ 1 step)))))
  (try first-guess 1))
;;gosh> (fixed-point (lambda (x) (/ (log 1000) (log x))) 2.0)
;;1::2.0
;;2::9.965784284662087
;;3::3.004472209841214
;;4::6.279195757507157
;;5::3.759850702401539
;;6::5.215843784925895
;;7::4.182207192401397
;;    :
;;31::4.555517548417651
;;32::4.555547679306398
;;33::4.555527808516254
;;34::4.555540912917957
;;4.555532270803653
;;gosh> (fixed-point (lambda (x) (average (/ (log 1000) (log x)) x)) 2.0)
;;1::2.0
;;2::5.9828921423310435
;;3::4.922168721308343
;;4::4.628224318195455
;;5::4.568346513136242
;;6::4.5577305909237005
;;7::4.555909809045131
;;8::4.555599411610624
;;9::4.5555465521473675
;;4.555537551999825

Exercise 1.37

;; a
(define (cont-frac-i n d k)
  (define (iter k f)
    (if (<= k 0)
        f
        (iter (- k 1) (/ (n k) (+ (d k) f)))))
  (iter k 0))
;; b
(define (cont-frac-r n d k)
  (define (rec c)
    (if (>= c k)
        (/ (n c) (d c))
        (/ (n c) (+ (d c) (rec (+ c 1))))))
  (rec 1))

(define contcount-f
  (lambda (i)
    (cont-frac-i (lambda (i) 1.0) (lambda (i) 1.0) i)))
(define (inc-contcount-loop contcount-f i)
  (define (iter c)
    (if (< i c)
        #t
        (begin (display c)
               (display ":")
               (display (contcount-f c))
               (newline)
               (iter (+ c 1)))))
  (iter 1))
;;gosh> (inc-contcount-loop contcount-f 20)
;;1:1.0
;;2:0.5
;;3:0.6666666666666666
        :
;;10:0.6179775280898876
;;11:0.6180555555555556
;;12:0.6180257510729613
;;       :
;;20:0.6180339850173578
;;#t

ｋを11以上に設定すれば4桁の精度が得られる。

Exercise 1.38

(define (e-2-cf i)
  (cont-frac (lambda (x) 1.0)
             (lambda (x) (if (= (remainder (+ x 1) 3) 0)
                             (* (/ (+ x 1) 3) 2)
                             1.0))
             i))
;;gosh> (inc-contcount-loop e-2-cf 20)
;;1:1.0
;;2:0.6666666666666666
;;3:0.75
;;4:0.7142857142857143
     :
;;17:0.7182818284590651
;;18:0.718281828459028
;;19:0.7182818284590459
;;20:0.7182818284590452
;;#t
;;gosh> (log (+ 2 (e-2-cf 20)))
;;1.0

Exercise 1.39

(define (tan-cf x k)
  (/ (cont-frac (lambda (i) (- (* x x)))
                (lambda (i) (- (* 2 i) 1))
                k)
     (- x)))
;;pi/4を求めてtan-cfのxに設定してkを１→10に変化させてみる。
;;gosh> (/ (asin 1) 2)
;;0.7853981633974483
;;gosh> (define tan-cf-pi/4 (lambda (k) (tan-cf (/ (asin 1) 2) k)))
;;tan-cf-pi/4
;;gosh> (inc-contcount-loop tan-cf-pi/4 10)
;;1:0.7853981633974483
;;2:0.9886892399342051
;;3:0.9997876809149684
        :
;;7:0.9999999999998131
;;8:0.9999999999999994
;;9:1.0
;;10:1.0

Exercise 1.40

後日

Exercise 1.41

(define (double f)
  (lambda (x) (f (f x))))
;;gosh> (((double (double double)) inc) 5)
;;21

Exercise 1.42

(define (compose f g)
  (lambda (x) (f (g x))))
;;gosh> ((compose square inc) 6) 
;;49

Exercise 1.43

;; function x -> f(g(x))
(define (compose f g)
  (lambda (x) (f (g x))))
;;
(define (repeated-i f n)
  (define (iter g i)
    (if (>= i n)
        g
        (iter (compose f g) (+ i 1))))
  (iter f 1))
(define (repeated-r f n)
  (if (= n 1)
      f
      (compose f (repeated-r f (- n 1)))))
;;gosh> ((repeated-i square 2) 5)
;;625
;;gosh> ((repeated-r square 2) 5)
;;625

Exercise 1.44

;; smoothing
(define (smooth f)
  (lambda (x) (/ (+ (f (- x dx))
                    (f x)
                    (f (+ x dx)))
                 3)))
(define (n-fold-smooth f n)
  ((repeated-r smooth n) f))

どうやって確認するか？？？