sicp solutions

**1.1

Value: a

Value: b

**1.2

(/ (+ 5

(- 2 (- 3 (+ 6 (/ 4 5) ) ) ) )

(* 3

(- 6 2)

(- 2 7) ) )

**1.3

(define (larger x y)

(> x y) x y)

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

(define (sum_of_square x y)

　　　　　　(+ (square x) (square y) ) )

(define (sum_of_square_of_two_larger_number x y z)

　　　　　　(if (= x (larger x y) )

　　　　　　　　　(sum_of_square x (larger y z) )

　　　　　　　　　(sum_of_square y (larger x z) ) ) )

**1.4

The comboination use if clause to decide the operator should be - or +, with which the absolute value of b can be get.

**1.5

The interpreter using natural-order evaluation would fall into the endless loop and the other interpreter would give a result as 0.

**1.6

I think that there will be too many recursions, which may exhaust the computer resource more easiliy.

Well, according to the solution given by schemewiki, the new-if applied to sqrt will run out of the computer resource because of the applicative-order evaluation the LISP using. To be specified, in this case the alternative choice will get executed unconditionaly first.

**1.7

Take the radicand as 0.001, where we would expect the solution to be 0.1, however, the program would yield 0.03230844833048122.

**1.8

The Newton's method to get cube root differentiates from the method for square root only a bit, so i just give the parts that are different.

(define (3average x y z)

　　　　　　(/ 3 (+ x y z) ) )

(define (improve guess x)

　　　　　　(/ (+ (/ x (square guess) )

　　　　　　　　(* guess 2)

)

**1.9

(+ 4 5)

(inc (+ (dec 4) 5) )

(inc (+ 3 5) )

(inc (inc (+ (dec 3) 5) ) )

(inc (inc (+ 2 5) ) )

(inc (inc (inc (+ (dec 2) 5) ) ) )

(inc (inc (inc ( + 1 5) ) ) )

(inc (inc (inc (inc (+ (dec 1) 5) ) ) ) )

(inc (inc (inc (inc (+ 0 5) ) ) ) )

(inc (inc (inc (inc 5) ) ) )

(inc (inc (inc 6) ) )

(inc (inc 7) )

(inc 8)

(+ 4 5)

(+ dec(4) inc(5) )

(+ 3 6)

(+ dec(3) inc(6) )

(+ 2 7)

(+ dec(2) inc(7) )

(+ 1 8)

(+ dec(1) inc(8) )

(+ 0 9)

the first one is recursive, and the second process is iterative.

**1.10

1024

65536

(f n)= 2*n

(g n)= 2^n

(h n)= 2^2^2^2..{n times}

**1.11

(define (f n)
(cond ( (< n 3) n)
( else (+ (f (- n 1) )
(* 2 (f (- n 2) ) )
(* 3 (f (- n 3) ) )
)
)
)
)

**1.12

(define (pascal-triangle-element row column)
(cond ( (= row column) 1)
( (or (= row 1) (= column 1) ) 1)
( (or (< row 1) (< column 1) (< row column) ) 0)
(else (+ (pascal-triangle-element (- row 1) (- column 1))
(pascal-triangle-element (- row 1) column)
)
)
)
)

**1.13

without tools, it is hard to write mathematic procedure on computer, there i just give the main idear to solve this problem.

As the hint given by the exercise, we replace the n with 1 and 2 respectively, and use these two equations to calculate the two arguments. And then write down the Fib(n) equation when n>2, which can prove the supposed equation given by the hint true.

To solve the problem, now we can subtract the Fib number expressed in the form we just proved with the number given by the problem, and prove that their difference will be less than 0.5. DONE :)

**1.14

the order of growth in space is O(n), the time is O(n^2)(PS: not sure)

**1.15

a. 5 times.

b. space: O(n); time: O(log(n) )

**1.16

(define (fast-expt b n)
        (define (even? n) (= (remainder n 2) 0))
        (define (square n) (* n n) )
        (define (fast-expt-itr b n product)
            (cond ( (= n 0) product)
                    ( (even? n) (square (fast-expt-itr b (/ n 2) product) ) )
                      (else (fast-expt-itr b (- n 1) (* product b) ) )
            )
        )
                (fast-expt-itr b n 1)
        )

**1.17

(define (fast* b n)
        (define (even? n) (= (remainder n 2) 0))
        (define (double n) (* n 2) )
        (define (halve n) (/ n 2) )
        (define (itr b n product)
            (cond ( (= n 0) product)
                    ( (even? n) (+ product (double (itr b (halve n) 0) ) ) )
                      (else (itr b (- n 1) (+ product b) ) )
            )
        )
                (itr b n 0)
        )

**1.18

(define (fast* b n)
        (define (even? n) (= (remainder n 2) 0))
        (define (double n) (* n 2) )
        (define (halve n) (/ n 2) )
        (define (itr b n product)
            (cond ( (= n 0) product)
                    ( (even? n) (+ product (double (itr b (halve n) 0) ) ) )
                      (else (itr b (- n 1) (+ product b) ) )
            )
        )
                (itr b n 0)
        )
**1.19
(+ (square p) (square q) )
(+ (* 2 (* p q) ) (* q q) )
**1.20
18
4
**1.21

(smallest-divisor 199) 
 199 
(smallest-divisor 1999) 
 1999 
(smallest-divisor 19999) 
 7 
**1.22

(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 (+ test-divisor 1) ) )
)
)
(define (divides? a b)
(= 0 (remainder b a)
)
)

(define (prime? n) (= n (smallest-divisor n) ) )
(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 n (- (runtime) start-time) )
#f) )
(define (report-prime n elapsed-time)
(newline)
(display n)
(display " *** ")
(display elapsed-time) )

(define (search-for-primes n counter)
(if (<= counter 0) (display "\nDONE")
(if (even? n) (search-for-primes (+ 1 n) counter)
(if (timed-prime-test n) (search-for-primes (+ n 2) (- counter 1) )
(search-for-primes (+ 2 n) counter) ) )
)
)

(search-for-primes 10000000 3)
(search-for-primes 100000000 3)
(search-for-primes 1000000000 3)

**1.23

(define (smallest-divisor n)
    (find-divisor n 2) 
)
(define (next x)
    (if(= x 2) 3 (+ x 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)
    (= 0 (remainder b a)
    )
)

(define (prime? n) (= n (smallest-divisor n) ) )
(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 n (- (runtime) start-time) )
        #f) ) 
(define (report-prime n elapsed-time)
                (newline)
                (display n)
                (display " *** ")
                (display elapsed-time) )

(define (search-for-primes n counter)
    (if (<= counter 0) (display "\nDONE")
     (if (even? n) (search-for-primes (+ 1 n) counter)
      (if (timed-prime-test n) (search-for-primes (+ n 2) (- counter 1) )
       (search-for-primes (+ 2 n) counter) ) ) 
     )
    )
     

(search-for-primes 10000000 3)
(search-for-primes 100000000 3)
(search-for-primes 1000000000 3)

View Code

according to the practice, the time used to run this program is roughly the time of exercise 1.22 divided by 1.5, which is because that though the input and procedure step halves, but one 'if' judgement is imported.

**1.24

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

(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) true)
  (    (fermat-test n) (fast-prime? n (- times 1) ) )
  (else false)
 )
 )
(define (timed-prime-test n)
;    (newline)
;    (display n)
    (start-prime-test n (runtime) ) )
(define (start-prime-test n start-time)
    (if(fast-prime? n 100)
        (report-prime n (- (runtime) start-time) )
        #f) ) 
(define (report-prime n elapsed-time)
                (newline)
                (display n)
                (display " *** ")
                (display elapsed-time) )

(define (search-for-primes n counter)
    (if (<= counter 0) (display "\nDONE")
     (if (even? n) (search-for-primes (+ 1 n) counter)
      (if (timed-prime-test n) (search-for-primes (+ n 2) (- counter 1) )
       (search-for-primes (+ 2 n) counter) ) ) 
     )
    )
     

;(search-for-primes 10000000 3)
(search-for-primes 100000000 3)
(search-for-primes 10000000000000000 3)

View Code

from the observation of the result, we can find one input is the square root of the other one, the computing time of the larger one will be roughly double the time of the smaller one, which supports the theory of logarithmic growth.

**1.25

If the codes change to what the exercise mentioned, the speed will get much slower, and to get the results take considerate longer time.

**1.26

the rewriten expmod generates a tree recursion instead of a linear recursion.

**1.27

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

(define (fermat-test a n)
 (= (expmod a n n) a)
 )
(define (fast-prime? n times)
 (cond 
  ( (= times 0) 
    (display "this number passed fermat-test")
    (newline)
    )
  (    (fermat-test times n) (fast-prime? n (- times 1) ) )
  (else false)
 )
 )
                (fast-prime? 561 560)
                (fast-prime? 1105 1104)
                (fast-prime? 1729 1728)
                (fast-prime? 2465 2464)
                (fast-prime? 2821 2820)
                (fast-prime? 6601 6600)

**1.28

(define (square-root-test a n)
  (and
   (=
    (remainder (square a) n)
    1
   )
   (= 1 a)
   (= a (- n 1) )
  )
 )
(define (expmod base ex m)
 (cond ( (= ex 0) 1)
  ( (even? ex) 
    (if(square-root-test base m)
     0
     (remainder (square (expmod base (/ ex 2) m) ) m) )
  )
  (else (remainder (* base (expmod base (- ex 1) m) ) m) )
 ) )

(define (mr-test a n)
  (= (expmod a (- n 1) n) 1)
 )
(define (prime? n a)
 (cond 
  ( (= a n) 
    (display n)
    (display " passed mr-test")
    (newline)
    )
  (    (mr-test a n) (prime? n (+ a 1) ) )
  (else 
   (display n)
   (display " not prime") 
   (newline) )
 )
 )
                (prime? 561 2)
                (prime? 1105 2)
                (prime? 1729 2)
                (prime? 2465 2)
                (prime? 2821 2)
                (prime? 6601 2)
                (prime? 23 2)

**1.29

(define (sum term a next b)
 (if (> a b)
  0
  (+ (term a)
   (sum term (next a) next b)
  )
 ) 
 )
(define (inc a) (+ 1 a) )
(define (simpson f a b n)
 (define (simpson-term k)
  (* (y k)
   (cond
	( (or (= k 0) (= k n) ) 1.0)
	( (even? k) 2.0)
	(else 4.0)
   )
  )
 )
 (define h (/ (- b a) n) )
 (define (y k) (f (+ a (* k h) ) ) )
 (* (/ h 3) (sum simpson-term 0 inc n) )
 )

(define (cube k) (* k k k) )

				(simpson cube 0 1 100)
				(simpson cube 0 1 1000)

**1.30

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

**1.31

(define (product term a next b)
 (if (> a b)
  1
  (* (term a)
   (product term (next a) next b)
  )
 ) 
 )
(define (inc a) (+ 1 a) )
(define (identity a) a)
(define (factorial n)
 (product identity 1 inc n)
 )
;factorial test
(factorial 12)

(define (pi a)
 (define (add-2 m) (+ m 2) )
 (define (pi-term k) (* (/ (- k 1) k)
						(/ (+ k 1) k)
					 )
 )
 (* 4.0 (product pi-term 3 add-2 a) )
 )
;pi test
(pi 10001)

;product procedure generates iterative process
;(define (product term a next b)
; (define (iter a result)
;  (if (> a b)
;   result
;   (iter (next a) (* result (term a) ))
;  )
; )
; (iter a 1)
; )

**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 (sum sum-term a sum-next b)
 (define sum-combiner +)
 (define sum-null-value 0)
 (accumulate sum-combiner sum-null-value sum-term a sum-next b)
 )

(define (product pro-term a pro-next b)
 (define pro-combiner *)
 (define pro-null-value 1)
 (accumulate pro-combiner pro-null-value pro-term a pro-next b)
 )
;iterative process
(define (accumulate combiner null-value term a next b)
 (define (itr a res)
  (if (> a b) res
			  (itr (next a) (combiner (term a) res) )
  )
 )
 (itr a null-value)
 )

**1.33

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

;prime? procedure
(define (smallest-divisor n)
	(find-divisor n 2) 
)
(define (next x)
	(if(= x 2) 3 (+ x 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)
	(= 0 (remainder b a)
	)
)
(define (prime? n) (= n (smallest-divisor n) ) )
;****************done***************

(define (inc k) (+ 1 k) )
;the sum of the square of the prime numbers in the interval a to b
(define (sum a b)
 (filtered-accumulate + 0 square a inc b prime?)
 )
;sum test
(sum 12 33)

;the product of all the positive intergers less than n that are relatively prime to n(i.e. GCD(i,n)=1)
(define (relatively-prime? i n)
 (= 1 (gcd i n) )
 )
(define (id a) a)
(define (product n)
 (define (filter i) (relatively-prime? i n) )
 (filtered-accumulate * 1 id 1 inc n filter)
 )
;product test
(product 12)

**1.34

The intepreter will report an error.

**1.35

(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)
 )
				;golden ratio
				(fixed-point (lambda (x) (+ 1 (/ 1 x) ) ) 1.0)

**1.36


(define tolerance 0.00001)
(define (fixed-point f first-guess)
 (define (close-enough? v1 v2)
  (< (abs (- v1 v2) ) tolerance)
 )
 (define (try guess)
  (newline)
  (display guess)
  (let ( (next (f guess) ) )
   (if (close-enough? guess next)
	next
	(try next)
   )
  )
 )
 (try first-guess)
 )
;compute the root of x^x=1000
(fixed-point (lambda (x) (/ (log 1000) (log x) ) ) 3)
;use average damping
(define (average x y) (/ (+ x y) 2) )
(fixed-point (lambda (x) (average x (/ (log 1000) (log x) ) ) ) 3)

The procedure using average damping take much less steps to get the qualified result.

**1.37

;recursive solution
(define (cont-frac n d k)
 (define (rec i)
  (if (= i k)
   (/ (n k) (d k) )
   (/ (n i) 
	  (+ (d i)
	     (rec (+ 1 i) ) 
	  ) 
   )
  )
 )
 (rec 1)
 )
;test
(/ 1 (cont-frac (lambda (x) 1.0)
		   (lambda (x) 1.0)
		   1000) )
;iterative solution
(define (cont-frac-itr n d k)
 (define (itr i result)
  (if (= i 0)
   result
   (itr (- i 1) (/ (n i) (+ (d i) result) ) )
  )
 )
 (itr k 0.0)
 )
;iterative solution test
(/ 1 (cont-frac-itr (lambda (x) 1.0)
		   (lambda (x) 1.0)
		   1000) )

**1.38

;recursive solution
(define (cont-frac n d k)
 (define (rec i)
  (if (= i k)
   (/ (n k) (d k) )
   (/ (n i) 
	  (+ (d i)
	     (rec (+ 1 i) ) 
	  ) 
   )
  )
 )
 (rec 1)
 )

(define	(dn i)
 (let ( (tmp (+ i 1) ) )
  (if (= (remainder tmp 3) 0)
   (* 2 (/ tmp 3) )
   1
  )
 )
 )
;e
(+ 2 (cont-frac (lambda (i) 1.0)
			dn
			10000) )

**1.39

;recursive solution
(define (cont-frac n d k)
 (define (rec i)
  (if (= i k)
   (/ (n k) (d k) )
   (/ (n i) 
	  (+ (d i)
	     (rec (+ 1 i) ) 
	  ) 
   )
  )
 )
 (rec 1)
 )
;tangent function
(define (fast-expt b n)
		(define (fast-expt-itr b n product)
			(cond ( (= n 0) product)
					( (even? n) (square (fast-expt-itr b (/ n 2) product) ) )
					  (else (fast-expt-itr b (- n 1) (* product b) ) )
			)
		)
				(fast-expt-itr b n 1)
		)
(define (tan-cf x k)
 (define (tn i)
  (if (= i 1)
   x
   (- 0 (fast-expt x i) )
  )
 )
 (define (td i) (- (* 2 i) 1) )
 (cont-frac tn td k)
 )
;tan test
(tan-cf 0.785 500)

**1.40

(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 (deriv g)
 (lambda (x)
  (/ (- (g (+ x dx) ) (g x) )
   dx)
 )
 )
(define dx 0.00001)
(define (cube a) (* a a a) )
(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)
  (+ (cube x)
   (* a (square x) )
   (* b x)
   c
  )
 )
 )

