SICP 演習問題 1.3

Exercise 1.29

;h = (b-a)/n
;y_k=func(a+kh)
;sum = (y_0 + 4y_1 + 2y_2 + 4y_3 + ... + y_n)
;
#lang Racket
(define (simpthon a b func n)
  (* (/ (h a b n) 3)
    (sum-simpthon a b func 0 n)))

(define (sum-simpthon a b func k n)
  (if (> k n)
    0
    (+ (cond ((or (= k 0) (= k n)) (y a b func k n))
       ((odd? k) (* 4 (y a b func k n)))
       ((even? k) (* 2 (y a b func k n))))
     (sum-simpthon a b func (+ k 1) n))))

(define (h a b n) (/ (- b a) n))
(define (y a b func k n) (func (+ a (* k (h a b n)))))
(define (odd? k) (= (remainder k 2) 1))
(define (even? k) (= (remainder k 2) 0))

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

(simpthon 0 1 linear 1)
(simpthon 0 1 linear 10)
(simpthon 0 1 linear 100)
(simpthon 0 1 square 10)

Exercise 1.30

#lang Racket
(define (sum term a next b)
  (if (> a b)
    0
    (+ (term a) (sum term (next a) next b))))

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

(define (square x) (* x x))
(define (step x) (+ x 1))

(sum square 1 step 4)
(sum2 square 1 step 4)

Exercise 1.31

1.31a

#lang Racket
(require racket/flonum)

(define (product term a next b)
  (define (iter a result)
    (if (> a b)
      result
      (iter (next a) (* (term a) result))))
  (iter a 1))

(define (factorial n) (product abs 1 inc n))
(define (inc x) (+ x 1))

(define (pi n) (* 4 (product wallis 2 inc n)))

(define (wallis x)
  (fl/ (->fl (wallis-even x))
       (->fl (wallis-odd  x))))
(define (wallis-even x) (if (odd?  x) (+ x 1) x))
(define (wallis-odd  x) (if (even? x) (+ x 1) x))

(factorial 5)
(pi 1000000)

1.31b

#lang Racket
(define (product term a next b)
  (if (> a b)
      1
      (* (term a)
        (product term (next a) next b))))

Exercise 1.32

1.32a

;sum
(define (sum term a next b)  (accumlate + 0 term a next b))

;product
(define (product term a next b)  (accumulate * 1 term a next b))

1.32b

(define (accumulate combiner null-value term a next b)
  (if (> a b)
      null-value
      (combiner
        (term a)
        (accumulate combiner null-value term (next a) next b))))

Exercise 1.33

#lang Racket
(define
  (filtered-accumulate combiner null-value filter term a next b)
  (define (iter a result)
    (cond ((> a b) result)
      ((filter a) (iter (next a) (combiner (term a) result)))
      (else (iter (next a) result))))
  (iter a null-value))

1.33a

#lang Racket
(define (prime-square-sum a b)
  (filtered-accumulate + 0 prime? square a inc b))
(define (prime? n) (= n (smallest-divisor n)))
(define (smallest-divisor n) (find-divisor n 2))
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (next test-divisor)))))
(define (divides? a b) (= (remainder b a) 0))
(define (square n) (* n n))
(define (next n)  (if (= n 2) 3 (+ n 2)))
(define (inc x) (+ x 1))
(prime-square-sum 1 5)

1.33b

#lang Racket
(define (disjoint-product n)
  (define (disjoint? x) (= (gcd x n) 1))
  (filtered-accumulate * 1 disjoint? abs 1 inc n))
(disjoint-product 6)

Exercise 1.33

#lang Racket
(define
  (filtered-accumulate combiner null-value filter term a next b)
  (define (iter a result)
    (cond ((> a b) result)
      ((filter a) (iter (next a) (combiner (term a) result)))
      (else (iter (next a) result))))
  (iter a null-value))

a

#lang Racket
(define (prime-square-sum a b)
  (filtered-accumulate + 0 prime? square a inc b))
(define (prime? n) (= n (smallest-divisor n)))
(define (smallest-divisor n) (find-divisor n 2))
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (next test-divisor)))))
(define (divides? a b) (= (remainder b a) 0))
(define (square n) (* n n))
(define (next n)  (if (= n 2) 3 (+ n 2)))
(define (inc x) (+ x 1))
(prime-square-sum 1 5)

b

#lang Racket
(define (disjoint-product n)
  (define (disjoint? x) (= (gcd x n) 1))
  (filtered-accumulate * 1 disjoint? abs 1 inc n))
(disjoint-product 6)

Excercise 1.34

(2 2) はひょうかできましぇん

#lang racket
(define (f g) (g 2))
(define (square x) (* x x))
(f square)
(f (lambda (z) (* z (+ z 1))))
(f f)

1.35

#lang Racket
(require racket/flonum)

