(define (simpson f a b n)
 (define h (/ (- b a) n))
 (define (simpson-term x) (+ (f x)
                             (* 4 (f (+ x h)))
                             (f (+ x h h))))
 (define (simpson-next x) (+ x h h))
 (/ (* h (sum simpson-term a simpson-next (- b h)))
    3.0))

(define (cube x) (* x x x))

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

(simpson cube 0 1.0 100) ==> .2500000000000005
(simpson cube 0 1.0 1000) ==> .2500000000000006

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

(define (inc n) (+ n 1))
(define (cube x) (* x x x))

(sum cube 1 inc 10) ==> 3025

(define (product factor a next b)
 (if (> a b)
     1
     (* (factor a)
        (product factor (next a) next b))))

(define (inc n) (+ n 1))
(define (identity x) x)

(define (factorial n)
 (product identity 1 inc n))

(display (factorial 10)) (newline)

(define (pi-factor n) (/ (* (- n 1) (+ n 1)) (* n n)))

(define (pi-next n) (+ n 2))

(* (product pi-factor 3.0 pi-next 1000) 4) ==> 3.143163842419204

(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))))

(define (sum term a next b)
  (accumulate + 0 term a next b))

(define (product factor a next b)
  (accumulate * 1 factor a next b))

反復的

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

(define (filtered-accumulate pred combiner null-value term a next b)
  (cond ((> a b) null-value)
        ((pred a) 
           (combiner (term a)
                     (filtered-accumulate pred combiner null-value 
                       term (next a) next b)))
        (else (filtered-accumulate pred combiner null-value 
                term (next a) next b))))

(define (prime-square-sum a b)
  (filtered-accumulate prime? + 0 square a inc b))

(define (prime? n)
  (let ((l 
  '(1 2 2 4 2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2 6 4 6 8 4 2 4 2 4 14 4 6 2
  10 2 6 6 4 2 4 6 2 10 2 4 2 12 10 2 4 2 4 6 2 6 4 6 6 6 2 6 4 2 6 4 6
  8 4 2 4 6 8 6 10 2 4 6 2 6 6 4 2 4 6 2 6 4 2 6 10 2 10 2 4 2 4 6 8 4 2
  4 12 2 6 4 2 6 4 6 12 2 4 2 4 8 6 4 6 2 4 6 2 6 10 2 4 6 2 6 4 2 4 2
  10 2 10 2 4 6 6 2 6 6 4 6 6 2 6 4 2 6 4 6 8 4 2 6 4 8 6 4 6 2 4 6 8 6
  4 2 10 2 6 4 2 4 2 10 2 10 2 4 2 4 8 6 4 2 4 6 6 2 6 4 8 4 6 8 4 2 4 2
  4 8 6 4 6 6 6 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10 2 6 4 6 2 6 4 2 4 6 6
  8 4 2 6 10 8 4 2 4 2 4 8 10 6 2 4 8 6 6 4 2 4 6 2 6 4 6 2 10 2 10 2 4
  2 4 6 2 6 4 2 4 6 6 2 6 6 6 4 6 8 4 2 4 2 4 8 6 4 8 4 6 2 6 6 4 2 4 6
  8 4 2 4 2 10 2 10 2 4 2 4 6 2 10 2 4 6 8 6 4 2 6 4 6 8 4 6 2 4 8 6 4 6
  2 4 6 2 6 6 4 6 6 2 6 6 4 2 10 2 10 2 4 2 4 6 2 6 4 2 10 6 2 6 4 2 6 4
  6 8 4 2 4 2 12 6 4 6 2 4 6 2 12 4 2 4 8 6 4 2 4 2 10 2 10 6 2 4 6 2 6
  4 2 4 6 6 2 6 4 2 10 6 8 6 4 2 4 8 6 4 6 2 4 6 2 6 6 6 4 6 2 6 4 2 4 2
  10 12 2 4 2 10 2 6 4 2 4 6 6 2 10 2 6 4 14 4 2 4 2 4 8 6 4 6 2 4 6 2 6
  6 4 2 4 6 2 6 4 2 4 12 2 12)))
    (define (test d)
      (let ((s (car l)))
        (cond ((< (/ n d) d) #t)
              ((= (remainder n d) 0) #f)
              (else (set! l (cdr l)) (test (+ d s))))))
  (set-cdr! (list-tail l 484) (list-tail l 5))
  (test 2)))

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

(define (inc n) (+ n 1))

(define (mutual-prime-product n)
  (filtered-accumulate (lambda (i) (= (gcd i n) 1)) * 1 id 1 inc n))

(define (id x) x)

(define (gcd a b)
        (if (= b 0)
            a
            (gcd b (remainder a b))))

(define (f g)
  (g 2))
だから
(f f)
=(f 2)
=(2 2)
2は演算子ではないから, これは評価出来ない. 

(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) (+ 1.0 (/ 1.0 x))) 1.0)