;test
(newtons-method (cubic 1 2 3) 1)

**1.41

(define (double pro)
 (lambda (x)
  (pro (pro x) )
 )
 )
(define (inc a) (+ 1 a) )
;test
( (double inc) 12)
( ( (double (double double) ) inc) 5)

**1.42

(define (compose f g)
 (lambda (x) (f (g x) ) )
 )
(define (inc a) (+ 1 a) )
;test
((compose square inc) 6)

**1.43

(define (compose f g)
 (lambda (x) (f (g x) ) )
 )
(define (repeated f n)
  (if (< n 1)
   (lambda (x) x)
   (compose f (repeated f (- n 1) ) )
  )
 )
;test
((repeated square 2) 5)

**1.44

(define (compose f g)
 (lambda (x) (f (g x) ) )
 )
(define (repeated f n)
  (if (< n 1)
   (lambda (x) x)
   (compose f (repeated f (- n 1) ) )
  )
 )
(define dx 0.000001)
(define (smooth f)
 (lambda (x)
  (/ 
   (+ 
	(f (+ x dx) )
	(f x)
	(f (- x dx) )
   )
   3)
  )
 )
(define (n-fold-smooth f n)
 ( (repeated smooth n) f)
 )
;test
( (n-fold-smooth square 5) 19)

**1.45

(define (compose f g)
(lambda (x) (f (g x) ) )
)
(define (repeated f n)
(if (< n 1)
(lambda (x) x)
(compose f (repeated f (- n 1) ) )
)
)
(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? next guess)
next
(try next)
)
)
)
(try first-guess)
)
(define (average x y)
(/ (+ x y) 2.0)
)
(define (average-damp f)
(lambda (x) (average x (f x) ) )
)
;test
(define (quan-root x)
(fixed-point
( (repeated average-damp 2) (lambda (y) (/ x (* y y y) ) ) )
1.0
)
)
(quan-root 625) ;through the test
(define (power index exponent)
(define (even? n)
(= (remainder n 2) 0)
)
(if (> exponent 0)
(if (even? exponent)
(square (power index (/ exponent 2) ) )
(* index (power index (- exponent 1) ) )
)
1
)
)
(power 2 10)
;another test
(define (nth-root x n)
(define times (floor (/ (log n) (log 2) ) ) )
(fixed-point
( (repeated average-damp times) (lambda (y) (/ x (power y (- n 1) ) ) ) )
1.0
)
)
(nth-root 1024 10)

(floor log2 n) times average damp required by the process

**1.46

(define (Iterative-improve good-enough? improve guess)
 (if (good-enough? guess)
  guess
  (Iterative-improve good-enough? improve (improve guess) )
 )
 )
(define (average x y)
 (/ (+ x y) 2)
 )
(define tolerance 0.00001)
;sqrt
(define (my-sqrt x)
 (define (sqrt-imp guess)
  (average guess (/ x guess) )
 )
 (define (sqrt-good-enough? guess)
  (< (abs (- (square guess) x) ) tolerance)
 )
 (Iterative-improve sqrt-good-enough? sqrt-imp 1.0)
 )
				(my-sqrt 25)
;fixed-point
(define (fixed-point f)
 (define (fp-imp guess) (f guess) )
 (define (fp-good-enough? guess)
  (< (abs (- guess (f guess) ) ) tolerance)
 )
 (Iterative-improve fp-good-enough? fp-imp 1.0)
 )
				(fixed-point cos)

**2.1

(define (numer x) (car x) )
(define (denom x) (cdr x) )
(define (print-rat x)
 (display (numer x) )
 (display "/")
 (display (denom x) )
 )
(define (make-rat n d)
 (let ( (g ( (if (< d 0) - +) (gcd n d) ) ) )
  (cons (/ n g) (/ d g) )
 )
 )
				;test
(print-rat (make-rat 2 4) )
(print-rat (make-rat -2 4) )
(print-rat (make-rat 2 -4) )
(print-rat (make-rat -2 -4) )

**2.2

(define (print-point p)
 (display "(")
 (display (x-point p) )
 (display ",")
 (display (y-point p) )
 (display ")")
 )
(define (make-point x y)
 (cons x y)
 )
(define (x-point p) (car p) )
(define (y-point p) (cdr p) )
(define (make-segment sp ep)
 (cons sp ep)
 )
(define (start-segment s)
 (car s)
 )
(define (end-segment s)
 (cdr s)
 )
(define (average x y)
 (/ (+ x y) 2)
 )
(define (midpoint-segment s)
 (make-point
		(average
		 (x-point (start-segment s) )
		 (x-point (end-segment s) )
		)
		(average
		 (y-point (start-segment s) )
		 (y-point (end-segment s) )
		)
 )
 )
;test
(print-point (midpoint-segment
			  (make-segment
			   (make-point 12 18)
			   (make-point 20 30)
			  )
			 )
)

**2.3

;point library
(define (make-point x y)
 (cons x y)
 )
(define (x-point p) (car p) )
(define (y-point p) (cdr p) )
;segment library
(define (make-segment sp ep)
 (cons sp ep)
 )
(define (start-segment s)
 (car s)
 )
(define (end-segment s)
 (cdr s)
 )
(define (seg-len s)
 (sqrt (+ (square (-
				   (x-point (start-segment s) )
				   (x-point (end-segment s) )
				  )
		  )
		(square (-
				   (y-point (start-segment s) )
				   (y-point (end-segment s) )
				  )
		)
	   )
 )
 )
;representation of rectangle without checking error or sanity
(define (make-rec side perpendicular-side)
 (cons side perpendicular-side)
 )
(define (width-len rec)
 (seg-len (car rec) )
 )
(define (height-len rec)
 (seg-len (cdr rec) )
 )
;public method
;there exists different representations of rectangle.
;As long as the width-len and height-len methods get defined which give width and hight respectively, the public methods do work
(define (area rect)
 (* (height-len rect) (width-len rect) )
 )
(define (perimeter rect)
 (*
  2
  (+ (height-len rect) (width-len rect) )
 )
 )
;test
(define r (make-rec (make-segment (make-point 1 12) (make-point 3 12) )
		   (make-segment (make-point 1 12) (make-point 1 18) )
		  )
)
(area r)
(perimeter r)

**2.4

(define (cons x y)
 (lambda (m) (m x y) )
 )
(define (car z)
 (z (lambda (p q) p ) )
 )
(define (cdr z)
 (z (lambda (p q) q ) )
 )
;test
(define s (cons 12 0) )
(car s)
				(cdr s)

**2.5

(define (cons a b) (* (expt 2 a) (expt 3 b) ) )
(define (logb b n)
 (ceiling (/ (log n) (log b) )
 )
 )
(define (car n)
 (logb 2 
		  (gcd
		   n
		   (expt 2 (logb 2 n) )
		  )
 )
 )
(define (cdr n)
 (logb 3 
		  (gcd
		   n
		   (expt 3 (logb 3 n) )
		  )
 )
 )
				;test
				(define x (cons 11 17) )
				(car x)
				(cdr x)

**2.6

(add-1 zero) <=> (lambda (f) (lambda (x) (f x) ) )

so,

(define one (lambda (f) (lambda (x) (f x) ) ) )

(add-1 two) <=> (lambda (f) (lambda (x) (f (f x) ) ) )

so,

(define two (lambda (f) (lambda (x) (f (f x) ) ) ) )

(define zero (lambda (f) (lambda (x) x ) ) )
(define (add-1 n) (lambda (f) (lambda (x) (f ((n f) x) ) ) ) )
(define one (lambda (f) (lambda (x) (f x) ) ) ) 
(define two (lambda (f) (lambda (x) (f (f x) ) ) ) )
(define (add a b)
 (lambda (f)
  (lambda (x)
   ( (a f) ( (b f) x) )
  )
 )
 )
;test
((zero square) 3)
				(((add-1 zero) square) 12)
				(((add one two) square) 2)

**2.7