(define tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(fixed-point (lambda (x) (fl+ 1.0 (fl/ 1.0 x))) 1.0)

1.36

#lang Racket
(require racket/flonum)

(define tolerance 0.00001)
(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (display "***")(display guess)(newline)
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(fixed-point (lambda (x) (fl/ (log 1000) (log x))) 1.1)

(define (average x y) (/ (+ x y) 2))
(fixed-point (lambda (x) (average x (fl/ (log 1000) (log x)))) 1.1)

tolerance 0.00001 38 steps (4.555538934848503) vs 14 steps (4.555536364911781)

tolerance 0.00000000000001 87 steps (4.555535705195124) vs 27 steps (4.555535705195128)

1.37

a

#lang Racket
(require racket/flonum)

(define (cont-frac-try n d k i)
  (if (> i k) 0.0
    (fl/ (n i) (fl+ (d i) (cont-frac-try n d k (+ i 1))))))

(define (cont-frac n d k)
  (cont-frac-try n d k 1))

(cont-frac (lambda (i) 1.0) (lambda(i) 1.0) 11)
(cont-frac (lambda (i) 1.0) (lambda(i) 1.0) 12)
(cont-frac (lambda (i) 1.0) (lambda(i) 1.0) 13)

b

(define (cont-frac n d k)
  (define (cont-frac-try i result)
    (if (<= i 0)
        result
        (cont-frac-try (- i 1) (/ (n i) (+ (d i) result)))))
  (cont-frac-try k 0.0))

1.38

(define (dfc k)
  (+ 2
     (cont-frac
      (lambda (x) 1.0)
      (lambda (x)
        (cond ((= (remainder x 3) 2) (*  (+ (floor(/ x 3)) 1) 2))
              (else 1.0)))
      k)))

(dfc 1000)

1.39

#lang Racket
(require racket/flonum)

(define (tan-cf x k)
  (define (tan-cf-try i)
    (if (> i k)
        0
        (/ (* x x)
           (- (- (* i 2) 1) (tan-cf-try (+ i 1))))))
  (/ x (- 1 (tan-cf-try 2))))

(define pi 3.141592)
(tan-cf (/ pi 4) 1000)
(tan-cf (/ pi 3) 1000)
(tan-cf pi 1000)

1.40

#lang Racket
(define dx 0.00001)
(define tolerance 0.00001)

(define (deriv g)
  (lambda (x) (/ (- (g (+ x dx)) (g x)) dx)))
(define (newton-transform g)
  (lambda (x) (- x (/ (g x) ((deriv g) x)))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (newtons-method g guess)
  (fixed-point (newton-transform g) guess))

(define (cubic a b c) (lambda (x) (+ (* x x x) (* a x x) (* b x) c)))

(newtons-method (cubic -3 3 -1) 1.1)
(newtons-method (cubic -6 12 -8) 1.1)

1.41

#lang racket
(define (double f)
  (lambda (x) (f (f x))))
(define (inc x) (+ x 1))
((double inc) 1)
(((double (double double)) inc) 5)

(((double (double double)) inc) 5)
(((double (lambda (x) (double (double x)))) inc) 5)
(((lambda (x) (double (double (double (double x))))) inc) 5)
((double (double (double (double inc)))) 5)
((double (double (double (lambda (x) (inc (inc x)))))) 5)
((double (double (lambda (x) (inc (inc (inc (inc x))))))) 5)
((double (lambda (x) (inc (inc (inc (inc (inc (inc (inc (inc x)))))))))) 5)
((lambda (x) (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc x))))))))))))))))) 5)
(inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc (inc 5)))))))))))))))))

1.42

#lang racket
(define (compose f g) (lambda (x) (f (g x))))

(define (square x) (* x x))
(define (inc x) (+ x 1))

((compose square inc) 6)

1.43

#lang Racket

1.44

#lang Racket

(define dx 0.0001)
(define (smooth f)
  (lambda (x) (/ (+ (f (- x dx)) (f x) (f (+ x dx))) 3)))
(define (repeated f n)
  (if (<= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define (n-fold-smooth f n) ((repeated smooth n) f))

1.45

#lang Racket

(define tolerance 0.00001)
(define (repeated f n)
  (if (<= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (average-damp f) (lambda (x) (average x (f x))))
(define (average x y) (/ (+ x y) 2))
(define (pow x n)
  (if (<= n 0) 1 (* x (pow x (- n 1)))))

(define (n-root x n k)
  (fixed-point
    ((repeated average-damp k)
       (lambda (y) (/ x (pow  y (- n 1)))))
    1.1 ))

(n-root 2 2 1)
(n-root 2 3 1)
(n-root 2 4 2)
(n-root 2 5 2)
(n-root 2 6 2)
(n-root 2 7 2)
(n-root 2 8 3)
(n-root 2 10 3)
(n-root 2 15 3)
(n-root 2 16 4)
(n-root 2 20 4)
(n-root 2 30 4)
(n-root 2 31 4)
(n-root 2 32 5)
(n-root 2 40 5)
(n-root 2 63 5)
(n-root 2 64 6)

log2(n) の模様 したがって

#lang Racket

(define tolerance 0.00001)
(define (repeated f n)
  (if (<= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (average-damp f) (lambda (x) (average x (f x))))
(define (average x y) (/ (+ x y) 2))
(define (pow x n)
  (if (<= n 0) 1 (* x (pow x (- n 1)))))
(define (log2 x)
  (/ (log x) (log 2)))

(define (n-root x n)
  (fixed-point
    ((repeated average-damp (floor (log2 n)))
       (lambda (y) (/ x (pow  y (- n 1)))))
    1.1 ))

Excercise 1.46

#lang Racket

(define (iterative-improve evaluate improve)
  (lambda (x)
    (let ((next (improve x)))
    (if (evaluate x next)
      next
      ((iterative-improve evaluate improve) next)))))

(define tolerance 0.00001)

(define (close-enough? v1 v2)
  (< (abs (- v1 v2)) tolerance))

(define (sqrt x)
  ((iterative-improve
    close-enough?
    (lambda (y)
      (/ (+(/ x y) y) 2))) 1.0))


(define (fixed-point f first-guess)
  ((iterative-improve
     close-enough?
     f)
   first-guess))