(define tolerance 0.00001)

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

(fixed-point (lambda (x) (/ (log 1000) (log x))) 2.0)

(fixed-point 
  (lambda (x) 
          (/ (+ x (/ (log 1000) (log x))) 2.0)) 2.0)

(define (cont-frac n d k)
  (define (cf i)
    (if (= i k)
        (/ (n i) (d i))
        (/ (n i) (+ (d i) (cf (+ i 1))))))
  (cf 1))


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


(define (cont-frac-iter n d k)
  (define (cf res i)
    (if (= i 0)
        res
        (cf (/ (n i) (+ (d i) res)) (- i 1))))
  (cf (/ (n k) (d k)) (- k 1)))

(cont-frac-iter (lambda (i) 1.0) (lambda (i) 1.0) 12)

(define (cont-frac n d k)
  (define (cf res i)
    (if (= i 0)
        res
        (cf (/ (n i) (+ (d i) res)) (- i 1))))
  (cf (/ (n k) (d k)) (- k 1)))

(+ 2.0
   (cont-frac (lambda (i) 1.0) 
              (lambda (i) (if (= (remainder i 3) 2)
                              (/ (+ i i 2.0) 3.0)
                              1.0))
              20))

(define (cont-frac n d k)
  (define (cf res i)
    (if (= i 0)
        res
        (cf (/ (n i) (+ (d i) res)) (- i 1))))
  (cf (/ (n k) (d k)) (- k 1)))

(define (tan-cf x k)
  (cont-frac (lambda (i) (if (= i 1) x (- (* x x))))
             (lambda (i) (+ i i -1.0)) k))

(tan-cf (/ 3.14159 4) 10)

(define dx 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 (newtons-method g guess)
  (fixed-point (newton-transform g) guess))

(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))

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

(newtons-method (cubic 3 3 1) 1)

(define (double f)
  (lambda (x) (f (f x))))
(define (inc x) (+ x 1))
(newline)
(display (((double (double double)) inc) 5)) → 21

説明 置換えモデルで評価してみる. doubleをDと書こう. 赤字が評価部分

(((D (D D)) inc) 5)
=(((λ(x) ((D D) ((D D) x))) inc) 5)
=(((D D) ((D D) inc)) 5)
=(((λ(x) (D (D x))) ((λ(x) (D (D x))) inc)) 5)  (* 0)
(* 0)の赤字部分(2箇所)を取り出し, 別に評価する. 

(λ(x) (D (D x)))
=(λ(x) (λ(y) ((D x) ((D x) y))))
=(λ(x) (λ(y) ((λ(z) (x (x z))) ((λ(z) (x (x z))) y))))
=(λ(x) (λ(y) (x (x ((λ(z) (x (x z))) y))) ))
=(λ(x) (λ(y) (x (x (x (x y)) )) ))
これを(* 0)の赤字部分(2箇所)に置き戻す. 

=(( (λ(x) (λ(y) (x (x (x (x y)) )) )) 
   ( (λ(x) (λ(y) (x (x (x (x y)) )) )) inc)) 5)
=(( (λ(x) (λ(y) (x (x (x (x y)) )) ))
   (λ(y) (inc (inc (inc (inc y)) )) )) 5)
=((λ(y) ((λ(y) (inc (inc (inc (inc y)) )) )
          ((λ(y) (inc (inc (inc (inc y)) )) )
           ((λ(y) (inc (inc (inc (inc y)) )) )
            ((λ(y) (inc (inc (inc (inc y)) )) ) y)))))
    5)
=((λ(y) ((λ(y) (inc (inc (inc (inc y)) )) )
          ((λ(y) (inc (inc (inc (inc y)) )) )
           ((λ(y) (inc (inc (inc (inc y)) )) )
            (inc (inc (inc (inc y)))) )))) 5)
=((λ(y) ((λ(y) (inc (inc (inc (inc y)) )) )
          ((λ(y) (inc (inc (inc (inc y)) )) )
           (inc (inc (inc (inc 
            (inc (inc (inc (inc y)))) )))) ))) 5)
=((λ(y) ((λ(y) (inc (inc (inc (inc y)) )) 
          (inc (inc (inc (inc 
           (inc (inc (inc (inc
             (inc (inc (inc (inc y)))))))) )))) )) 5)
=((λ(y) (inc (inc (inc (inc 
          (inc (inc (inc (inc
           (inc (inc (inc (inc
            (inc (inc (inc (inc y)))) )))) )))) )))) ) 5)
=21

(define (compose f g)
  (lambda (x) (f (g x))))

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

(compose square inc) 6))  ==> 49