(define (make-interval a b) (cons a b) )
(define (upper-bound x)
 (if (> (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (lower-bound x)
 (if (< (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
				;test
				(define m (make-interval 2 8) )
				(upper-bound m)
				(lower-bound m)

**2.8

(define (make-interval a b) (cons a b) )
(define (upper-bound x)
 (if (> (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (lower-bound x)
 (if (< (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (sub-interval x y)
 (make-interval
  (- (lower-bound x) (upper-bound y) )
  (- (upper-bound x) (lower-bound y) )
 )
 )
;test
(define m (make-interval 2 8) )
(define n (make-interval 22 18) )
				(sub-interval m n)

**2.9

(define (make-interval a b) (cons a b) )
(define (upper-bound x)
 (if (> (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (lower-bound x)
 (if (< (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (sub-interval x y)
 (make-interval
  (- (lower-bound x) (upper-bound y) )
  (- (upper-bound x) (lower-bound y) )
 )
 )
(define (add-interval x y)
 (make-interval
  (+ (lower-bound x) (lower-bound y) )
  (+ (upper-bound x) (upper-bound y) )
 )
 )
(define (mul-interval x y)
 (let 
  (
  (p1 (* (upper-bound x) (lower-bound y) ) )
  (p2 (* (upper-bound x) (upper-bound y) ) )
  (p3 (* (lower-bound x) (upper-bound y) ) )
  (p4 (* (lower-bound x) (lower-bound y) ) )
  )
  (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4) )
 )
 )
(define (div-interval x y)
 (mul-interval
  x
  (make-interval (/ 1.0 (upper-bound y) )
   (/ 1.0 (lower-bound y) )
  )
 )
 )
(define (width x)
 (/ (- (upper-bound x) (lower-bound x) ) 2)
)
				;test
(define m (make-interval 2 8) )
(define n (make-interval 22 18) )
				(width (sub-interval m n) )
				(width (add-interval m n) )
				(+ (width m) (width n) )
				(- (width m) (width n) )
				(width (mul-interval m n) )
				(width (div-interval m n) )
				(* (width m) (width n) )
				(/ (width m) (width n) )

**2.10

(define (make-interval a b) (cons a b) )
(define (upper-bound x)
 (if (> (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (lower-bound x)
 (if (< (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (mul-interval x y)
 (let 
  (
  (p1 (* (upper-bound x) (lower-bound y) ) )
  (p2 (* (upper-bound x) (upper-bound y) ) )
  (p3 (* (lower-bound x) (upper-bound y) ) )
  (p4 (* (lower-bound x) (lower-bound y) ) )
  )
  (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4) )
 )
 )
(define (div-interval x y)
 (if (<= (* (lower-bound y) (upper-bound y) ) 0)
  (error "error, divider interval spans 0")
 (mul-interval
  x
  (make-interval (/ 1.0 (upper-bound y) )
   (/ 1.0 (lower-bound y) )
  )
 )
 )
 )
;test
(define m (make-interval 2 8) )
(define n (make-interval 22 18) )
(define j (make-interval -22 18) )
				(div-interval m j)
				(div-interval m n)

**2.11

(define (make-interval a b) (cons a b) )
(define (upper-bound x)
 (if (> (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (lower-bound x)
 (if (< (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (old-mul-interval x y)
 (let 
  (
  (p1 (* (upper-bound x) (lower-bound y) ) )
  (p2 (* (upper-bound x) (upper-bound y) ) )
  (p3 (* (lower-bound x) (upper-bound y) ) )
  (p4 (* (lower-bound x) (lower-bound y) ) )
  )
  (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4) )
 )
 )
(define (mul-interval x y)
 (define (end-points i)
  (cond ( (and (> (upper-bound i) 0) (> (lower-bound i) 0) )
		  1
		)		;both ends are positive
   ( (and (< (upper-bound i) 0) (< (lower-bound i) 0) )
		  -1
		)		;both ends are negative
   (else 0)		;interval spans 0
  )
 )
 (let ( (x-sign (end-points x) )
		(y-sign (end-points y) )
		(x-ue (upper-bound x) )		;upper end
		(x-le (lower-bound x) )		;lower end
		(y-ue (upper-bound y) )
		(y-le (lower-bound y) )
	  )
  (cond
   ( (> x-sign 0)
	 (cond
	  ( (> y-sign 0) (make-interval (* x-le y-le) (* x-ue y-ue) ) )
	  ( (< y-sign 0) (make-interval (* x-ue y-le) (* x-le y-ue) ) )
	  ( else (make-interval (* x-ue y-le) (* x-ue y-ue) ) )
	 )
   )
   ( (< x-sign 0)
	 (cond
	  ( (> y-sign 0) (make-interval (* x-le y-ue) (* x-ue y-le) ) )
	  ( (< y-sign 0) (make-interval (* x-ue y-ue) (* x-le y-le) ) )
	  ( else (make-interval (* x-le y-ue) (* x-ue y-le) ) )
	 )
   )
   (else
	 (cond
	  ( (> y-sign 0) (make-interval (* x-le y-ue) (* x-ue y-ue) ) )
	  ( (< y-sign 0) (make-interval (* x-ue y-le) (* x-le y-le) ) )
	  ( else (make-interval (min (* x-le y-ue) (* x-ue y-le) )
			  (max (* x-le y-le) (* x-ue y-ue) )
			 )
	  )
	 )
   )
   )
	 )
   )



;test
(define m (make-interval -2 -8) )
(define n (make-interval 22 18) )
(define j (make-interval -22 18) )
				(mul-interval m j)
				(mul-interval m n)
				(mul-interval j n)
				(mul-interval m m)
				(mul-interval j j)
				(mul-interval n n)
				(old-mul-interval m j)
				(old-mul-interval m n)
				(old-mul-interval j n)
				(old-mul-interval m m)
				(old-mul-interval j j)
				(old-mul-interval n n)

**2.12

(define (make-interval a b) (cons a b) )
(define (upper-bound x)
 (if (> (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (lower-bound x)
 (if (< (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (make-center-percent c p)
 (let ( (width (* c p) ) )
  (make-interval (- c width) (+ c width) )
 )
 )
(define (center x)
 (/ (+ (upper-bound x) (lower-bound x) ) 2)
 )
(define (percent x)
 (/
  (/ (- (upper-bound x) (lower-bound x) ) 2)
  (center x)
 )
 )
				;test
				(define s (make-center-percent 10 0.1) )
				(center s)
				(percent s)

**2.13

The sum of component tolerances is the percentage tolerance of the product of two intervals.

**2.14

Suppose that there are two intervals,

(a-t, a+t);　　(b-d,b+d)

using par1 to compulate the parallel resistor, it results to

[ (a-t)*(b-d) / (a+t+b+d), (a+t)*(b+d) / (a-t+b-d) ]

however, using par2, the result is

[ (a-t)*(b-d) / (a-t+b-d), (a+t)*(b+d) / (a+t+b+d) ]

the cause to that difference is the difference between intervals' multiplication and addition.

;interval representation
(define (make-interval a b) (cons a b) )
(define (upper-bound x)
 (if (> (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (lower-bound x)
 (if (< (car x) (cdr x) ) 
  (car x)
  (cdr x) 
  )
 )
(define (make-center-percent c p)
 (let ( (width (* c p) ) )
  (make-interval (- c width) (+ c width) )
 )
 )
(define (center x)
 (/ (+ (upper-bound x) (lower-bound x) ) 2)
 )
(define (percent x)
 (/
  (/ (- (upper-bound x) (lower-bound x) ) 2)
  (center x)
 )
 )
;interval computation
(define (mul-interval x y)
 (let 
  (
  (p1 (* (upper-bound x) (lower-bound y) ) )
  (p2 (* (upper-bound x) (upper-bound y) ) )
  (p3 (* (lower-bound x) (upper-bound y) ) )
  (p4 (* (lower-bound x) (lower-bound y) ) )
  )
  (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4) )
 )
 )
(define (div-interval x y)
 (if (<= (* (lower-bound y) (upper-bound y) ) 0)
  (error "error, divider interval spans 0")
 (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 Lem's parallel resistors
(define (par1 r1 r2)
 (div-interval (mul-interval r1 r2)
  (add-interval r1 r2)
 )
 )
(define (par2 r1 r2)
 (let ((one (make-interval 1 1) ) )
  (div-interval one
   (add-interval (div-interval one r1)
	(div-interval one r2)
   )
  )
 )
 )
				;test
				(define s (make-center-percent 10 0.1) )
				(define d (make-center-percent 10 0.1) )
				(define k (make-center-percent 10 0.01) )
				(div-interval s d)
				(div-interval s s)	;the result should be [1,1], however, it is the same as above
				(par1 s k)
				(par2 s k)	;get two different results

**2.15

Yes, because no matter computation the intervals do, the uncertainty might rise.

**2.16

F***, after i viewed the answer listed on wiki solution, which states the ideal solution is impossible now, i have no motivation to try even once this problem.

**2.17

(define (last-pair li)
 (if (null? (cdr li) )
  (car li)
  (last-pair (cdr li) )
 )
 )
				;test
				(define a (list 1 2 3 111) )
				(last-pair a)

**2.18

(define (reverse li)
 (if (null? (cdr li) )
  li
  (append (reverse (cdr li) ) (cons (car li) () ) )
 )
 )
				;test
				(reverse (list 1 2 3 5) )

**2.19

(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 cv) (car cv) )
(define (except-first-denomination cv) (cdr cv) )
(define (no-more? cv) (null? cv) )

(define us-coins (list 50 25 10 5 1) )
(define uk-coins (list 100 50 20 10 5 2 1 0.5) )
				;test
				(cc 100 us-coins)

**2.20

(define (same-parity . args)
 (define (itr i test)
  (if (null? i)
   ()
   (if (test (car i) )
	(cons (car i) (itr (cdr i) test) )
	(itr (cdr i) test)
   )
  )
 )
 (if (even? (car args) )
  (itr args even?)
  (itr args odd?)
 )
 )
				;test
				(same-parity 2 3 4 5 6 7)
				(same-parity 1 2 3 4 5 6 7)

**2.21

(define (square-list items)
 (map square items)
 )
;test 1
(square-list (list 1 2 3 4 22) )

(define (square-list items)
 (if (null? items)
  '()
  (cons (square (car items) ) (square-list (cdr items) ) )
 )
 )
;test 2
(square-list (list 9 8 7 6 33) )

**2.22

In the first implementation, the newer result is added to the front of the older result, because the parameter answer is the result got before.

In the second implementation, since the iteration starts from the answer as nil, which is viewed as a list, then the result will become things like that

(list ..(list (list (list nil) **) **).. **)

**2.23

(define (for-each proc items)
 (cond 
  ((null? items)
   true
  )
  (else
   (proc (car items) )
   (for-each proc (cdr items) )
  )
 )
 )

				;test
				(for-each (lambda (x) (newline) (display x) )
				 (list 34 35 12 89)
				)

**2.24

The result given by the interpreter

Value: (1 (2 (3 4)))

**2.25

(define a (list 1 3 (list 5 7) 9) )
(define b (list (list 7) ) )
(define c (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7))))))))
				;test
				(car (cdr (car (cdr (cdr a) ) ) ) )
				(car (car b) )
				(car (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr c)))))))))))))

**2.26

(append x y):

(1 2 3 4 5 6)

(cons x y):

((1 2 3) 4 5 6)

(list x y):

((1 2 3) (4 5 6))

**2.27

(define (deep-reverse x)
 (if (pair? x)
  (append (deep-reverse (cdr x) ) (list (deep-reverse (car x) ) ) )
  x
 )
 )
				;test
				(define x (list (list 1 2) (list 3 4) ) )
				(define y (list 12 32 4 (list 3 5 2) 23 44 (list 1 0 9) 98) )
				(deep-reverse x)
				(deep-reverse y)

**2.28

(define (fringe tree)
 (cond
  (
   (pair? tree) (append (fringe (car tree)) (fringe (cdr tree) ) )
  )
  ((null? tree) '() )
  (else (list tree) )
 )
 )
				;test
				(define x (list (list 1 2) (list 3 4) ) )
				(fringe x)
				(fringe (list x x) )

**2.29

(define (make-mobile left right) (list left right) )
(define (make-branch length structure) (list length structure))
;selectors
(define (left-branch bin-mo) (car bin-mo) )
(define (right-branch bin-mo) (car (cdr bin-mo) ) )
(define (branch-length bra) (car bra) )
(define (branch-structure bra) (car (cdr bra) ) )
				;test
 (left-branch (make-mobile 2 3)) 
 (right-branch (make-mobile 2 3)) 
 (branch-length (make-branch 4 5)) 
 (branch-structure (make-branch 4 5)) 
;total weight of a mobile
(define (mobile? bra) (pair? bra) ) 
(define (branch-weight br)
 (let ((mob (branch-structure br) ) )
  (if (mobile? mob)
   (total-weight mob)
   mob
  )
 )
 )
(define (total-weight mo)
 (+
  (branch-weight (left-branch mo) )
  (branch-weight (right-branch mo) )
 )
 )
				;test
				(define x (make-mobile
						   (make-branch 12
							(make-mobile 
							 (make-branch 3 8)
							 (make-branch 4 6)
							)
						   )
						   (make-branch 1 8)
						  )
				)
;				x
;				(right-branch (right-branch x) )
				(total-weight x)

;balanced?
(define (torque br) (* (branch-length br) (branch-weight br) ) )
				;test
				(torque (make-branch 11 (make-mobile (make-branch 9 12) (make-branch 7 8)) ) )
;this method can more clearly express the differences between branch and mobile
(define (branch-balanced? br)
 (balanced? (branch-structure br) )
 )
(define (balanced? mobile)
 (let (
	   (le (left-branch mobile))
	   (ri (right-branch mobile))
	  )
  (if (mobile? (branch-structure le) )
   (branch-balanced? le)
   (if (mobile? (branch-structure ri) )
	(branch-balanced? ri)
   )
  )
	(= (torque le) (torque ri) )
  )
 )
				;test
				(balanced? x)
				(define y (make-mobile (make-branch 3 8)
							(make-branch 8 3)
						   )
				)
				(balanced? y)

				(define level-1-mobile (make-mobile (make-branch 2 1) 
																			 (make-branch 1 2))) 
				 (define level-2-mobile (make-mobile (make-branch 3 level-1-mobile) 
										                                      (make-branch 9 1))) 
				 (define level-3-mobile (make-mobile (make-branch 4 level-2-mobile) 
										                                      (make-branch 8 2)))
				(balanced? level-1-mobile) 
				 (balanced? level-2-mobile) 
				 (balanced? level-3-mobile) 
				  
				 (balanced? (make-mobile (make-branch 10 1000) 
							                          (make-branch 1 level-3-mobile)))

View Code

the code of selectors are the only changes the program need to take to adjust to the new representation of mobiles.

;new implementation
(define (make-mobile left right) (cons left right) )
(define (make-branch length structure) (cons length structure))
;selectors
(define (left-branch bin-mo) (car bin-mo) )
(define (right-branch bin-mo) (cdr bin-mo) )
(define (branch-length bra) (car bra) )
(define (branch-structure bra) (cdr bra) )

**2.30

(define (square-tree tree)
 (cond
		((null? tree) '())
		((not (pair? tree) )
		 (square tree)
		)
		(else
		 (cons (square-tree (car tree) )
		  (square-tree (cdr tree) )
		 )
		)
 )
 )
				;test
				(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))
;using map to define 
(define (square-tree-2 tree)
 (map (lambda (sub-tree)
	   (if (pair? sub-tree)
		(square-tree-2 sub-tree)
		(square sub-tree)
	   )
	  )
  tree
 )
 )
				;test
				(square-tree-2 (list 1 (list 2 (list 3 4) 5) (list 6 7)))

**2.31

(define (tree-map proc tree)
 (map (lambda (subtree)
	   (if (pair? subtree)
		(tree-map proc subtree)
		(proc subtree)
	   )
	  )
  tree
 )
 )
				;test
(define (square-tree tree) (tree-map square tree) )
				(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

**2.32

(define nil '())
(define (subsets s)
 (if (null? s)
  (list nil)
  (let ((rest (subsets (cdr s) ) ) )
   (append rest (map (lambda (x)
					  (append (list (car s)) x)
					 )
				 rest
				)
   )
  )
 )
 )
				;test
				(define set (list 1 2 3))
				(subsets set)

**2.33

(define nil '())
(define (accumulate op initial sequence)
 (if (null? sequence)
  initial
  (op (car sequence) (accumulate op initial (cdr sequence) ) )
 )
 )
(define (map p sequence)
 (accumulate (lambda (x y)
			  (cons (p x) y)
			 )
  nil sequence
 )
 )
;according to the defination of accumulate, this procedure reconstruct
;a NEW LIST, and when it comes to the end of the sequence 1, this list
;does not point to the null, like the sequence 1 does, it directly points
;to the sequence 2, which could conclude from the comparing (cons seq1 seq2)
; and (append seq1 seq2)
;That did help me understand the data structure more clearly.
(define (append seq1 seq2)
 (accumulate cons seq2 seq1)
 )
(define (length sequence)
 (accumulate (lambda (x y)
			  (+ 1 y)
			 )
  0
  sequence
 )
 )
;test
(define a (list 2 3 5 7 9 10 32) )
(define b (list 9 8 7 6 5) )
				(map square a)
				(append a b)
				(length a)

**2.34

(define nil '())
(define (accumulate op initial sequence)
 (if (null? sequence)
  initial
  (op (car sequence) (accumulate op initial (cdr sequence) ) )
 )
 )
(define (horner-eval x coefficient-sequence)
 (accumulate (lambda (this-coeff higher-terms)
			  (+ this-coeff (* x higher-terms) )
			 )
  0
  coefficient-sequence
 )
 )
				;test
				(horner-eval 2 (list 1 3 0 5 0 1))

**2.35

(define nil '())
(define (accumulate op initial sequence)
 (if (null? sequence)
  initial
  (op (car sequence) (accumulate op initial (cdr sequence) ) )
 )
 )
(define (count-leaves t)
 (accumulate (lambda (leaves next)
			  (+ (accumulate + 0 leaves)
			   next
			  )
			 )
  0
  (map
				  (lambda (x)
				   (define (leaves-list x)
					(if (pair? x)
					 (append (leaves-list (car x) ) (leaves-list (cdr x) ) )
					 (if (null? x)
					  nil
					  (list 1)
					 )
					)
				   )
				   (leaves-list x)
				  )
				  t
				 )
 )
 )
				;test
				(define x (cons (list 9 2) (list 3 4) ) )
				(count-leaves x)
				(count-leaves (list x x) )
				(define y (list 3 4 (list 1 8 9) 3 (list 2 7) ) )
				(count-leaves y)
				(count-leaves (list y y) )

;second solution 
(define (count-leaves-recursive t)
 (accumulate + 0 (map (lambda (node) 
					   (if (pair? node) 
						(count-leaves-recursive node) 
						1)) 
				  t)
  )
 ) 
				  
				;test
				(count-leaves-recursive x)
				(count-leaves-recursive (list x x) )
				(count-leaves-recursive y)
				(count-leaves-recursive (list y y) )

**2.36

(define nil '())
(define (accumulate op initial sequence)
 (if (null? sequence)
  initial
  (op (car sequence) (accumulate op initial (cdr sequence) ) )
 )
 )
(define (accumulate-n op init seqs)
 (if (null? (car seqs))
  nil
  (cons (accumulate op init (map car seqs) )
   (accumulate-n op init (map cdr seqs) )
  )
 )
 )
				;test
				(define s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12) ) )
				(accumulate-n + 0 s)

**2.37

(define nil '())
(define (accumulate op initial sequence)
 (if (null? sequence)
  initial
  (op (car sequence) (accumulate op initial (cdr sequence) ) )
 )
 )
(define (accumulate-n op init seqs)
 (if (null? (car seqs))
  nil
  (cons (accumulate op init (map car seqs) )
   (accumulate-n op init (map cdr seqs) )
  )
 )
 )
(define (dot-product v w)
 (accumulate + 0 (map * v w) )
 )
(define (matrix-*-vector m v)
 (map (lambda (x y)
	   (accumulate + 0 (map (lambda (w) (* y w) ) x))
	  )
  m
  v
 )
 )
(define (transpose mat)
 (accumulate-n cons nil mat)
 )
(define (matrix-*-matrix m n)
 (let ((cols (transpose n)))
  (map (lambda (x)
		 (map (lambda (y) (dot-product x y) ) cols)
		)
	   
   m
  )
 )
 )
				;test
				(define v (list 1 2 3) )
				(define w (list 4 5 6) )
				(define m (list (list 9 8 7) (list 5 4 3) (list 0 1 2) ) )
				(define k (list (list 1 1 1) (list 1 1 1) (list 1 1 1) ) )
				(dot-product v w)
				(matrix-*-vector m v)
				(transpose m)
				(matrix-*-matrix m m)
				(matrix-*-matrix m k)

**2.38

(define nil '())
(define (accumulate op initial sequence)
 (if (null? sequence)
  initial
  (op (car sequence) (accumulate op initial (cdr sequence) ) )
 )
 )
(define (fold-right op initial sequence)
 (accumulate op initial sequence)
 )
(define (fold-left op initial sequence)
 (define (iter result rest)
  (if (null? rest)
   result
   (iter (op result (car rest) )
	(cdr rest) )
  )
 )
 (iter initial sequence)
 )
				;test
				(fold-right / 1 (list 1 2 3) )
				(fold-left / 1 (list 1 2 3) )
				(fold-right list nil (list 1 2 3) )
				(fold-left list nil (list 1 2 3) )
				;if the op satisfies the commmutavity, the results yield by two procedure will be the same
				(fold-right + 1 (list 1 2 3) )
				(fold-left + 1 (list 1 2 3) )

**2.39

(define nil '())
(define (accumulate op initial sequence)
 (if (null? sequence)
  initial
  (op (car sequence) (accumulate op initial (cdr sequence) ) )
 )
 )
(define (fold-right op initial sequence)
 (accumulate op initial sequence)
 )
(define (fold-left op initial sequence)
 (define (iter result rest)
  (if (null? rest)
   result
   (iter (op result (car rest) )
	(cdr rest) )
  )
 )
 (iter initial sequence)
 )
(define (reverse-r sequence)
 (fold-right (lambda (x y) (append y (list x) ) ) nil sequence)
 )
				;test
				(define m (list 3 4 5 6 7 9 0 1 2))
				(reverse-r m)
(define (reverse-l sequence)
 (fold-left (lambda (x y) (append (list y) x ) ) nil sequence)
 )
				;test
				(reverse-l m)

**2.40

(define nil '())
;define prime?
(define (smallest-divisor n)
	(find-divisor n 2) 
)
(define (next x)
	(if(= x 2) 3 (+ x 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)
	(= 0 (remainder b a)
	)
)

(define (prime? n) (= n (smallest-divisor n) ) )
;define accumulate
(define (accumulate proc init seq)
 (if (null? seq)
  init
  (proc (car seq) (accumulate proc init (cdr seq) ) )
 )
 )
(define (flatmap proc seq)
 (accumulate append nil (map proc seq) )
 )
(define (enumerate-interval i j)
 (if (<= i j)
  (cons i (enumerate-interval (+ 1 i) j) )
  nil
 )
 )
				;test
				(enumerate-interval 3 12)
(define (unique-pairs n)
 (flatmap (lambda (i)
		   (map (lambda (j) (list i j) )
			(enumerate-interval 1 (- i 1) )
		   )
		  )
  (enumerate-interval 1 n)
 )
 )
				;test
				(unique-pairs 4)
;simplify prime-sum-pairs
(define (make-pair-sum pair)
 (list (car pair) (cadr pair) (+ (car pair) (cadr pair) ) )
 )
(define (prime-sum? pair)
 (prime? (+ (car pair) (cadr pair) ) )
 )
(define (prime-sum-pairs n)
 (map make-pair-sum
  (filter prime-sum? (unique-pairs n) )
 )
 )
				;test
				(prime-sum-pairs 6)

**2.41

(define nil '())
(define (accumulate proc init seq)
 (if (null? seq)
  init
  (proc (car seq) (accumulate proc init (cdr seq) ) )
 )
 )
(define (enumerate-interval i j)
 (if (<= i j)
  (cons i (enumerate-interval (+ 1 i) j) )
  nil
 )
 )
(define (flatmap proc seq)
 (accumulate append nil (map proc seq) )
 )
(define (triples n)
 (flatmap (lambda (x)
		   (flatmap (lambda (y)
					 (map (lambda (z) (list x y z) ) (enumerate-interval (+ 1 y) n) )
					)
			(enumerate-interval (+ 1 x) n)
		   )
		  )
  (enumerate-interval 1 n)
 )
 )
				;test
				(triples 5)
(define (triple-sum t)
 (+ (car t) (cadr t) (cadr (cdr t) ) )
 )
				;test
				(triple-sum (list 2 3 7))
(define (find-triples n s)
 (define (equal? i) (= (triple-sum i) s) )
 (filter equal? (triples n) )
 )
				;test
				(find-triples 10 11)

**2.42

(define nil '() )
(define (accumulate proc init seq)
 (if (null? seq)
  init
  (proc (car seq) (accumulate proc init (cdr seq) ) )
 )
)
(define (flatmap proc seq)
 (accumulate append nil (map proc seq) )
 )
(define (enumerate-interval i j)
 (if (<= i j)
  (cons i (enumerate-interval (+ 1 i) j) )
  nil
 )
 )
(define (queens board-size)
 (define (queen-cols k)
  (if (= k 0)
   (list empty-board)
   (filter
	(lambda (positions) (safe? k positions) )
	(flatmap
	 (lambda (rest-of-queens)
	  (map (lambda (new-row)
		    (adjoin-position new-row k rest-of-queens)
		   )
	   (enumerate-interval 1 board-size)
	  )
	 )
	 (queen-cols (- k 1) )
	)
   )
  )
 )
 (queen-cols board-size)
 )
(define (adjoin-position row column queens)
 (append (list (list row column)) queens)
 )
				;test
				(define x (adjoin-position 3 3 (list (list 1 2) (list 2 1) ) ))
(define empty-board nil)
(define (row queen) (car queen) )
(define (column queen) (cadr queen) )
(define (safe? n positions)
 (let ((new-queen (car positions) )
	   (queens (cdr positions) )
	  )
  (define (judge-itr k qs)
   (cond
	( (= k 0) true)
	( (or (= (abs (- n (column (car qs)))) (abs (- (row new-queen) (row (car qs))))) (= (row new-queen) (row (car qs)))) false)
	(else (judge-itr (- k 1) (cdr qs) ) )
   )
  )
  (judge-itr (- n 1) queens)
 )
 )
				;test
				(safe? 3 x)
				(column (car (cdr x) ) )
				(length (queens 8))

**2.43

I guess, for every element of (enumerate-interval 1 board-size), the program will re-calculate (queen-cols (- k 1) ), that causes the unbelievably slow speed.

The time will be (8^8)T.

**2.44

;since this exercise, every case which i need to draw something, i will use racket or some other dialects that enable i to see the picture.

#lang racket

(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1) ) )

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1) ) ) )
        (beside painter (below smaller smaller) )
        )
      )
  )
(paint (right-split einstein 2))
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1) ) ) )
        (below painter (beside smaller smaller) )
        )
      )
  )

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1) ) )
            (right (right-split painter (- n 1) ) )
            )
        (let ((top-left (beside up up) )
              (corner (corner-split painter (- n 1) ) )
              (bottom-right (below right right) )
              )
          (beside (below painter top-left)
                  (below bottom-right corner)
                  )
          )
        )
      )
  )
(paint (corner-split einstein 4))

**2.45

#lang racket

(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1) ) )

(define (split op1 op2)
 (define (itr painter n)
  (if (= n 0)
   painter
   (let ((smaller (itr painter (- n 1) ) )
		)
	(op1  painter (op2 smaller smaller) )
   )
  )
 )
 (lambda (p n)
  (itr p n)
 )
 )
				;test
				(define right-split (split beside below) )
				(paint (right-split einstein 4) )
				(define up-split (split below beside) )
				(paint (up-split einstein 4) )

**2.46

;constructor and selector
(define (make-vect x y) (cons x y) )
(define (xcor-vect v) (car v) )
(define (ycor-vect v) (cdr v) )
;calculation procedure
(define (add-vect a b)
 (make-vect (+ (xcor-vect a) (xcor-vect b) )
  (+ (ycor-vect a) (ycor-vect b) )
 )
 )
(define (sub-vect a b)
 (make-vect (- (xcor-vect a) (xcor-vect b) )
  (- (ycor-vect a) (ycor-vect b) )
 )
 )
(define (scale-vect n v)
 (make-vect (* (xcor-vect v) n)
  (* (ycor-vect v) n)
 )
 )
				;test
				(define m (make-vect 1 2) )
				(define n (make-vect 4 8) )
				(add-vect m n)
				(sub-vect m n)
				(scale-vect 10 m)

**2.47

;constructor and selector
(define (make-vect x y) (cons x y) )
(define (make-frame origin edge1 edge2)
 (list origin edge1 edge2)
 )
(define (origin-frame f)
 (car f)
 )
(define (edge1-frame f)
 (cadr f)
 )
(define (edge2-frame f)
 (caddr f)
 )
				;test
				(define m (make-vect 1 2) )
				(define n (make-vect 4 8) )
				(define t (make-vect 9 11) )
				(define f (make-frame m n t) )
				(origin-frame f)
				(edge1-frame f)
				(edge2-frame f)

;the second implementation, which i wrote in a different file in case that the compiler confuse that two.
;constructor and selector
(define (make-vect x y) (cons x y) )
(define (make-frame origin edge1 edge2)
 (cons origin (cons edge1 edge2) )
 )
(define (origin-frame f)
 (car f)
 )
(define (edge1-frame f)
 (cadr f)
 )
(define (edge2-frame f)
 (cddr f)
 )
				;test
				(define m (make-vect 1 2) )
				(define n (make-vect 4 8) )
				(define t (make-vect 9 11) )
				(define f (make-frame m n t) )
				(origin-frame f)
				(edge1-frame f)
				(edge2-frame f)

**2.48

;constructor and selector
(define (make-vect x y) (cons x y) )
(define (xcor-vect v) (car v) )
(define (ycor-vect v) (cdr v) )
(define (make-segment s e)
 (cons s e)
 )
(define (start-segment seg)
 (car seg)
 )
(define (end-segment seg)
 (cdr seg)
 )
				;test
				(define m (make-vect 1 2) )
				(define n (make-vect 4 8) )
				(define s (make-segment m n) )
				(start-segment s)
				(end-segment s)

**2.49

;include the lib and statement that draw picture
#lang scheme
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

(define nil '())
(define (xcor-vect v) (car v) )
(define (ycor-vect v) (cdr v) )
(define (add-vect a b)
 (make-vect (+ (xcor-vect a) (xcor-vect b) )
  (+ (ycor-vect a) (ycor-vect b) )
 )
 )
(define (sub-vect a b)
 (make-vect (- (xcor-vect a) (xcor-vect b) )
  (- (ycor-vect a) (ycor-vect b) )
 )
 )
(define (scale-vect n v)
 (make-vect (* (xcor-vect v) n)
  (* (ycor-vect v) n)
 )
 )
;exercise 2.49
(define (connect vect-list)
 (define (itr seg-list remain)
  (if (null? (cdr remain) )
   (reverse seg-list)
   (itr 
	(cons (make-segment (car remain) (cadr remain)) seg-list)
	(cdr remain)
   )
  )
 )
 (itr nil vect-list)
 )
				;i used to define above-right as (1,1) and above-left as (0,1), which shows a "L" as the result picture.
				;so i guess the width of the line is 0.1, which make the line out of the frame when given "1"
(define above-left (make-vect 0 0.99))
(define below-right (make-vect 0.99 0))
(define above-right (make-vect 0.99 0.99))
(define below-left (make-vect 0 0))
;a, outline
(define (draw-outline f)
 ((segments->painter (connect (list below-left above-left above-right below-right below-left)))
  f
 )
 )
				;test
				(paint draw-outline)
;b, X mark
(define (draw-x f)
 ((segments->painter (list (make-segment below-left above-right)
					  (make-segment above-left below-right)
					 )
  )
  f
 )
 )
				;test
				(paint draw-x)
;c, diamond
(define (draw-diamond f)
 (define (mid-point a b)
  (scale-vect
   0.5
   (add-vect a b)
  )
 )
 ((segments->painter (connect (list (mid-point above-left below-left) 
							   (mid-point above-left above-right)
							   (mid-point above-right below-right)
							   (mid-point below-left below-right)
							   (mid-point above-left below-left))
					)
  )
  f
 )
 )
				;test
				(paint draw-diamond)
;d, wave
(define (wave frame)
  ((segments->painter (append (connect (list (make-vect 0.4  0.0)
                                             (make-vect 0.5  0.33)
                                             (make-vect 0.6  0.0))) ;inside legs
                              (connect (list (make-vect 0.25 0.0)
                                             (make-vect 0.33 0.5)
                                             (make-vect 0.3  0.6)
                                             (make-vect 0.1  0.4)
                                             (make-vect 0.0  0.6))) ;lower left
                              (connect (list (make-vect 0.0  0.8)
                                             (make-vect 0.1  0.6)
                                             (make-vect 0.33 0.65)
                                             (make-vect 0.4  0.65)
                                             (make-vect 0.35 0.8)
                                             (make-vect 0.4  1.0))) ;upper left
                              (connect (list (make-vect 0.75 0.0)
                                             (make-vect 0.6  0.45)
                                             (make-vect 1.0  0.15)));lower right
                              (connect (list (make-vect 1.0  0.35)
                                             (make-vect 0.8  0.65)
                                             (make-vect 0.6  0.65)
                                             (make-vect 0.65 0.8)
                                             (make-vect 0.6  1.0)))));upper right
   frame)
   )
   ;test
   (paint wave)

View Code

**2.50

;include the lib and statement that draw picture
#lang scheme
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

(define nil '())
(define (xcor-vect v) (car v) )
(define (ycor-vect v) (cdr v) )
(define (add-vect a b)
 (make-vect (+ (xcor-vect a) (xcor-vect b) )
  (+ (ycor-vect a) (ycor-vect b) )
 )
 )
(define (sub-vect a b)
 (make-vect (- (xcor-vect a) (xcor-vect b) )
  (- (ycor-vect a) (ycor-vect b) )
 )
 )
(define (scale-vect n v)
 (make-vect (* (xcor-vect v) n)
  (* (ycor-vect v) n)
 )
 )
;exercise 2.49
(define (connect vect-list)
 (define (itr seg-list remain)
  (if (null? (cdr remain) )
   (reverse seg-list)
   (itr 
	(cons (make-segment (car remain) (cadr remain)) seg-list)
	(cdr remain)
   )
  )
 )
 (itr nil vect-list)
 )
				;i used to define above-right as (1,1) and above-left as (0,1), which shows a "L" as the result picture.
				;so i guess the width of the line is 0.1, which make the line out of the frame when given "1"
(define above-left (make-vect 0 0.99))
(define below-right (make-vect 0.99 0))
(define above-right (make-vect 0.99 0.99))
(define below-left (make-vect 0 0))
;a, outline
(define (draw-outline f)
 ((segments->painter (connect (list below-left above-left above-right below-right below-left)))
  f
 )
 )
				;test
				(paint draw-outline)
;b, X mark
(define (draw-x f)
 ((segments->painter (list (make-segment below-left above-right)
					  (make-segment above-left below-right)
					 )
  )
  f
 )
 )
				;test
				(paint draw-x)
;c, diamond
(define (draw-diamond f)
 (define (mid-point a b)
  (scale-vect
   0.5
   (add-vect a b)
  )
 )
 ((segments->painter (connect (list (mid-point above-left below-left) 
							   (mid-point above-left above-right)
							   (mid-point above-right below-right)
							   (mid-point below-left below-right)
							   (mid-point above-left below-left))
					)
  )
  f
 )
 )
				;test
				(paint draw-diamond)
;d, wave
(define (wave frame)
  ((segments->painter (append (connect (list (make-vect 0.4  0.0)
                                             (make-vect 0.5  0.33)
                                             (make-vect 0.6  0.0))) ;inside legs
                              (connect (list (make-vect 0.25 0.0)
                                             (make-vect 0.33 0.5)
                                             (make-vect 0.3  0.6)
                                             (make-vect 0.1  0.4)
                                             (make-vect 0.0  0.6))) ;lower left
                              (connect (list (make-vect 0.0  0.8)
                                             (make-vect 0.1  0.6)
                                             (make-vect 0.33 0.65)
                                             (make-vect 0.4  0.65)
                                             (make-vect 0.35 0.8)
                                             (make-vect 0.4  1.0))) ;upper left
                              (connect (list (make-vect 0.75 0.0)
                                             (make-vect 0.6  0.45)
                                             (make-vect 1.0  0.15)));lower right
                              (connect (list (make-vect 1.0  0.35)
                                             (make-vect 0.8  0.65)
                                             (make-vect 0.6  0.65)
                                             (make-vect 0.65 0.8)
                                             (make-vect 0.6  1.0)))));upper right
   frame)
   )
   ;test
   (paint wave)

View Code

**2.51

#lang scheme
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

				;analogous to the beside procedure
(define (my-below painter1 painter2)
 (let ((split-point (make-vect 0.0 0.5)))
  (let ((painter-upper ((transform-painter 
						split-point
						(make-vect 1.0 0.5)
						(make-vect 0.0 1.0)
					   )
						painter2
					   )
		)
		(painter-below ((transform-painter
						(make-vect 0.0 0.0)
						(make-vect 1.0 0.0)
						split-point
					   )
						painter1 
					   )
		)
	   )
   (lambda (frame)
	(painter-upper frame)
	(painter-below frame)
   )
  )
 )
)
;test
(paint (my-below (rotate90 einstein) einstein))

				;using beside and rotate
(define (my-below2 painter1 painter2)
 (rotate90 (rotate90 (rotate90 (beside
								(rotate90 painter2)
								(rotate90 painter1)
							   )
					 )
		   )
 )
 )
				;test
(paint (my-below2 einstein (rotate90 einstein)))

View Code

**2.52

;include the lib and statement that draw picture
#lang scheme
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

(define nil '())
(define (connect vect-list)
 (define (itr seg-list remain)
  (if (null? (cdr remain) )
   (reverse seg-list)
   (itr 
	(cons (make-segment (car remain) (cadr remain)) seg-list)
	(cdr remain)
   )
  )
 )
 (itr nil vect-list)
 )
(define (wave frame)
  ((segments->painter (append (connect (list (make-vect 0.4  0.0)
                                             (make-vect 0.5  0.33)
                                             (make-vect 0.6  0.0))) ;inside legs
                              (connect (list (make-vect 0.25 0.0)
                                             (make-vect 0.33 0.5)
                                             (make-vect 0.3  0.6)
                                             (make-vect 0.1  0.4)
                                             (make-vect 0.0  0.6))) ;lower left
                              (connect (list (make-vect 0.0  0.8)
                                             (make-vect 0.1  0.6)
                                             (make-vect 0.33 0.65)
                                             (make-vect 0.4  0.65)
                                             (make-vect 0.35 0.8)
                                             (make-vect 0.4  1.0))) ;upper left
                              (connect (list (make-vect 0.75 0.0)
                                             (make-vect 0.6  0.45)
                                             (make-vect 1.0  0.15)));lower right
                              (connect (list (make-vect 1.0  0.35)
                                             (make-vect 0.8  0.65)
                                             (make-vect 0.6  0.65)
                                             (make-vect 0.65 0.8)
                                             (make-vect 0.6  1.0)))
				(connect (list (make-vect 0.45 0.75)
						  (make-vect 0.50 0.65)
						  (make-vect 0.55 0.75)
						 )
				)
));upper right
   frame)
   )

   ;test
   (paint wave)

View Code

#lang scheme
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1) ) ) )
        (beside painter (below smaller smaller) )
        )
      )
  )
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1) ) ) )
        (below painter (beside smaller smaller) )
        )
      )
  )
