[转]Guile Common Problems
reeeder for stylish

SICP Ch1

scturtle posted @ 2011年6月05日 00:09 in Other , 1292 阅读

我的部分练习题解答,望指正

1.3

(define (max2in3 a b c)
  (if (and (>= b a) (>= c a))
      (+ b c)
      (if (and (>= a b) (>= c b))
          (+ a c)
          (+ a b))))

1.6

if不是应用序的会根据pre决定求then-cla还是else-cla, new-if会先求出pre, then-cla, else-cla 再进入cond.测试:

(define (new-if pre then-cla else-cla)
  (display 'here_)
  (cond (pre then-cla)(else else-cla)))
(new-if #t (display 'then_)(display 'else_))

结果:
then_else_here_

验证了之前猜想的顺序.

1.16

(define (fast-expt b n)
  (define (expt-iter a b n)
    (if (= n 0)
        a
        (if (even? n)
            (expt-iter a (* b b) (/ n 2))
            (expt-iter (* a b) b (- n 1)))))
  (expt-iter 1 b n))
(fast-expt 2 2)

1.17

(define (fast* a b)
  (if (= b 1)
    a
    (if (= b 0)
      0
      (if (even? b)
    (fast* (double a) (halve b))
    (+ a (fast* a (- b 1)))))))

1.18

(define (fast* a b)
  (define (iter a t b)
    (if (= b 1)
      (+ a t)
      (if (= b 0)
    0
    (if (even? b)
      (iter (double a) t (halve b))
      (iter a (+ t a) (- b 1) )))))
  (iter a 0 b))

1.19

p`=p^2+q^2
q`=2*p*q+ q*q

(+ (* p p) (* q q))
(+ (* 2 p q) (* q q))


1.22
(use-modules (ice-9 debug))

(define (divides? a b)
  (= (remainder b a) 0))

(define (smallest-divisor n)
  (find-divisor n 2))

(define (find-divisor n test-divisor)
  (cond ((> (* test-divisor test-divisor) n) n)
	((divides? test-divisor n) test-divisor)
	(else (find-divisor n (+ test-divisor 1)))))

(define (prime? n)
  (= n (smallest-divisor n)))

(use-modules (srfi srfi-19)) ;time
(use-modules (ice-9 debug))

(load "prim.scm")

(define (runtime) (time-nanosecond (current-time)))

(define (timed-prime-test n)
  (newline)
  (display n)
  (start-prime-test n (runtime)))

(define (start-prime-test n start-time)
  (if (prime? n)
    (report-prime (- (runtime) start-time))))

(define (report-prime elapsed-time)
  (display " *** ")
  (display elapsed-time))

(define (search-for-primes n count)
  (if (not (= count 0))
    (if (prime? n)
      (begin
	(timed-prime-test n)
	(search-for-primes (+ n 1) (- count 1)))
      (search-for-primes (+ n 1) count))))

;(trace search-for-primes)
(search-for-primes 1000 3)
(newline)
(search-for-primes 10000 3)
(newline)
(search-for-primes 100000 3)
(newline)

1.21
(use-modules (srfi srfi-19)) ;time
(use-modules (ice-9 debug))

(load "prim.scm")

(define (next n)
  (if (= n 2) 
    3
    (+ n 2)))

(define (find-divisor n test-divisor)
  (cond ((> (* test-divisor test-divisor) n) n)
	((divides? test-divisor n) test-divisor)
	(else (find-divisor n (next test-divisor)))))

(define (runtime) (time-nanosecond (current-time)))

(define (timed-prime-test n)
  (newline)
  (display n)
  (start-prime-test n (runtime)))

(define (start-prime-test n start-time)
  (if (prime? n)
    (report-prime (- (runtime) start-time))))

(define (report-prime elapsed-time)
  (display " *** ")
  (display elapsed-time))

(define (search-for-primes n count)
  (if (not (= count 0))
    (if (prime? n)
      (begin
	(timed-prime-test n)
	(search-for-primes (+ n 1) (- count 1)))
      (search-for-primes (+ n 1) count))))

;(trace search-for-primes)
(search-for-primes 1000 3)
(newline)
(search-for-primes 10000 3)
(newline)
(search-for-primes 100000 3)
(newline)


1.24
(use-modules (ice-9 debug))

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

(define (expmod base exp m)
  (cond ((= exp 0) 1)
	((even? exp)
	 (remainder (square (expmod base (/ exp 2) m))
		    m))
	(else
	  (remainder (* base (expmod base (- exp 1) m))
		     m))))

;(display (expmod 11 10 2))

(define (fermat-test n)
  (define (try-it a)
    (= (expmod a n n) a))
  (try-it (+ 1 (random (- n 1)))))

(define (fast-prime? n times)
  (cond ((= times 0) #t)
	((fermat-test n) (fast-prime? n (- times 1)))
	(else #f)))

;(display (fast-prime? 17 10))
;(display (fast-prime? 18 10))

(use-modules (srfi srfi-19)) ;time
(use-modules (ice-9 debug))

(load "fastprim.scm")
(define times 10)

(define (runtime) (time-nanosecond (current-time)))

(define (timed-prime-test n)
  (newline)
  (display n)
  (start-prime-test n (runtime)))

(define (start-prime-test n start-time)
  (if (fast-prime? n times)
    (report-prime (- (runtime) start-time))))

(define (report-prime elapsed-time)
  (display " *** ")
  (display elapsed-time))

(define (search-for-primes n count)
  (if (not (= count 0))
    (if (fast-prime? n times)
      (begin
	(timed-prime-test n)
	(search-for-primes (+ n 1) (- count 1)))
      (search-for-primes (+ n 1) count))))

;(trace search-for-primes)
(search-for-primes 1000 3)
(newline)
(search-for-primes 10000 3)
(newline)
(search-for-primes 100000 3)
(newline)

1.27
(use-modules (ice-9 debug))

(load "fastprim.scm")

(define (test-carmichael? n)
  (define (iter n a)
    (if (= a 0)
      #t
      (if (= (expmod a n n) a)
	(iter n (- a 1))
	#f)))
  (trace iter)
  (iter n (- n 1)))

(display (test-carmichael? 561))
(newline)
(display (test-carmichael? 1105))
(newline)
(display (test-carmichael? 1729))
(newline)
(display (test-carmichael? 2465))
(newline)
(display (test-carmichael? 2821))
(newline)
(display (test-carmichael? 6601))
(newline)

1.28
(use-modules (ice-9 debug))

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

(define (expmod base exp m)
  (cond ((= exp 0) 1)
	((even? exp)
	 (let* ((a (expmod base (/ exp 2) m))
	        (a^2 (remainder (square a) m)))
	   (if (and (not (= a 1)) 
		    (not (= a (- m 1)))
		    (= a^2 1))
	     0
	     a^2)))
	(else
	  (remainder (* base (expmod base (- exp 1) m))
		     m))))

;(trace expmod)
;(display (expmod 11 10 2))

(define (mr-test? n)
  (define (try-it a)
    (= (expmod a (- n 1) n) 1))
  (try-it (+ 1 (random (- n 1)))))

(define (fast-prime? n times)
  (cond ((= times 0) #t)
	((mr-test? n) (fast-prime? n (- times 1)))
	(else #f)))

(display (fast-prime? 17 1)) (newline)
(display (fast-prime? 561 1)) (newline)


1.29
(use-modules (ice-9 debug))

(define (f x) (* x x x))

(define (simpson f a b n)
  (let ((h (/ (- b a) n)))
    (define (y k) (f (+ a (* k h))))
    (define (iter k)
      (if (= k 0)
	(y 0)
	(+ (* 4 (y (- k 1)))
	   (* 2 (y k))
	   (iter (- k 2)))))
    (/ (* h(- (iter n) (y n))) 3)))

(display (exact->inexact (simpson f 0 1 100)))  (newline)
;(display (exact->inexact (simpson f 0 1 1000))) (newline)

1.30
(use-modules (ice-9 debug))

(define (f x) (* x x x))

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

(define (simpson f a b n)
  (let ((h (/ (- b a) n)))
    (define (y k) (f (+ a (* k h))))
    (define (term k) 
	(+ (* 4 (y (- k 1)))
	   (* 2 (y k))))

    (/ (* h (+ (y 0) (sum term 1 (lambda (k) (+ k 2)) (- n 2)) (y n))) 3)))

(trace sum)
(display (exact->inexact (simpson f 0 1 100)))  (newline)
(display (exact->inexact (simpson f 0 1 1000))) (newline)

1.31.1
(use-modules (ice-9 debug))

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

(define (f n)
  (let ((a (quotient n 2))
	(b (quotient (+ n 1) 2)))
    (/ (+ 2 (* b 2)) (+ 3 (* a 2)))))
	
(define (factorial n)
  (product f 0 (lambda (x) (+ x 1)) n))

;(trace product)
(display (exact->inexact (* 4 (factorial 100))))
(newline)

1.31.2
(use-modules (ice-9 debug))

(define (product f a next b)
  (define (iter a result)
    (if (> a b)
      result
      (iter (next a) (* (f a) result))))
  ;(trace iter)
  (iter a 1))

(define (f n)
  (let ((a (quotient n 2))
	(b (quotient (+ n 1) 2)))
    (/ (+ 2 (* b 2)) (+ 3 (* a 2)))))
	
(define (factorial n)
  (product f 0 (lambda (x) (+ x 1)) n))

(display (exact->inexact (* 4 (factorial 100))))
(newline)

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

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

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

(define (f x) x)
(define (next x) (+ x 1))

(display (sum f 1 next 10))
(newline)
(display (product f 1 next 5))
(newline)

1.33
(load "prim.scm")

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

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

(define (f x) x)
(define (next x) (+ x 1))

(define (primsum a b)
  (accumulate + 0 f prime? a next b))

(define (euler n)
  (define (test? i)
    (= (gcd i n) 1))
  (accumulate * 1 f test? 2 next n))

(display (primsum 1 10))
(newline)
(display (euler 10))
(newline)

1.34
(define (f g)
  (g 2))

(display (f f))
(newline)
; (2 2)

1.35
(define tolerance 0.00001)

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    ;(format #t "guess:~a~%" guess)
    (let((next (f guess)))
      (if (close-enough? guess next)
	next
	(try next))))
  (try first-guess))

(define (average a b)
  (/ (+ a b) 2.0))

;(display (fixed-point (lambda (x) (average x (+ 1 (/ x)))) 1.0))
;(newline)

1.36
(use-modules (ice-9 format))

(define tolerance 0.00001)

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (format #t "guess:~a~%" guess)
    (let((next (f guess)))
      (if (close-enough? guess next)
	next
	(try next))))
  (try first-guess))

(define (average a b)
  (/ (+ a b) 2.0))

(display (fixed-point (lambda (x) (average x (+ 1 (/ x)))) 1.0))
(newline)

(display (fixed-point (lambda (x) (average x (/ (log 1000) (log x)))) 2.0))
(newline)

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

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

(define (cont-frac2 n d k)
  (define (iter i ans)
  (if (= i 0)
    ans
    (iter (- i 1) (/ (n i) (+ (d i) ans)))))
  (iter k 0))

(display (cont-frac2
	   (lambda (i) 1.0)
	   (lambda (i) 1.0)
	   12))

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

(define (cont-frac2 n d k)
  (define (iter i ans)
  (if (= i 0)
    ans
    (iter (- i 1) (/ (n i) (+ (d i) ans)))))
  (iter k 0))

(define (d i)
  (if (= 0 (remainder (+ i 1) 3))
    (* 2 (quotient (+ i 1) 3))
    1))

(display (+ 2 (cont-frac2
	   (lambda (i) 1.0)
	   d
	   12)))

1.39
(use-modules (ice-9 format))

(define (tan-cf x k)
  (define (n i)
    (if (= i 1) x (* x x)))
  (define (d i)
    (- (* i 2) 1.0))
  (define (iter i ans)
    (format #t "i:~a n:~a d:~a ans:~a ~%" i (n i) (d i) ans)
    (if (= i 0)
      ans
      (iter (- i 1) (/ (n i) (- (d i) ans)))))
  (iter k 0))

(display (tan-cf (/ 3.14 4) 10))

1.40
(define tolerance 0.00001)

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    ;(format #t "guess:~a~%" guess)
    (let((next (f guess)))
      (if (close-enough? guess next)
	next
	(try next))))
  (try first-guess))

(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 (cubic a b c)
  (lambda (x)
    (+ c (* x (+ b (* x (+ a x)))))))

(display
  (newtons-method (cubic -1 -1 -2) 1))

1.41

(define (double f)
  (lambda (x)
    (f (f x))))

(define (inc x) (+ x 1))

(display
  (((double (double double)) inc) 5))
  ;5 + 16 = 21 !!!!!!!!
(newline)
; = 
(display
  ((double (double (double (double inc)))) 5))
(newline)

1.42

(define (inc x) (+ x 1))

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

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

(display
  ((compose square inc) 6))

1.43

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

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

(define (repeated f n)
  (if (= n 1)
    f
    (compose f (repeated f (- n 1)))))

;(display
;  ((repeated square 2) 5))

1.44

(load "1.43.scm")
(define dx 0.001)

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

(display (sin 3))
(newline)

(display 
  ((smooth sin) 3))
(newline)

(display 
  ((repeated (smooth sin) 3) 3))
(newline)

1.45

(load "1.35.scm")
(load "1.43.scm")

;y^4=x
(define (average-damp f)
  (lambda (x) (average x (f x))))

(define (root4 x)
  (fixed-point 
    ((repeated average-damp 2) 
     (lambda (y) (/ x (expt y 3)))) 1.0))

(display (root4 16.0))
(newline)

;y^n=x
(define (rootN x n)
  (let ((k (floor (/ (log n) (log 2)))))
    (format #t "x:~a n:~a k:~a ~%" x n k)
    (fixed-point 
      ((repeated average-damp k)
       (lambda (y) (/ x (expt y (- n 1))))) 1.0)))

(display (rootN 65535.0 16))
(newline)

1.46

(define (iterative-improve good-enough? improve)
  (lambda (x)
    (define (iter guess)
      (if (good-enough? guess)
	guess
	(iter (improve guess))))
    (iter x)))

(define tolerance 0.00001)

(define (sqrt-improve x first-guess)
  (define (good-enough? guess)
    (> tolerance (abs (- (* guess guess) x))))
  (define (average x y) (/ (+ x y) 2))
  (define (improve guess)
    (average guess (/ x guess)))
  ((iterative-improve good-enough? improve) first-guess))

(display
  (sqrt-improve 16 2.0))
(newline)

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

(display
  (fixed-point-improve cos 1.0))
(newline)

 


登录 *


loading captcha image...
(输入验证码)
or Ctrl+Enter