(define (repeated f n)
  (if (= n 0)
      (lambda (x) x)
      (compose f (repeated f (- n 1)))))

(repeated square 2) 5) ==> 625

(repeated square 1) 5) ==> 25

(repeated square 0) 5) ==> 5

(define (oddp x)
  (= (remainder x 2) 1))

(define (compose f g)
  (lambda (x) (f (g x))))

(define (repeated f n)
  (if (= n 0)
      (lambda (x) x)
      (compose f (repeated f (- n 1)))))

(define dx 0.1)

(define (smooth f)
  (lambda (x) (/ (+ (f x) (f (- x dx)) (f (+ x dx))) 3)))

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

(define (f x)
  (let ((ix (floor x)))
    (if (oddp ix) (+ (- ix x) 1) (- x ix))))

(do ((x 5 (+ x 1))) ((= x 25))
(display (list (/ x 10) (f (/ x 10)))) (newline))

;実行例

(do ((x 5 (+ x 1))) ((= x 25))
(display (list (/ x 10) ((n-fold-smooth f 3) (/ x 10)))) (newline))

;(1/2 .5)
;(3/5 .6)
;(7/10 .6999999999999998)
;(4/5 .7925925925925926)
;(9/10 .8629629629629628)
;(1 .8888888888888888)
;(11/10 .8629629629629628)
;(6/5 .7925925925925924)
;(13/10 .6999999999999998)
;(7/5 .6000000000000001)
;(3/2 .5)
;(8/5 .3999999999999999)
;(17/10 .30000000000000004)
;(9/5 .2074074074074074)
;(19/10 .13703703703703715)
;(2 .11111111111111122)
;(21/10 .13703703703703715)
;(11/5 .20740740740740757)
;(23/10 .2999999999999999)
;(12/5 .3999999999999999)

(define k 1)

(define (compose f g)
  (lambda (x) (f (g x))))

(define (repeated f n)
  (if (= n 0)
      (lambda (x) x)
      (compose f (repeated f (- n 1)))))

(define tolerance 0.00001)

(define (average x y)
  (/ (+ x y) 2))

(define (average-damp f)
  (lambda (x) (average x (f 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 (n-th-root n x)
  (fixed-point ((repeated average-damp k) 
                (lambda (y) (/ x (expt y (- n 1))))) 1.0))

;実験してみると
;n=2,3       はk=1で出来る. 
;n=4,5,..,7  はk=2で出来る. 
;n=8,9,...,15はn=3で出来る. 
;n=16,...    はn=4でないと出来ないらしい. 

;したがって完成版のn-th-rootは

(define (n-th-root n x)
  (let ((k (floor (/ (log n) (log 2)))))
    (fixed-point ((repeated average-damp k) 
                  (lambda (y) (/ x (expt y (- n 1))))) 1.0)))

;やってみよう. 

(do ((n 1 (+ n 1))) ((= n 32))
(display (n-th-root n 2)) (newline))

;2.
;1.4142135623746899
;1.259923236422975
;1.189207115002721
;1.1486967244204176
;1.1224648393618204
;1.1040857488809648
;1.090507732665258
;1.0800601441048037
;1.0717742428174573
;1.065039586617723
;1.059461368044972
;1.0547695373814245
;1.050752520212518
;1.0472983541977885
;1.0442737824274142
;1.0416156614885945
;1.0392595425499167
;1.0371561253194534
;1.0352662146623808
;1.0335586312466867
;1.0320056593867177
;1.0305933664724618
;1.02929997968937
;1.0281108225009543
;1.0270212252548725
;1.0260079614009368
;1.0250678862254134
;1.0241933227655466
;1.0233696479018326
;1.0226067502327343

(define (iterative-improve test improve)
  (lambda (g)
    (define (iter g)
      (if (test g) g
          (iter (improve g))))
  (iter g)))

(define (sqrt x)
 (define (good-enough? g)
  (define (square x) (* x x))
  (< (abs (- (square g) x)) 0.0001))
 (define (improve g)
  (define (average x y) (/ (+ x y) 2))
  (average g (/ x g)))
 ((iterative-improve good-enough? improve) 1.0))

(sqrt 2) ==> 1.4142156862745097

(define (fixed-point f)
 (define (close-enough? g)
   (< (abs (- g (f g))) 0.00001))
 ((iterative-improve close-enough? f) 1.0))

(fixed-point cos) ==> .7390893414033927