(define (corner-split painter n)
 (if (= n 0)
  painter
  (let ((up (up-split painter (- n 1)) )
		(right (right-split painter (- n 1)) )
		(corner (corner-split painter (- n 1)))
	   )
   (beside (below painter up)
	(below right corner)
   )
  )
 )
 )
				;test
				(paint (corner-split einstein 2))

View Code

#lang racket

(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1) ) )

(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1) ) ) )
        (beside painter (below smaller smaller) )
        )
      )
  )
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1) ) ) )
        (below painter (beside smaller smaller) )
        )
      )
  )

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1) ) )
            (right (right-split painter (- n 1) ) )
            )
        (let ((top-left (beside up up) )
              (corner (corner-split painter (- n 1) ) )
              (bottom-right (below right right) )
              )
          (beside (below painter top-left)
                  (below bottom-right corner)
                  )
          )
        )
      )
  )
(define (square-limit painter n)
  (let ((quarter (rotate180 (corner-split painter n) ) ) )
    (let ((half (beside (flip-horiz quarter)  quarter) ) )
      (below (flip-vert half) half)
      )
    )
  )
(paint (square-limit einstein 4) )

View Code

**2.53

(a b c)

((george))

((y1 y2))

(red shoes blue socks)

**2.54

(define (equal? a b)
 (cond ((and (not (pair? a)) (not (pair? b)))
		(eq? a b)
	   )
  ((and (pair? a) (pair? b) )
   (and (equal? (car a) (car b)) (equal? (cdr a) (cdr b) ))
  )
  (else false)
 )
 )
				;test
				(equal? '(1 2 3 4) '(1 2 3 4) )
				(equal? '(1 (2 3) 4) '(1 (2 3 4) ) )

**2.55

(car ''something) = (car (quote (quote somethin)))

 ;;The first occurrency of 'quote' quotes the next entity 
 ;; (quote something),which is actualy a list with two elements,so 
 ;; caring this list yileds 'quote.However,this is just a quoted 
 ;; symbol,not a procedure,typing quote in the interpreter prints: 
  
quote　　

**2.56

(define (fast-expt b n)
		(define (even? n) (= (remainder n 2) 0))
		(define (square n) (* n n) )
		(define (fast-expt-itr b n product)
			(cond ( (= n 0) product)
					( (even? n) (square (fast-expt-itr b (/ n 2) product) ) )
					  (else (fast-expt-itr b (- n 1) (* product b) ) )
			)
		)
				(fast-expt-itr b n 1)
		)
(define (variable? x) (symbol? x))
(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
(define (sum? x) (and (pair? x) (eq? (car x) '+)))
(define (product? x) (and (pair? x) (eq? (car x) '*)))
(define (addend x) (cadr x))
(define (augend x) (caddr x) )
(define (make-sum a b)
 (cond
  ((=number? a 0) b)
  ((=number? b 0) a)
  ((and (number? a) (number? b))
   (+ a b)
  )
  (else (list '+ a b ) )
 )
 )
(define (=number? x n)
 (and (number? x) (eq? x n) )
 )
(define (make-product a b)
 (cond
  ((or (=number? a 0) (=number? b 0)) 0)
  ((=number? a 1) b)
  ((=number? b 1) a)
  ((and (number? a) (number? b)) (* a b) )
  (else (list '* a b) )
 )
 )

(define (deriv exp var)
 (cond ((number? exp) 0)
  ((variable? exp) 
   (if (same-variable? exp var) 1 0)
  )
  ((sum? exp)
   (make-sum 
	(deriv (addend exp) var)
	(deriv (augend exp) var)
   )
  )
  ((product? exp) 
   (make-sum
	(make-product 
	 (multiplier exp)
	 (deriv (multiplicand exp) var)
	)
	(make-product
	 (multiplicand exp)
	 (deriv (multiplier exp) var)
	)
   )
  )
  ((exponentiation? exp)
   (make-product
	(exponent exp)
	(make-product
	 (make-exponentiation
	  (base exp)
	  (make-sum (exponent exp) -1)
	 )
	 (deriv (base exp) var)
	)
   )
  )
  (else (error "unknow expression type: DERIV" exp))
  )
  )
(define (exponentiation? exp) (and (pair? exp) (eq? (car exp) '**)))
(define (base x) (cadr x))
(define (exponent x) (caddr x) )
(define (make-exponentiation base exponent)
 (cond
  ((=number? exponent 0) 1)
  ((=number? exponent 1) base)
  ((and (number? base) (number? exponent)) (fast-expt base exponent) )
  (else (list '** base exponent) )
 )
 )
				;test
				(deriv '(** x 3) 'x)
				(deriv '(+ x 3) 'x)
				(deriv '(** (+ x 1) (+ y 4) ) 'x)

**2.57

;some basic procedure
(define (fast-expt b n)
		(define (even? n) (= (remainder n 2) 0))
		(define (square n) (* n n) )
		(define (fast-expt-itr b n product)
			(cond ( (= n 0) product)
					( (even? n) (square (fast-expt-itr b (/ n 2) product) ) )
					  (else (fast-expt-itr b (- n 1) (* product b) ) )
			)
		)
				(fast-expt-itr b n 1)
		)
(define (variable? x) (symbol? x))
(define (=number? x n)
 (and (number? x) (eq? x n) )
 )
(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
;sum
(define (sum? x) (and (pair? x) (eq? (car x) '+)))
(define (addend x) (cadr x))
(define (augend x) 
 (let ((aug (cddr x)))
  (if (null? (cdr aug))
   (car aug)
   (cons '+ aug)
   )
 )
 )
(define (make-sum a b)
 (cond
  ((=number? a 0) b)
  ((=number? b 0) a)
  ((and (number? a) (number? b))
   (+ a b)
  )
  (else (list '+ a b ) )
 )
 )
;product
(define (product? x) (and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p)
 (let ((md (cddr p)))
  (if (null? (cdr md))
   (car md)
   (cons '* md)
   )
 )
 )
(define (make-product a b)
 (cond
  ((or (=number? a 0) (=number? b 0)) 0)
  ((=number? a 1) b)
  ((=number? b 1) a)
  ((and (number? a) (number? b)) (* a b) )
  (else (list '* a b) )
 )
 )

(define (deriv exp var)
 (cond ((number? exp) 0)
  ((variable? exp) 
   (if (same-variable? exp var) 1 0)
  )
  ((sum? exp)
   (make-sum 
	(deriv (addend exp) var)
	(deriv (augend exp) var)
   )
  )
  ((product? exp) 
   (make-sum
	(make-product 
	 (multiplier exp)
	 (deriv (multiplicand exp) var)
	)
	(make-product
	 (multiplicand exp)
	 (deriv (multiplier exp) var)
	)
   )
  )
  ((exponentiation? exp)
   (make-product
	(exponent exp)
	(make-product
	 (make-exponentiation
	  (base exp)
	  (make-sum (exponent exp) -1)
	 )
	 (deriv (base exp) var)
	)
   )
  )
  (else (error "unknow expression type: DERIV" exp))
  )
  )
;exponentiation
(define (exponentiation? exp) (and (pair? exp) (eq? (car exp) '**)))
(define (base x) (cadr x))
(define (exponent x) (caddr x) )
(define (make-exponentiation base exponent)
 (cond
  ((=number? exponent 0) 1)
  ((=number? exponent 1) base)
  ((and (number? base) (number? exponent)) (fast-expt base exponent) )
  (else (list '** base exponent) )
 )
 )

				;test
				(deriv '(+ x a b x) 'x)
				(deriv '(* x a b x) 'x)
				(deriv '(+ x 3 4 (* 2 x 3)) 'x)

**2.58

*************a*****************
;some basic procedure
(define (fast-expt b n)
		(define (even? n) (= (remainder n 2) 0))
		(define (square n) (* n n) )
		(define (fast-expt-itr b n product)
			(cond ( (= n 0) product)
					( (even? n) (square (fast-expt-itr b (/ n 2) product) ) )
					  (else (fast-expt-itr b (- n 1) (* product b) ) )
			)
		)
				(fast-expt-itr b n 1)
		)
(define (variable? x) (symbol? x))
(define (=number? x n)
 (and (number? x) (eq? x n) )
 )
(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
;sum
(define (sum? x) (and (pair? x) (eq? (cadr x) '+)))
(define (addend x) (car x))
(define (augend x) (caddr x))
(define (make-sum a b)
 (cond
  ((=number? a 0) b)
  ((=number? b 0) a)
  ((and (number? a) (number? b))
   (+ a b)
  )
  (else (list a '+ b ) )
 )
 )
;product
(define (product? x) (and (pair? x) (eq? (cadr x) '*)))
(define (multiplier p) (car p))
(define (multiplicand p) (caddr p))
(define (make-product a b)
 (cond
  ((or (=number? a 0) (=number? b 0)) 0)
  ((=number? a 1) b)
  ((=number? b 1) a)
  ((and (number? a) (number? b)) (* a b) )
  (else (list a '* b) )
 )
 )

(define (deriv exp var)
 (cond ((number? exp) 0)
  ((variable? exp) 
   (if (same-variable? exp var) 1 0)
  )
  ((sum? exp)
   (make-sum 
	(deriv (addend exp) var)
	(deriv (augend exp) var)
   )
  )
  ((product? exp) 
   (make-sum
	(make-product 
	 (multiplier exp)
	 (deriv (multiplicand exp) var)
	)
	(make-product
	 (multiplicand exp)
	 (deriv (multiplier exp) var)
	)
   )
  )
  ((exponentiation? exp)
   (make-product
	(exponent exp)
	(make-product
	 (make-exponentiation
	  (base exp)
	  (make-sum (exponent exp) -1)
	 )
	 (deriv (base exp) var)
	)
   )
  )
  (else (error "unknow expression type: DERIV" exp))
  )
  )
;exponentiation
(define (exponentiation? exp) (and (pair? exp) (eq? (car exp) '**)))
(define (base x) (cadr x))
(define (exponent x) (caddr x) )
(define (make-exponentiation base exponent)
 (cond
  ((=number? exponent 0) 1)
  ((=number? exponent 1) base)
  ((and (number? base) (number? exponent)) (fast-expt base exponent) )
  (else (list '** base exponent) )
 )
 )
				;test
				(deriv '(x + (3 * (x + (y + 2)))) 'x)


*******************b****************
;some basic procedure
(define (fast-expt b n)
		(define (even? n) (= (remainder n 2) 0))
		(define (square n) (* n n) )
		(define (fast-expt-itr b n product)
			(cond ( (= n 0) product)
					( (even? n) (square (fast-expt-itr b (/ n 2) product) ) )
					  (else (fast-expt-itr b (- n 1) (* product b) ) )
			)
		)
				(fast-expt-itr b n 1)
		)
(define (variable? x) (symbol? x))
(define (=number? x n)
 (and (number? x) (eq? x n) )
 )
(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
;sum
(define (sum? x) (and (pair? x) (eq? (cadr x) '+)))
(define (addend x) (car x))
(define (augend x) 
 (let ((aug (cddr x)))
  (if (null? (cdr aug))
   (car aug)
   aug
   )
 )
 )
(define (make-sum a b)
 (cond
  ((=number? a 0) b)
  ((=number? b 0) a)
  ((and (number? a) (number? b))
   (+ a b)
  )
  (else (list a '+ b ) )
 )
 )
;product
(define (product? x) (and (pair? x) (eq? (cadr x) '*)))
(define (multiplier p) (car p))
(define (multiplicand p)
 (let ((md (cddr p)))
  (if (null? (cdr md))
   (car md)
   md
   )
 )
 )
(define (make-product a b)
 (cond
  ((or (=number? a 0) (=number? b 0)) 0)
  ((=number? a 1) b)
  ((=number? b 1) a)
  ((and (number? a) (number? b)) (* a b) )
  (else (list '* a b) )
 )
 )

(define (deriv exp var)
 (cond ((number? exp) 0)
  ((variable? exp) 
   (if (same-variable? exp var) 1 0)
  )
  ((sum? exp)
   (make-sum 
	(deriv (addend exp) var)
	(deriv (augend exp) var)
   )
  )
  ((product? exp) 
   (make-sum
	(make-product 
	 (multiplier exp)
	 (deriv (multiplicand exp) var)
	)
	(make-product
	 (multiplicand exp)
	 (deriv (multiplier exp) var)
	)
   )
  )
  ((exponentiation? exp)
   (make-product
	(exponent exp)
	(make-product
	 (make-exponentiation
	  (base exp)
	  (make-sum (exponent exp) -1)
	 )
	 (deriv (base exp) var)
	)
   )
  )
  (else (error "unknow expression type: DERIV" exp))
  )
  )
;exponentiation
(define (exponentiation? exp) (and (pair? exp) (eq? (car exp) '**)))
(define (base x) (cadr x))
(define (exponent x) (caddr x) )
(define (make-exponentiation base exponent)
 (cond
  ((=number? exponent 0) 1)
  ((=number? exponent 1) base)
  ((and (number? base) (number? exponent)) (fast-expt base exponent) )
  (else (list '** base exponent) )
 )
 )

				;test
				(deriv '(x + a + b) 'x)
				(deriv '(x + 3 * (x + y + 2)) 'x)

View Code

**2.59

(define (element-of-set? x set)
 (cond ((null? set) false)
  ((equal? x (car set)) true)
  (else (element-of-set? x (cdr set)))
 )
)
(define (union-set a b)
 (cond
  ((null? a) b)
  ((null? b) a)
  ((element-of-set? (car a) b) (union-set (cdr a) b))
  (else (cons (car a) (union-set (cdr a) b)))
 )
)
;test
(define x (list 1 2 3))
(define y (list 4 5 6))
(union-set x y)

**2.60

(define (element-of-set? x set)
 (cond
  ((null? set) false)
  ((equal? x (car set)) true)
  (else (element-of-set? x (cdr set)))
 )
)
(define (adjoin-set x set)
 (cons x set)
)
(define (union-set set1 set2)
 (append set1 set2)
)
(define (intersection-set set1 set2)
 (cond
    ((or (null? set1) (null? set2)) '())
    ((element-of-set? (car set1) set2) (cons (car set1) (intersection-set (cdr set1) set2)))
    (else (intersection-set (cdr set1) set2))
 )
)
;test
(define x (list 1 3 2 3))
(define y (list 4 5 4 5 3 6))
(union-set x y)
(define z (adjoin-set 6 x))
(intersection-set z y)

**2.61

(define (adjoin-set x set)
 (cond
  ((= x (car set)) set)
  ((> x (car set)) (cons (car set) (adjoin-set x (cdr set))))
  (else (cons x set))
 )
)
;test
(define l (list 1 2 3 4 9))
(adjoin-set 7 l)

**2.62

(define (union-set s1 s2)
 (cond
  ((null? s1) s2)
  ((null? s2) s1)
  (else
   (let
    ((x1 (car s1))
     (x2 (car s2))
    )
    (cond
     ((= x1 x2) (cons x1 (union-set (cdr s1) (cdr s2))))
     ((> x1 x2) (cons x2 (union-set s1 (cdr s2))))
     ((< x1 x2) (cons x1 (union-set (cdr s1) s2)))
    )
   )
  )
 )
)
;test
(define a (list 2 3 4 5 6 9 ))
(define b (list 4 5 7 8 9 10))
(union-set a b)

**2.63

yes.

(list 1 3 5 7 9 11)

tree->list-1 takes O(n*log n) time

tree->list-2 takes O(n) time

**2.64

the partial-tree first split the n-length list into two lists, the first one contains the first (quotient (n-1)/2) numbers, and the rest make up for the second list. Then the first element of the second list plays the role as the root, the first list is the left branch of that tree, the remaining elements of the second list is the right branch. And apply the partial-tree to the left branch and right branch respectively.

O(n)

**2.65

(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left-branch right-branch)
 (list entry left-branch right-branch)
)
(define (tree->list tree)
 (define (copy-to-list tree result-list)
  (if (null? tree)
   result-list
   (copy-to-list (left-branch tree)
    (cons (entry tree)
     (copy-to-list (right-branch tree) result-list)
    )
   )
  )
 )
 (copy-to-list tree '())
)
(define (list->tree elements)
 (car (partial-tree elements (length elements)))
)
(define (partial-tree elts n)
 (if (= n 0)
  (cons '() elts)
  (let ((left-size (quotient (- n 1) 2)))
   (let ((left-result (partial-tree elts left-size)))
    (let ((left-tree (car left-result))
          (non-left-elts (cdr left-result))
          (right-size (- n (+ left-size 1)))
         )
     (let ((this-entry (car non-left-elts))
           (right-result (partial-tree (cdr non-left-elts) right-size))
          )
      (let ((right-tree (car right-result))
            (remaining-elts (cdr right-result))
           )
       (cons (make-tree this-entry left-tree right-tree) remaining-elts)
      )
     )
    )
   )
  )
 )
)
(define (union-set-list set1 set2)
 (cond
  ((null? set1) set2)
  ((null? set2) set1)
  (else
   (let
    ((x (car set1))
     (y (car set2))
    )
    (cond 
     ((= x y) (cons x (union-set-list (cdr set1) (cdr set2))))
     ((> x y) (cons y (union-set-list set1 (cdr set2))))
     ((< x y) (cons x (union-set-list (cdr set1) set2)))
    )
   )
  )
 )
)
(define (union-set set1 set2)
 (list->tree (union-set-list (tree->list set1) (tree->list set2)))
)
(define (intersection-set-list list1 list2)
 (cond
  ((or (null? list1) (null? list2)) '())
  (else
   (let
    ((x (car list1))
     (y (car list2))
    )
    (cond
     ((= x y) (cons x (intersection-set-list (cdr list1) (cdr list2))))
     ((< x y) (intersection-set-list (cdr list1) list2))
     ((> x y) (intersection-set-list list1 (cdr list2)))
    )
   )
  )
 )
)
(define (intersection-set set1 set2)
 (list->tree (intersection-set-list (tree->list set1) (tree->list set2)))
)
;test
(define s1 (list->tree '(1 2 3 5 6 8 10 11)))
(define s2 (list->tree '(2 4 6 8 11 13)))
(tree->list (union-set s1 s2))
(tree->list (intersection-set s1 s2))

View Code

**2.66

;constructor and selector
(define (make-record key value) (cons key value))
(define (key record) (car record))
(define (value record) (cdr record))
;tree
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left-branch right-branch)
 (list entry left-branch right-branch)
)
(define (tree->list tree)
 (define (copy-to-list tree result-list)
  (if (null? tree)
   result-list
   (copy-to-list (left-branch tree)
    (cons (entry tree)
     (copy-to-list (right-branch tree) result-list)
    )
   )
  )
 )
 (copy-to-list tree '())
)
(define (list->tree elements)
 (car (partial-tree elements (length elements)))
)
(define (partial-tree elts n)
 (if (= n 0)
  (cons '() elts)
  (let ((left-size (quotient (- n 1) 2)))
   (let ((left-result (partial-tree elts left-size)))
    (let ((left-tree (car left-result))
          (non-left-elts (cdr left-result))
          (right-size (- n (+ left-size 1)))
         )
     (let ((this-entry (car non-left-elts))
           (right-result (partial-tree (cdr non-left-elts) right-size))
          )
      (let ((right-tree (car right-result))
            (remaining-elts (cdr right-result))
           )
       (cons (make-tree this-entry left-tree right-tree) remaining-elts)
      )
     )
    )
   )
  )
 )
)
;tree lookup
(define (lookup given-key set-of-records)
 (if (null? set-of-records)
  false
  (let ((entry-key (key (entry set-of-records))))
   (cond
    ((= given-key entry-key) (entry set-of-records))
    ((> given-key entry-key) (lookup given-key (right-branch set-of-records)))
    ((< given-key entry-key) (lookup given-key (left-branch set-of-records)))
   )
  )
 )
)
;test
(define database
   (list->tree (list (make-record 1 'a)
                                    (make-record 5 'e)
                                    (make-record 10 'j)
                                    (make-record 26 'z))))
 
 (lookup 1 database)
 (lookup 10 database)
 (lookup 7 database)

View Code

**2.67

(a d a b b c a)

**2.68

;representation and selector
(define (make-leaf symbol weight) (list 'leaf symbol weight))
(define (leaf? object) (eq? (car object) 'leaf))
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))

(define (make-code-tree left right)
 (list left right 
  (append (symbols left) (symbols right)) 
  (+ (weight left) (weight right)))
)
(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
(define (symbols tree)
 (if (leaf? tree)
  (list (symbol-leaf tree))
  (caddr tree)
 )
)
(define (weight tree)
 (if (leaf? tree)
  (weight-leaf tree)
  (cadddr tree)
 )
)
(define (encode message tree)
 (if (null? message)
  '()
  (append (encode-symbol (car message) tree)
   (encode (cdr message) tree)
  )
 )
 )
(define (encode-symbol symbol tree)
 (cond 
  ((leaf? tree) '())
  ((member symbol (symbols (left-branch tree)))
   (cons 0 (encode-symbol symbol (left-branch tree)))
  )
  ((member symbol (symbols (right-branch tree)))
   (cons 1 (encode-symbol symbol (right-branch tree)))
  )
  (else (error "bad symbol" symbol))
 )
 )
(define sample-tree
 (make-code-tree (make-leaf 'A 4)
  (make-code-tree (make-leaf 'B 2)
   (make-code-tree (make-leaf 'D 1)
    (make-leaf 'C 1)
   )
  )
 )
)
(define sample-message '(a d a b b c a))
(encode sample-message sample-tree)

**2.69

;representation and selector
(define (make-leaf symbol weight) (list 'leaf symbol weight))
(define (leaf? object) (eq? (car object) 'leaf))
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))

(define (make-code-tree left right)
 (list left right 
  (append (symbols left) (symbols right)) 
  (+ (weight left) (weight right)))
)
(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
(define (symbols tree)
 (if (leaf? tree)
  (list (symbol-leaf tree))
  (caddr tree)
 )
)
(define (weight tree)
 (if (leaf? tree)
  (weight-leaf tree)
  (cadddr tree)
 )
)
(define (adjoin-set x set)
 (cond ((null? set) (list x))
  ((< (weight x) (weight (car set))) (cons x set))
  (else (cons (car set) (adjoin-set x (cdr set))))
 )
)
(define (make-leaf-set pairs)
 (if (null? pairs)
  '()
  (let ((pair (car pairs)))
   (adjoin-set (make-leaf (car pair) (cadr pair))
    (make-leaf-set (cdr pairs))
   )
  )
 )
)
(define (generate-huffman-tree pairs)
 (successive-merge (make-leaf-set pairs))
)
(define (successive-merge leaf-set)
 (if (null? (cdr leaf-set))
  (car leaf-set)
  (successive-merge (adjoin-set
                     (make-code-tree (car leaf-set) (cadr leaf-set))
                     (cddr leaf-set)
                    )
  )
 )
)
(define p (list '(a 1) '(b 2) '(d 2) '(f 3) '(g 5)))
(generate-huffman-tree p)

View Code

**2.70

;representation and selector
(define (make-leaf symbol weight) (list 'leaf symbol weight))
(define (leaf? object) (eq? (car object) 'leaf))
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))

(define (make-code-tree left right)
 (list left right 
  (append (symbols left) (symbols right)) 
  (+ (weight left) (weight right)))
)
(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
(define (symbols tree)
 (if (leaf? tree)
  (list (symbol-leaf tree))
  (caddr tree)
 )
)
(define (weight tree)
 (if (leaf? tree)
  (weight-leaf tree)
  (cadddr tree)
 )
)
(define (encode message tree)
 (if (null? message)
  '()
  (append (encode-symbol (car message) tree)
   (encode (cdr message) tree)
  )
 )
 )
(define (encode-symbol symbol tree)
 (cond 
  ((leaf? tree) '())
  ((member symbol (symbols (left-branch tree)))
   (cons 0 (encode-symbol symbol (left-branch tree)))
  )
  ((member symbol (symbols (right-branch tree)))
   (cons 1 (encode-symbol symbol (right-branch tree)))
  )
  (else (error "bad symbol" symbol))
 )
 )
(define (adjoin-set x set)
 (cond ((null? set) (list x))
  ((< (weight x) (weight (car set))) (cons x set))
  (else (cons (car set) (adjoin-set x (cdr set))))
 )
)
(define (make-leaf-set pairs)
 (if (null? pairs)
  '()
  (let ((pair (car pairs)))
   (adjoin-set (make-leaf (car pair) (cadr pair))
    (make-leaf-set (cdr pairs))
   )
  )
 )
)
(define (generate-huffman-tree pairs)
 (successive-merge (make-leaf-set pairs))
)
(define (successive-merge leaf-set)
 (if (null? (cdr leaf-set))
  (car leaf-set)
  (successive-merge (adjoin-set
                     (make-code-tree (car leaf-set) (cadr leaf-set))
                     (cddr leaf-set)
                    )
  )
 )
)
(define p (list '(a 2) '(na 16) '(boom 1) '(sha 3) '(get 2) '(yip 9) '(job 2) '(wah 1)))
(define lyrics '
 (get a job
  sha na na  na na na na na na
  get a job
  sha na na  na na na na na na
  wah yip yip yip yip yip yip yip yip yip 
  sha boom
 ))
(length (encode lyrics (generate-huffman-tree p)))
(* 3 (length lyrics))

View Code

108

**2.71

n-1

**2.72

As far as i can tell, the complexity of member is O(n), and descending down the tree takes n-1 step, so the complexity of procedure encode is the product of them, O(n^2).

**2.73

nothing to dispatch on number and same variable.

==> 2_73_b.scm <==
(define (install-sum-package)
 (define (addend s) (car s))
 (define (augend s) (cadr s))
 (define (make-sum a b)
  (cond
   ((eq? a 0) b)
   ((eq? b 0) a)
   ((and (number? a) (number? b)) (+ a b))
   (else (list '+ a b))
  )
 )
 (define (deriv-sum s v)
  (make-sum (deriv (addend s) v) (deriv (augend s) v))
 )
 (put 'deriv '+ deriv-sum)
'done)
(define (install-product-package)
 (define (multiplier s) (car s))
 (define (multiplicand s) (cadr s))
 (define (make-product a b)
  (cond
   ((or (eq? a 0) (eq? b 0)) 0)
   ((eq? a 1) b)
   ((eq? b 1) a)
   ((and (number? a) (number? b)) (* a b))
   (else '(* a b))
  )
 )
 (define (make-sum a b)
  (cond
   ((eq? a 0) b)
   ((eq? b 0) a)
   ((and (number? a) (number? b)) (+ a b))
   (else (list '+ a b))
  )
 )
 (define (deriv-product s v)
  (make-sum
   (make-product (deriv (multiplier s) v) (multiplicand s) )
   (make-product (multiplier s) (deriv (multiplicand s) v))
  )
 )
 (put 'deriv '* deriv-product)
'done)

==> 2_73.scm <==
(load "2_73_sys.scm")
(define (variable? x) (symbol? x))
(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
(define (apply-generic op . args)
 (let ((type-tags (map type-tag args)))
  (let ((proc (get op type-tags)))
   (if proc
    (apply proc (map contents args))
    (error "No method for these types -- APPLY-GENERIC"
     (list op type-tags)
    )
   )
  )
 )
)
(define (deriv exp var)
 (cond ((number? exp) 0)
  ((variable? exp) (if (same-variable? exp var) 1 0))
  (else ((get 'deriv (operator exp)) (operands exp) var))
 )
 )
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
		;test
(load "2_73_b.scm")
(install-sum-package)
(install-product-package)
(deriv 'y 'x)
table
(get 'deriv '+)
(deriv '(+ (* x 3) (* y x)) 'x)
(deriv '(* 3 x) 'x)

==> 2_73_sys.scm <==
(define table (list ))
(define (put op type proc)
 (set! table (append table (list (list op type proc))))
 )
(define (get op type)
 (define (search op type t)
  (cond ((null? t) #f)
   ((and (eqv? (caar t) op) (eqv? (cadar t) type))
	(caddar t)
   )
   (else (search op type (cdr t)))
  )
 )
 (search op type table)
 )
(define (attach-tag type-tag contents)
 (cons type-tag contents)
 )
(define (type-tag datum)
 (if (pair? datum)
  (car datum)
  (error "Bad tagged datum -- TYPE-TAG" datum)
 )
 )
(define (content datum)
 (if (pair? datum)
  (cdr datum)
  (error "Bad tagged datum -- CONTENTS" datum)
 )
 )
;(install-sum-package)
;(install-product-package)
;table

View Code

(define (install-exp-package)
 (define (base x) (car x))
 (define (exponent x) (cadr x))
 (define (fast-expt b n)
   (define (fast-expt-itr b n product)
    (cond ( (= n 0) product)
      ( (even? n) (square (fast-expt-itr b (/ n 2) product) ) )
        (else (fast-expt-itr b (- n 1) (* product b) ) )
    )
   )
     (fast-expt-itr b n 1)
   )
 (define (make-product a b)
  (cond
   ((or (eq? a 0) (eq? b 0)) 0)
   ((eq? a 1) b)
   ((eq? b 1) a)
   ((and (number? a) (number? b)) (* a b))
   (else (list '* a b))
  )
 )
 (define (make-sum a b)
  (cond
   ((eq? a 0) b)
   ((eq? b 0) a)
   ((and (number? a) (number? b)) (+ a b))
   (else (list '+ a b))
  )
 )
 (define (make-exponentiation base exponent)
  (cond
   ((eq? exponent 0) 1)
   ((eq? exponent 1) base)
   ((and (number? base) (number? exponent)) (fast-expt base exponent) )
   (else (list '** base exponent) )
  )
  )
 (define (deriv-exp s v)
  (make-product
   (exponent s)
   (make-product (make-exponentiation (base s)
                  (make-sum (exponent s) -1)
                 )
    (deriv (base s) v)
   )
  )
 )
 (put 'deriv '** deriv-exp)
 'done)

View Code

change the put sentence to (put (operator exp) 'deriv proc)

**2.74

(define (get-record divition employee-name)
 ((get division 'record) employee-name)
)
(define (get-salary divition employee-name)
 ((get division 'salary) employee-name)
)
(define (find-employee-record employee-name division-list)
 (if (null? division-list)
  #f
  (or (get-record (car division-list) employee-name)
   (find-employee-record employee-name (cdr division-list))
  )
 )
)

install new division's package which contains the corresponding generic procedures into the lookup table.

**2.75

(define (make-from-mag-ang r a)
 (define (dispatch op)
  (cond ((eq? op 'magnitude) r)
   ((eq? op 'angle) a)
   ((eq? op 'real-part) (* r (cos a)))
   ((eq? op 'imag-part) (* r (sin a)))
  )
 )
)

**2.76

When add new types:

generic operation with explicit dispatch must have to add clauses to each of the generic interface procedures to check for the new type and apply the appropriate selector for the representation.

data-directed style only needs to write corresponding operation in new type's package, and install that package in system to add the record to the table for checking.

message-passing-style needs to add the clause to every procedure on every level to handle the new types.

When add new operation:

generic operation with explicit dispatch need to implement new operation considering all types.

data-directed style have to add to every package the new operation, and insert the corresponding data type, operation and procedure to table.

message-passing-style only requires to add clause to procedure upper level to let it know how to dispatch the new operation.

type-directed style is appropriate for a system in which new types must be often added.

message-passing-style would be most appropriate for a system in which new operation must often be added.

**2.77

Because there is not magnitude method corresponding to complex package in the table. The apply-generic is invoked twice, first by comlex package, then by rectangular.

**2.78

(define (attach-tag type-tag contents)
 (if (number? contents)
  contents
  (cons type-tag contents)
 )
)
(define (type-tag datum)
 (cond
  ((number? datum) 'scheme-number)
  ((pair? datum) (car datum))
  (else (error "Bad tagged datum -- TYPE-TAG" datum))
 )
)
(define (contents datum)
 (cond
  ((number? datum) datum)
  ((pair? datum) (cdr datum))
  (else (error "BAD tagged datum -- CONTENTS" datum))
 )
)
;test
(define a (attach-tag 'scheme-number 1))
(define b (attach-tag 'my-type (list 2 3 4)))
(type-tag a)
(type-tag b)
(contents a)
(contents b)

**2.79

(define (equ? x y) (apply-generic 'equ? x y))
(define (add-equ?-operation)
 (put 'equ? '(scheme-number scheme-number) =)
 (put 'equ? '(rational rational)
  (lambda (x y) (= 
                 (* (numer x) (denom y) )
                 (* (numer y) (denom x) )
                )
  )
 )
 (put 'equ? '(complex complex)
  (lambda (x y) (and
                 (= (real-part x) (real-part y))
                 (= (imag-part x) (imag-part y))
                )
  )
 )
 'done
)

**2.80

(define (=zero? x) (apply-generic '=zero? x))
(define (add-=zero?-operation)
 (put '=zero? 'scheme-number (lambda (x) (= x 0)))
 (put '=zero? 'rational (lambda (x) (= (numer x) 0) ) )
 (put '=zero? 'complex (lambda (x) (and
                                    (= (real-part x) 0)
                                    (= (imag-part x) 0)
                                   )
                       )
 )
 'done
)

**2.81

a. The program will get into endless loop.

b. The original codes work well, because if there is no corresponding operation, the program just report error.

(define (apply-generic op . args)
 (let ((type-tags (map type-tag args)))
  (let ((proc (get op type-tags)))
   (if proc
    (apply proc (map contents args))
    (if (and (= (length args) 2) (not (eq? (car type-tags) (cadr type-tags))))
     (let ((type1 (car type-tags))
           (type2 (cadr type-tags))
           (a1 (car args))
           (a2 (cadr args))
          )
      (let ((t1->t2 (get-coercion type1 type2))
            (t2->t1 (get-coercion type2 type1))
           )
       (cond (t1->t2 (apply-generic op (t1->t2 a1) a2))
        (t2->t1 (apply-generic op a1 (t2->t1 a2)))
        (else (error "No method for these types" (list op type-tags)))
       )
      )
     )
     (else (error "No method for these types" (list op type-tags)))
    )
   )
  )
 )
)

**2.82

(define (get-coercion-type . type-tags)
 (define (coercion-try goal-type types)
  (if (null? types)
   true
   (if (or (equal? (car types) goal-type) (get-coercion (car types) goal-type))
    (coercion-try goal-type (cdr types))
    false
   )
  )
 )
 (define (type-try types)
  (if (null? types)
   false
   (if (coercion-try (car types) type-tags)
    (car types)
    (type-try (cdr types))
   )
  )
 )
 (type-try type-tags)
)
(define (trans type args)
 (if (null? args)
  '()
  (let ((arg (car args)))
   (let ((tran (get-coercion (type-tag arg) type)))
    (if tran
     (cons (tran arg) (trans type (cdr args)))
     (cons arg (trans type (cdr args)))
    )
   )
  )
 )
)
(define (apply-generic op . args)
 (let ((type-tags (map type-tag args)))
  (let ((proc (get op type-tags)))
   (if proc
    (apply proc (map contents args))
    (let ((goal-type (get-coercion-type type-tags)))
     (if goal-type
      (apply-generic op (trans args))
      (error "No method for these types" (list op type-tags))
     )
    )
   )
  )
 )
)

**2.83

(define (raise type) (apply-generic 'raise type))
(put 'raise 'integer (lambda (x) (make-rat x 1)))
(put 'raise 'rational (lambda (x) (make-real (/ (numer x) (denom x)))))
(put 'raise 'real (lambda (x) (make-from-real-imag x 0)))

**2.84

;procedures of raising
(load "2_83.scm")

(define (apply-generic op . args)
 ;suppose t is on the higher level of the tower
 (define (raise-to s t)
  (let ((s-type (type-tag s))
        (t-type (type-tag t))
       )
   (cond
    ((equal? s-type t-type) s)
    ((get 'raise (list s-type))
     (raise-to ((get 'raise s-type) (contents s)) t)
    )
    (else false)
   )
  )
 )
 (let ((type-tags (map type-tag args)))
  (let ((proc (get op type-tags)))
   (if proc
    (apply proc (map contents args))
    (if (= (length args) 2)
     (let ((arg1 (car args))
           (arg2 (cadr args))
          )
      (cond
       ((raise-to arg1 arg2) (apply-generic op (raise-to arg1 arg2) arg2))
       ((raise-to arg2 arg1) (apply-generic op arg1 (raise-to arg2 arg1)))
       (else (error "No method for these types"))
      )
     )
     (error "No method for these types"))
   )
  )
 )
)

**2.85

(define (install-project-package)
 (put 'project 'complex
  (lambda (x) (make-real (real-part x)))
 )
 (put 'project 'real    ;lower real number into integer rather than rational, which is difficult to achieve
  (lambda (x) (make-integer (round x)))
 )
)
(define (project arg)
 (let ((proc (get 'project (type-tag arg)))
       (operand (contents arg))
      )
  (if proc (proc operand) false)
 )
)

(define (drop arg)
 (let ((tag (type-tag arg))
       (lower (project arg))
      )
  (if (and lower (equal? lower (raise lower)))
   (drop lower)
   arg
  )
 )
)

View Code

**2.86

(define (sine x)
 (apply-generic 'sine x)
)
(define (cosine x)
 (apply-generic 'cosine x)
)
(put 'sine 'rational 
 (lambda (x) (sin (/ (numer x) (denomer x))))
)
(put 'sine 'scheme-number 
 (lambda (x) (sin x))
)
(put 'cosine 'rational 
 (lambda (x) (cos (/ (numer x) (denomer x))))
)
(put 'cosine 'scheme-number 
 (lambda (x) (cos x))
)

As for the accommodation on the complex-package codes, it can be described in briefly one sentence that all the operands in the complex-number operation should be raised to rational-number level.

**2.87

(define (=zero? coefficient)
 (cond
  ((number? coefficient) (if (= 0 coefficient)
                          true
                          false
                         )
  )
  ((pair? coefficient) (=zero? (coeff coefficient)))
  (else (error "Unknow type"))
 )
)

**2.88

;(define (sub-poly p1 p2)
; (if (same-variable? (variable p1) (variable p2))
;  (make-poly (varibale p1)
;   (sub-terms (term-list p1) (term-list p2))
;  )
;  (error "Polys not in same var -- SUB-POLY" (list p1 p2))
; )
;)
;(define (sub-terms L1 L2)
; (cond ((empty-termlist? L2) L1)
;  ((empty-termlist? L1) (negate L2))
;  (else
;   (let ((t1 (first-term L1))
;         (t2 (first-term L2))
;        )
;    (cond
;     ((> (order t1) (order t2))
;      (adjoin-term t1 (sub-terms (rest-terms L1) L2))
;     )
;     ((< (order t1) (order t2))
;      (adjoin-term (sub-terms L1 (rest-terms L2)) t2)
;     )
;     (else
;      (adjoin-term
;       (make-term (order t1)
;        (add (coeff t1) (coeff t2))
;       )
;       (sub-terms (rest-terms L1) (rest-terms L2))
;      )
;     )
;    )
;   )
;  )
; )
;)

;this is the simple way
(define (negate termlist)
 (apply-generic 'negate termlist)
)
(put 'negate 'scheme-number (lambda (t) (tag (- t))))
(put 'negate 'rational (lambda (t) (make-rational (- (numer t)) (denom t))))
(put 'negate 'complex (lambda (t) (make-from-real-imag (- (real-part t)) (- (imag-part t)))))
(define (negate-terms termlist)
 (if (empty-termlist? termlist)
  the-empty-termlist
  (let ((t (first-term termlist)))
   (adjoin-term (make-term (order t) (negate (coeff t)))
    (negate-terms (rest-terms termlist))
   )
  )
 )
)
(put 'negate 'poly (lambda (poly) (make-poly (variable poly) (negate-terms (term-list poly)))))
(put 'sub 'poly (lambda (x y) (tag (add-poly x (negate y)))))

View Code

**2.89

(define (adjoin-term term term-list)
 (if (=zero? (coeff term))
  term-list
  (let ((exponent (order term))
        (len (length term-list))
       )
   (cond
    ((= (+ exponent 1) len)
    (cons (cons (coeff term) (first-term term-list)) (rest-term term-list))
    )
    ((> (+ exponent 1) len)
     (cons (coeff term) (complement-zero exponent term-list))
    )
    (else
     (cons (first-term term-list) (adjoin-term term (rest-term term-list)))
    )
   )
  )
 )
)

**2.90

**2.91

(define (div-terms L1 L2)
 (if (empty-termlist? L1)
  (list (the-empty-termlist) (the-empty-termlist))
  (let ((t1 (first-term L1))
        (t2 (first-term L2))
       )
   (if (> (order t2) (order t1))
    (list (the-empty-termlist) L1)
    (let ((new-c (div (coeff t1) (order t2)))
          (new-o (- (order t1) (order t2)))
         )
     (let ((rest-of-result
            (div-terms (add-terms L1 (negate (mul-terms (list new-t) L2)))
             L2)
           )
          )
      (list (adjoin-term new-t (car rest-of-result))
       (cadr rest-of-result)
      )
     )
    )
   )
  )
 )
)

View Code

**2.92

(define (apply-generic op . args)
 (let ((type-tags (map type-tag args)))
  (let ((proc (get op type-tags)))
   (if proc
    (apply proc (map contents args))
    (error "No method for these types"
     (list op type-tags)
    )
   )
  )
 )
)

(define put 2d-put!)    ;2d-put! x-key y-key datum
(define (get x-key y-key)
 (let ((1d-table (2d-get-alist-x x-key)))
  (let ((type-f (assoc y-key 1d-table)))
   (if type-f (cdr type-f) #f)
  )
 )
)

(define (type-tag datum)
 (cond 
  ((pair? datum) (car datum))
  ((number? datum) 'scheme-number)
  (else (error "Bad tagged datum -- TYPE-TAG" datum))
 )
)

(define (contents datum)
 (cond 
  ((pair? datum) (cdr datum))
  ((number? datum) datum)
  (else (error "Bad tagged datum -- CONTENTS" datum))
 )
)

(define (attache-tag type-tag contents)
 (if (number? contents) 
  contents
  (cons type-tag contents)
 )
)

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (negation x) (apply-generic 'negation x))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (equ? x y) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))

;scheme number package
(define (install-scheme-number-package)
 (define (tag x)
  (attache-tag 'scheme-number x)
 )
 (put 'add '(scheme-number scheme-number)
  (lambda (x y) (tag (+ x y)))
 )
 (put 'sub '(scheme-number scheme-number)
  (lambda (x y) (tag (- x y)))
 )
 (put 'negation '(scheme-number)
  (lambda (x) (tag (- x)))
 )
 (put 'mul '(scheme-number scheme-number)
  (lambda (x y) (tag (* x y)))
 )
 (put 'div '(scheme-number scheme-number)
  (lambda (x y) (tag (/ x y)))
 )
 (put 'equ? '(scheme-number scheme-number) =)
 (put '=zero? '(scheme-number)
  (lambda (x) (= x 0))
 )
 (put 'make 'scheme-number
  (lambda (x) (tag x))
 )
)

;install polynomial package
(define (install-polynomial-package)
 (define (variable p) (car p))
 (define (term-list p) (cdr p))
 (define (variable? x) (symbol? x))
 (define (same-variable? a b)
  (and (variable? a) (variable? b) (eq? a b))
 )
 (define (order term) (car term))
 (define (coeff term) (cadr term))
 (define (first-term term-list) (car term-list))
 (define (rest-terms term-list) (cdr term-list))
 (define (empty-termlist? term-list) (null? term-list))
;can't be (define wrong-empty-list '())
;;the difference lays on the result when null? procedure is called on it
 ;;(null? wrong-empty-list) return #t
 ;;(null? empty-termlist) return #f
 (define (empty-termlist) '())
 (define (adjoin-term term term-list)
  (if (=zero? (coeff term) )
   term-list
   (cons term term-list)
  )
 )
 (define (remove-zeros L) (filter (lambda (term) (not (=zero? (coeff term)))) L))
 (define (make-term order coeff) (list order coeff))
 (define (make-poly variable term-list) (cons variable (remove-zeros term-list)))
 (define (add-poly p1 p2)
  (let ((v1 (variable p1))
        (v2 (variable p2))
        (t1 (term-list p1))
        (t2 (term-list p2))
       )
   (if (same-variable? v1 v2)
    (make-poly v1 (add-terms t1 t2))
    (let ((type1 (var-type v1))
          (type2 (var-type v2))
         )
     (if (and type1 type2)
        (if (> type1 type2)
            (add-poly p1 (make-poly v1 (list (make-term 0 (tag p2)))))
            (add-poly p2 (make-poly v2 (list (make-term 0 (tag p1)))))
        )
        (error "Invalid variable -- ADD-POLY" (list p1 p2))
     )
    )
   )
  )
 )
 (define (add-terms L1 L2)
  (cond 
   ((empty-termlist? L1) L2)
   ((empty-termlist? L2) L1)
   (else
    (let
     ((t1 (first-term L1))
      (t2 (first-term L2))
     )
     (cond 
      ((> (order t1) (order t2))
            (adjoin-term t1 (add-terms (rest-terms L1) L2))
           )
      ((< (order t1) (order t2))
            (adjoin-term t2 (add-terms L1 (rest-terms L2)))
           )
      (else (adjoin-term 
             (make-term (order t1)
             (add (coeff t1) (coeff t2))
             )
             (add-terms (rest-terms L1) (rest-terms L2))
            )
      )
     )
    )
   )
  )
 )
 (define (sub-poly p1 p2)
  (add-poly p1 (neg-poly p2))
 )
 (define (neg-poly p) (make-poly (variable p) (neg-terms (term-list p))))
 (define (neg-terms term-list)
  (if (empty-termlist? term-list)
   term-list
   (let ((t (first-term term-list)))
    (adjoin-term (make-term (order t) (negation (coeff t)))
     (neg-terms (rest-terms term-list))
    )
   )
  )
 )
 (define (mul-poly p1 p2)
  (let ((v1 (variable p1))
        (v2 (variable p2))
       )
   (if (same-variable? v1 v2)
    (make-poly v1 (mul-terms (term-list p1) (term-list p2)))
    (let ((type1 (var-type v1))
          (type2 (var-type v2))
         )
     (if (and type1 type2)
      (if (> type1 type2)
       (mul-poly p1 (make-poly v1 (list (make-term 0 (tag p2)))))
       (mul-poly p2 (make-poly v2 (list (make-term 0 (tag p1)))))
      )
      (error "Don't know the order of the two variables -- MUL-POLY" (list p1 p2))
     )
    )
   )
  )
 )
 (define (mul-terms L1 L2)
  (if (empty-termlist? L1) (empty-termlist)
   (add-terms (mul-term-by-all-terms (first-term L1) L2)
    (mul-terms (rest-terms L1) L2)
   )
  )
 )
 (define (mul-term-by-all-terms t L)
  (if (empty-termlist? L)
   (empty-termlist)
   (let ((term (first-term L)))
    (adjoin-term (make-term (+ (order t) (order term))
                  (mul (coeff t) (coeff term))
                 )
            (mul-term-by-all-terms t (rest-terms L))
    )
   )
  )
 )
 (define (add-num-poly x p)
  (make-poly (variable p) (add-terms (list (make-term 0 x)) (term-list p)))
 )
 (define (mul-num-poly x p)
  (make-poly (variable p) 
   (map (lambda (term) (list (order term) (*  x (coeff term))))
    (term-list p)
   )
  )
 )

 ;interface
 (define (tag x) (attache-tag 'polynomial x))
 (put 'add '(polynomial scheme-number)
  (lambda (p x) (tag (add-num-poly x p)))
 )
 (put 'add '(polynomial polynomial)
  (lambda (p1 p2) (tag (add-poly p1 p2)))
 )
 (put 'add '(scheme-number polynomial)
  (lambda (x p) (tag (add-num-poly x p)))
 )
 (put 'sub '(polynomial scheme-number)
  (lambda (p x) (tag (add-num-poly (negation (attache-tag 'scheme-number x)) p)))
 )
 (put 'sub '(polynomial polynomial)
  (lambda (p1 p2) (tag (add-poly p1 (neg-poly p2))))
 )
 (put 'sub '(scheme-number polynomial)
  (lambda (x p) (tag (add-num-poly x (neg-poly p))))
 )
 (put 'mul '(polynomial scheme-number)
  (lambda (p x) (tag (mul-num-poly x p)))
 )
 (put 'mul '(polynomial polynomial)
  (lambda (p1 p2) (tag (mul-poly p1 p2)))
 )
 (put 'mul '(scheme-number polynomial)
  (lambda (x p) (tag (mul-num-poly x p)))
 )
 (put '=zero? '(polynomial)
  (lambda (p) (empty-termlist? (term-list p)))
 )
 (put 'make 'polynomial (lambda (v t) (tag (make-poly v t))))
 'done
)

;invoker
 (define (var-type v)
  (cond 
   ((eq? v 'x) 0)
   ((eq? v 'y) 1)
   (else #f)
  )
 )
 (define (make-polynomial variable term-list)
  ((get 'make 'polynomial) variable term-list)
 )

;test
(install-scheme-number-package)
(install-polynomial-package)

(define px1 (make-polynomial 'x '((4 2) (2 1) (0 5))))
(define px2 (make-polynomial 'x '((3 7) (1 3.5))))
(define py1 (make-polynomial 'y '((5 1) (4 3) (2 4.7) (0 -8.1)))) 
(define py2 (make-polynomial 'y '((4 2.3) (3 2.) (2 4) (1 20))))
(define pxy1 (make-polynomial 'y (list (list 3 px1)
                                       (list 2 px2)
                                       (list 1 0.4)
                                       (list 0 px1))))
(define pxy2 (make-polynomial 'y (list (list 4 px2)
                                       (list 3 2.36)
                                       (list 1 px1))))

(define pxy3 (make-polynomial 'y (list (list 4 px2)
                                       (list 2 px1)
                                       (list 1 px1))))

(add px1 py2)
;Value: (polynomial y (4 2.3) (3 2.) (2 4) (1 20) (0 (polynomial x (4 2) (2 1) (0 5))))

(add py1 px2)
;Value: (polynomial y (5 1) (4 3) (2 4.7) (0 (polynomial x (3 7) (1 3.5) (0 -8.1))))

(sub px2 py1)
;Value: (polynomial y (5 -1) (4 -3) (2 -4.7) (0 (polynomial x (3 7) (1 3.5) (0 8.1))))

(sub pxy2 px2)
;Value: (polynomial y (4 (polynomial x (3 7) (1 3.5))) 
;                     (3 2.36) 
;                     (1 (polynomial x (4 2) (2 1) (0 5))) 
;                     (0 (polynomial x (3 -7) (1 -3.5))))

(add pxy3 pxy2)
;Value: (polynomial y (4 (polynomial x (3 14) (1 7.))) 
;                     (3 2.36) 
;                     (2 (polynomial x (4 2) (2 1) (0 5))) 
;                     (1 (polynomial x (4 4) (2 2) (0 10))))

(mul py2 px2)
;Value: (polynomial y (4 (polynomial x (3 16.099999999999998) (1 8.049999999999999))) 
;                     (3 (polynomial x (3 14.) (1 7.))) 
;                     (2 (polynomial x (3 28) (1 14.))) 
;                     (1 (polynomial x (3 140) (1 70.))))

(mul pxy1 px2)
;Value: (polynomial y (3 (polynomial x (7 14) (5 14.) (3 38.5) (1 17.5))) 
;                     (2 (polynomial x (6 49) (4 49.) (2 12.25))) 
;                     (1 (polynomial x (3 2.8000000000000003) (1 1.4000000000000001))) 
;                     (0 (polynomial x (7 14) (5 14.) (3 38.5) (1 17.5))))

(mul pxy2 pxy3)
;Value: (polynomial y (8 (polynomial x (6 49) (4 49.) (2 12.25))) 
;                     (7 (polynomial x (3 16.52) (1 8.26))) 
;                     (6 (polynomial x (7 14) (5 14.) (3 38.5) (1 17.5))) 
;                     (5 (polynomial x (7 28) (5 28.) (4 4.72) (3 77.) (2 2.36) (1 35.) (0 11.799999999999999))) 
;                     (4 (polynomial x (4 4.72) (2 2.36) (0 11.799999999999999))) 
;                     (3 (polynomial x (8 4) (6 4) (4 21) (2 10) (0 25))) 
;                     (2 (polynomial x (8 4) (6 4) (4 21) (2 10) (0 25))))

(mul (mul px1 py1) pxy2)
;Value: (polynomial y (9 (polynomial x (7 14) (5 14.) (3 38.5) (1 17.5))) 
;                     (8 (polynomial x (7 42) (5 42.) (4 4.72) (3 115.5) (2 2.36) (1 52.5) (0 11.799999999999999))) 
;                     (7 (polynomial x (4 14.16) (2 7.08) (0 35.4))) 
;                     (6 (polynomial x (8 4) (7 65.8) (6 4) (5 65.8) (4 21) (3 180.95) (2 10) (1 82.25) (0 25))) 
;                     (5 (polynomial x (8 12) (6 12) (4 85.184) (2 41.092) (0 130.45999999999998))) 
;                     (4 (polynomial x (7 -113.39999999999999) (5 -113.39999999999999) (3 -311.85) (1 -141.75))) 
;                     (3 (polynomial x (8 18.8) (6 18.8) (4 60.468) (2 27.884) (0 21.92))) 
;                     (1 (polynomial x (8 -32.4) (6 -32.4) (4 -170.1) (2 -81.) (0 -202.5))))

View Code

posted on 2015-01-09 10:36 alex_wood 阅读(485) 评论(0) 编辑收藏举报

会员力量，点亮园子希望

刷新页面返回顶部

alex_wood

sicp solutions

导航

公告