Skip to content

Instantly share code, notes, and snippets.

@emanuelfeld
Last active September 19, 2018 18:19
Show Gist options
  • Save emanuelfeld/103923e607cd108d05ccf237ae296224 to your computer and use it in GitHub Desktop.
Save emanuelfeld/103923e607cd108d05ccf237ae296224 to your computer and use it in GitHub Desktop.

Structure and Interpretation of Computer Programs

1.3 Define a procedure that takes three numbers as arguments and returns the sum of the squares of the two larger numbers.

(define (largest-sum-of-squares x y z)
  (cond ((not (or (< y x) (< z x))) (+ (* y y) (* z z)))
        ((not (or (< x y) (< z y))) (+ (* x x) (* z z)))
        (else                       (+ (* x x) (* y y)))))
> (largest-sum-of-squares 1 2 3)
13

1.7 The good-enough? test used in computing square roots will not be very effective for finding the square roots of very small numbers. Also, in real computers, arithmetic operations are almost always performed with limited precision. This makes our test inadequate for very large numbers. Explain these statements, with examples showing how the test fails for small and large numbers. An alternative strategy for implementing good-enough? is to watch how guess changes from one iteration to the next and to stop when the change is a very small fraction of the guess. Design a square-root procedure that uses this kind of end test. Does this work better for small and large numbers?

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

(define (improve guess x)
  (average guess (/ x guess)))

(define (sqrt-iter guess prev-guess x)
  (if (good-enough? guess prev-guess)
      guess
      (sqrt-iter (improve guess x) guess x)))

(define (good-enough? guess prev-guess)
  (< (abs (- guess prev-guess)) (* 0.001 guess)))

(define (sqrt x)
  (sqrt-iter 1.0 0.0 x))

1.8 Implement a cube-root procedure analogous to the square-root procedure.

(define (improve-cbrt guess x)
  (/ (+ (/ x (* guess guess)) 
     (* 2 guess)) 
   3))

(define (good-enough? guess prev-guess)
  (< (abs (- guess prev-guess)) (* 0.001 guess)))

(define (rt-iter guess prev-guess x)
  (if (good-enough? guess prev-guess)
       guess
       (rt-iter (improve-cbrt guess x) guess x)))

(define (cbrt x)
  (rt-iter 1.0 0.0 x))

1.11 A function f is defined by the rule that f(n)=n if n<3 and f(n)=f(n−1)+2f(n−2)+3f(n−3) if n≥3. Write a procedure that computes f by means of a recursive process. Write a procedure that computes f by means of an iterative process.

(define (f-recursive n)
  (if (< n 3)
      n
      (+ (f-recursive (- n 1)) (* 2 (f-recursive (- n 2))) (* 3 (f-recursive (- n 3))))))

(define (f-iterative n)
  (define (iter a b c counter n)
    (cond ((< n 3) n)
          ((= counter n) c)
          (else (iter b c (+ c (* 2 b) (* 3 a)) (+ counter 1) n))))
  (iter 0 1 2 2 n))

1.12 Write a procedure that computes elements of Pascal’s triangle by means of a recursive process.

(define (pascal row col)
  (cond ((= col row) 1)
        ((= col 1) 1)
        ((+ (pascal (- row 1) (- col 1))
            (pascal (- row 1) col)))))

1.13 Prove that Fib(n) is the closest integer to (φ^n)/√5 where φ=(1+√5)/2.

psi^2 = (1 + 2*sqrt(5) + 5) / 4 = (6 + 2*sqrt(5)) / 4 = (3 + sqrt(5)) / 2 = (1 + p)
sigma^2 = (1 - 2*sqrt(5) + 5) / 4 = (6 - 2*sqrt(5)) / 4 = (3 - sqrt(5)) / 2 = (1 + s)

Base case

fib(0) = (psi^0 - sigma^0) / sqrt(5) = 0
fib(1) = (psi^1 - sigma^1) / sqrt(5) = sqrt(5) / sqrt(5) = 1
fib(2) = (psi^2 - sigma^2) / sqrt(5)
       = [(3 + sqrt(5)) / 2 - (3 - sqrt(5)) / 2] / sqrt(5) = sqrt(5) / sqrt(5) 
       = 1

fib(1) + fib(0) = 1 = fib(2)

Inductive step

fib(n) = (psi^n - sigma^n) / sqrt(5)
fib(n + 1) = (psi^(n + 1) - sigma^(n + 1)) / sqrt(5)

fib(n + 1) + fib(n) =? fib(n + 2)
                    = psi^n - sigma^n + psi^(n+1) - sigma^(n+1)
                    = psi^n * (1 + psi) - sigma^n * (1 + sigma)
                    = psi^n * psi^2 - sigma^n * sigma^2
                    = (psi^(n + 2) - sigma^(n + 2)) / sqrt(5)
                    = fib(n + 2)

fib(n) = (psi^n - sigma^n) / sqrt(5)
fib(n) - psi^n / sqrt(5) = -sigma^n / sqrt(5)
| sigma^n | ≤ sqrt(5) / 2 > 1
| sigma^1 | = (1 - sqrt(5)) / 2 < 1

So, fib(n) closest integer to psi^n / sqrt(5)

1.16 Design a procedure that evolves an iterative exponentiation process that uses successive squaring and uses a logarithmic number of steps.

(define (expt-iter b n)
  (define (iter b n a)
  (cond ((= n 0) a)
        ((even? n) (iter (square b) (/ n 2) a))
        (else (iter b (- n 1) (* a b)))))
  (iter b n 1))

1.17 Design a multiplication procedure analogous to fast-expt that uses a logarithmic number of steps.

(define (mul-iter a b)
  (define (double n) (* n 2))
  (define (halve n) (/ n 2))
  (define (iter a b c)
      (cond ((= b 0) c)
            ((even? b) (iter (double a) (halve b) c))
            (else (iter a (- b 1) (+ a c)))))
  (iter a b 0))

1.19

T = [[1 1]
     [1 0]]

T_pq = [[p+q q]
        [q   p]]

T_p'q' is the result of applying T_pq twice, i.e.:

T_p'q' = [[(p+q)^2+q^2 (p+q)q+pq]  
          [(p+q)q+pq   q^2+p^2  ]]
       = [[p^2+2pq+2q^2 2pq+q^2]
          [2pq+q^2      p^2+q^2]]
       = [[p'+q' q']
          [q'    p']]
 
 where:
 p' = p^2+q^2
 q' = 2pq+q^2
(define (fib n)
  (fib-iter 1 0 0 1 n))

(define (fib-iter a b p q count)
  (cond ((= count 0) 
         b)
        ((even? count)
         (fib-iter a
                   b
                   (+ (* p p) (* q q))
                   (+ (* 2 p q) (* q q))
                   (/ count 2)))
        (else 
         (fib-iter (+ (* b q) 
                      (* a q) 
                      (* a p))
                   (+ (* b p) 
                      (* a q))
                   p
                   q
                   (- count 1)))))

1.29

(define (simpsons-sum f a b n)
  (define h (/ (- b a) n))
  (define (term k)
    (define y (f (+ a (* k h))))
    (cond ((or (= k 0) (= k n)) y)
          ((even? k)  (* 2 y))
          ((* 4 y))))
  (* (/ h 3) (sum term 0 inc n)))
> (simpsons-sum cube 0 1 100)
1/4
> (simpsons-sum cube 0 1 1000)
1/4

1.30

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

1.31

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

(define (factorial n)
  (define (self n) n)
  (define (inc n) (+ n 1))
  (product self 1 inc n))

(define (wallace-term n) (* (/ n (- n 1)) (/ n (+ n 1))))
(define (inc-two n) (+ n 2))
> (* (product wallace-term 2 inc-two 1000) 2)
3.141435593589838
(define (product-recursive term a next b)
  (if (> a b)
      1
      (* (term a) (product-recursive term (next a) next b))))

1.32 Show that sum and product (Exercise 1.31) are both special cases of a still more general notion called accumulate that combines a collection of terms, using some general accumulation function:

(accumulate combiner null-value term a next b)

Accumulate takes as arguments the same term and range specifications as sum and product, together with a combiner procedure (of two arguments) that specifies how the current term is to be combined with the accumulation of the preceding terms and a null-value that specifies what base value to use when the terms run out. Write accumulate and show how sum and product can both be defined as simple calls to accumulate.

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

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

(define (factorial-accumulate n)
  (define (self n) n)
  (define (inc n) (+ n 1))
  (product-accumulate self 1 inc n))

If your accumulate procedure generates an iterative process, write one that generates a recursive process.

(define (accumulate-recursive combiner null-value term a next b)
  (if (> a b)
      null-value
      (combiner (term a) (accumulate-recursive combiner null-value term (next a) next b))))
    
(define (factorial-accumulate-recursive n)
  (define (self n) n)
  (define (inc n) (+ n 1))
  (accumulate-recursive * 1 self 1 inc n))

1.33 You can obtain an even more general version of accumulate (Exercise 1.32) by introducing the notion of a filter on the terms to be combined. That is, combine only those terms derived from values in the range that satisfy a specified condition. The resulting filtered-accumulate abstraction takes the same arguments as accumulate, together with an additional predicate of one argument that specifies the filter. Write filtered-accumulate as a procedure.

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

Show how to express the following using filtered-accumulate:

  1. the sum of the squares of the prime numbers in the interval a to b (assuming that you have a prime? predicate already written)
(define (sum-sq-primes a b)
  (define (square n) (* n n))
  (define (inc n) (+ n 1))
  (filtered-accumulate prime? + 0 square a inc b))
  1. the product of all the positive integers less than n that are relatively prime to n (i.e., all positive integers i<n such that GCD(i,n)=1).
(define (product-relatively-primes n)
  (define (self n) n)
  (define (inc n) (+ n 1))
  (define (relatively-prime? i) ((= (gcd i n) 1)))
  (filtered-accumulate relatively-prime? * 1 self a inc b))

1.35 Show that the golden ratio φ is a fixed point of the transformation x↦1+1/x, and use this fact to compute φ by means of the fixed-point procedure.

phi = (1 + sqrt(5))/2
1 + 1/phi = 1 + 2/(1 + sqrt(5))

phi                 =? 1 + 1/phi
(1 + sqrt(5))/2   =? 1 + 2/(1 + sqrt(5))
(1 + sqrt(5))     =? 2 + 4/(1 + sqrt(5))
(1 + sqrt(5))^2   =? 2*(1 + sqrt(5)) + 4
1 + 2*sqrt(5) + 5 =? 2 + 2*sqrt(5) + 4
6 + 2*sqrt(5)     =? 6 + 2*sqrt(5)
6 + 2*sqrt(5)     == 6 + 2*sqrt(5)

Hence, phi is a fixed point of the transformation x --> 1 + 1/x.
> (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1)
1.6180327868852458

1.36 Modify fixed-point so that it prints the sequence of approximations it generates, using the newline and display primitives shown in Exercise 1.22. Then find a solution to x^x=1000 by finding a fixed point of xlog(1000)/log(x). (Use Scheme’s primitive log procedure, which computes natural logarithms.) Compare the number of steps this takes with and without average damping.

  1. Without damping:
> (fixed-point (lambda (x) (/ (log 1000) (log x))) 2)
9.965784284662087
... (33 steps)
4.555532270803653
  1. With damping:
> (fixed-point (lambda (x) (* 0.5 (+ x (/ (log 1000) (log x))))) 2)
5.9828921423310435
... (8 steps)
4.555537551999825

1.37

  1. Define a procedure cont-frac such that evaluating (cont-frac n d k) computes the value of the kk-term finite continued fraction. Check your procedure by approximating 1/φ using
(cont-frac (lambda (i) 1.0)
           (lambda (i) 1.0)
           k)

for successive values of k. How large must you make k in order to get an approximation that is accurate to 4 decimal places (0.6180)?

(define (cont-frac n d k)
  (define (iter n d i result)
      (if (= i 0)
          result
          (iter n d (- i 1) (/ (n i) (+ (d i) result)))))
  (let ((start (/ (n k) (d k))))
        (iter n d k start)))
> (cont-frac (lambda (i) 1.0)
             (lambda (i) 1.0)
             10)
0.6180555555555556
  1. If your cont-frac procedure generates a recursive process, write one that generates an iterative process. If it generates an iterative process, write one that generates a recursive process.
(define (cont-frac-recur n d k)
  (define (recur n d i)
      (if (= i k)
          (/ (n i) (d i))
          (/ (n i) (+ (d i) (recur n d (+ i 1))))))
  (recur n d 0))
> (cont-frac-recur (lambda (i) 1.0)
                   (lambda (i) 1.0)
                   10)
0.6180555555555556

1.38 In 1737, the Swiss mathematician Leonhard Euler published a memoir De Fractionibus Continuis, which included a continued fraction expansion for e−2, where e is the base of the natural logarithms. In this fraction, the N_i are all 1, and the D_i are successively 1, 2, 1, 1, 4, 1, 1, 6, 1, 1, 8, …. Write a program that uses your cont-frac procedure from Exercise 1.37 to approximate e, based on Euler’s expansion.

> (+ (cont-frac (lambda (i) 1.0)
                (lambda (i) (if (= (modulo (- i 2) 3) 0) (* 2 (expt 2 (/ (- i 2) 3))) 1.0))
                10) 2)
2.718288334182374

1.39 Define a procedure (tan-cf x k) that computes an approximation to the tangent function based on Lambert’s formula. k specifies the number of terms to compute, as in Exercise 1.37.

(define (tan-cf x k)
  (cont-frac (lambda (i) (if (= i 1) x (* -1 x x)))
             (lambda (i) (- (* 2 i) 1))
             k))
> (tan-cf 0.78539816 10)
0.9999999932051035

1.40 Define a procedure cubic that can be used together with the newtons-method procedure in expressions of the form (newtons-method (cubic a b c) 1) to approximate zeros of the cubic x^3+ax^2+bx+c.

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

1.41 Define a procedure double that takes a procedure of one argument as argument and returns a procedure that applies the original procedure twice. For example, if inc is a procedure that adds 1 to its argument, then (double inc) should be a procedure that adds 2. What value is returned by (((double (double double)) inc) 5)?

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

1.42 Let f and g be two one-argument functions. The composition f after g is defined to be the function xf(g(x)). Define a procedure compose that implements composition.

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

1.43

(define (repeated f n)
  (cond ((= n 0) identity)
        ((even? n) (repeated (compose f f) (/ n 2)))
        ((compose f (repeated f (- n 1))))))
> ((repeated square 2) 5)
625

1.44 The idea of smoothing a function is an important concept in signal processing. If f is a function and dx is some small number, then the smoothed version of f is the function whose value at a point x is the average of f(xdx), f(x), and f(x+dx). Write a procedure smooth that takes as input a procedure that computes f and returns a procedure that computes the smoothed f. It is sometimes valuable to repeatedly smooth a function (that is, smooth the smoothed function, and so on) to obtain the n-fold smoothed function. Show how to generate the n-fold smoothed function of any given function using smooth and repeated from Exercise 1.43.

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

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

1.45

1.46 Several of the numerical methods described in this chapter are instances of an extremely general computational strategy known as iterative improvement. Iterative improvement says that, to compute something, we start with an initial guess for the answer, test if the guess is good enough, and otherwise improve the guess and continue the process using the improved guess as the new guess. Write a procedure iterative-improve that takes two procedures as arguments: a method for telling whether a guess is good enough and a method for improving a guess. Iterative-improve should return as its value a procedure that takes a guess as argument and keeps improving the guess until it is good enough. Rewrite the sqrt procedure of 1.1.7 and the fixed-point procedure of 1.3.3 in terms of iterative-improve.

(define (iterative-improve good-enough? improver)
  (lambda (guess)
    (let ((next-guess (improver guess)))
         (if (good-enough? guess next-guess)
             next-guess
             ((iterative-improve good-enough? improver) next-guess)))))
(define (close-enough? x y) 
  (< (abs (- x y)) 0.001))

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

(define (sqrt x)
  (define (improver guess)
    (average guess (/ x guess)))
  ((iterative-improve close-enough? improver) x))

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

2.1

(define (make-rat n d)
  (let ((g ((if (< d 0) - +) (abs (gcd n d)))))
    (cons (/ n g)
          (/ d g))))

2.2

(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))

(define (make-segment start-point end-point)
  (cons start-point end-point))
(define (start-segment segment) (car segment))
(define (end-segment segment) (cdr segment))

(define (midpoint-segment segment)
  (define (average a b) (/ (+ a b) 2.0))
  (let ((start-point (start-segment segment))
        (end-point   (end-segment segment)))
    (make-point (average (x-point start-point) (x-point end-point))
                (average (y-point start-point) (y-point end-point)))))

2.3

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

2.5

(define (cons a b)
  (* (expt 2 a) (expt 3 b)))

(define (factor-count value factor)
  (define (iter remainder count)
    (if (= (modulo remainder factor) 0)
        (iter (/ remainder factor) (+ count 1))
        count))
  (iter value 0))

(define (car z) (factor-count z 2))
(define (cdr z) (factor-count z 3))

2.6

(define zero (lambda (f) (lambda (x) x)))

(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))
one =
(add-1 zero) =
(lambda (f) (lambda (x) (f ((zero f) x)))) =
(lambda (f) (lambda (x) (f ((lambda (x) x) x)))) =
(lambda (f) (lambda (x) (f x)))
(define one (lambda (f) (lambda (x) (f x))))
two = 
(add-1 one) =
(lambda (f) (lambda (x) (f ((one f) x)))) = 
(lambda (f) (lambda (x) (f ((lambda (x) (f x)) x)))) =
(lambda (f) (lambda (x) (f (f x))))
(define two (lambda (f) (lambda (x) (f (f x)))))
(define (add m n)
  (lambda (f)
    (lambda (x)
      ((m f) ; apply the m-fold composition of f to the below
        ((n f) x))))) ; apply the n-fold composition of f to x, i.e. the successor function gets applied n times to the zero

2.7

(define lower-bound car)
(define upper-bound cdr)

2.8

(define (sub-interval x y)
  (add-interval x 
               (make-interval (- (upper-bound y)) 
                              (- (lower-bound y)))))

2.9

(define (width-interval interval)
  (/ (- (upper-bound interval)
        (lower-bound interval)) 
   2))

2.10

(define (div-interval x y)
    (if (<= (* (lower-bound y) (upper-bound y)) 0)
        (error "division by interval spanning zero")
        (mul-interval x 
                    (make-interval 
                     (/ 1.0 (upper-bound y)) 
                     (/ 1.0 (lower-bound y))))))

2.17

(define (last-pair items)
  (if (null? (cdr items))
      (car items)
      (last-pair (cdr items))))

2.18

(define (reverse items)
  (define (iter items result)
    (if (null? items)
        result
        (iter (cdr items) (cons (car items) result))))
  (iter items ()))

2.20

(define (same-parity x . y)
  (define (iter items result)
    (cond ((null? items) (cons x (reverse result)))
          ((same-parity? (car items)) (iter (cdr items) (cons (car items) result)))
          (else (iter (cdr items) result))))
  (define same-parity? 
    (if (= 0 (mod x 2)) even? odd?))
  (iter y ()))

2.21

(define (square-list items)
  (if (null? items)
      ()
      (cons (* (car items) (car items)) (square-list (cdr items)))))

(define (square-list items)
  (map (lambda (x) (* x x)) items))

2.23

(define (for-each procedure items)
  (cond ((not (null? items))
          (procedure (car items))
          (for-each fn (cdr items)))))

2.27

(define (deep-reverse items)
    (define (iter items result)
        (cond ((null? items) result)
              ((list? (car items)) (iter (cdr items) (cons (deep-reverse (car items)) result)))
              (else                (iter (cdr items) (cons (car items) result)))))
    (iter items ()))

2.28

(define (fringe items)
  (define (iter items result)
    (cond ((null? items) result)
          ((list? (car items)) (iter (cdr items) (append result (fringe (car items)))))
          (else                (iter (cdr items) (append result (list (car items)))))))
  (iter items ()))

2.29

(define (left-branch mobile)
  (car mobile))

(define (right-branch mobile)
  (car (cdr mobile)))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (car (cdr branch)))

(define (total-weight mobile)
  (if (not (pair? mobile))
      mobile
      (+ (total-weight (branch-structure (left-branch mobile)))
         (total-weight (branch-structure (right-branch mobile))))))

(define (balanced? mobile)
  (define (torque branch)
    (* (branch-length branch) 
       (total-weight (branch-structure branch))))
  (if (not (pair? mobile))
      #t
      (let ((left (left-branch mobile))
            (right (right-branch mobile)))
        (and (= (torque left) (torque right))
             (balanced? (branch-structure left))
             (balanced? (branch-structure right))))))

2.30 Define a procedure square-tree analogous to the square-list procedure of Exercise 2.21.

; recursive
(define (square-tree tree factor)
  (cond ((null? tree) ())
        ((not (pair? tree)) 
         (* tree tree))
        (else
         (cons (square-tree (car tree))
               (square-tree (cdr tree))))))
; map
(define (square-tree tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree sub-tree)
             (* sub-tree sub-tree)))
       tree))

2.31 Abstract your answer to Exercise 2.30 to produce a procedure tree-map with the property that square-tree could be defined as

(define (square-tree tree) 
  (tree-map square tree))
(define (tree-map proc tree)
  (map (lambda (sub-tree)
        (if (pair? sub-tree)
            (tree-map proc sub-tree)
            (proc sub-tree)))
      tree))

2.32

(define (subsets s)
  (if (null? s)
      (list ())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (x) (cons (car s) x)) rest)))))

2.33 Complete the following definitions of some basic list-manipulation operations as accumulations:

(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) 
              () sequence))

(define (append seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length sequence)
  (accumulate (lambda (x y) (+ 1 y)) 0 sequence))

2.34

(define 
  (horner-eval x coefficient-sequence)
  (accumulate 
   (lambda (this-coeff higher-terms)
     (+ this-coeff (* x higher-terms)))
   0
   coefficient-sequence))

2.35

(define (count-leaves t)
  (accumulate + 
              0 
              (map (lambda (x) 1) (enumerate-tree t))))

2.36

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      ()
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

2.37

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(define (matrix-*-vector m v)
  (map (lambda (x) (dot-product v x)) m))

(define (transpose mat)
  (accumulate-n cons () mat))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x) (matrix-*-vector cols x)) m)))

2.39

(define (reverse sequence)
  (fold-right 
  (lambda (x y) (append y (list x))) () sequence))
(define (reverse sequence)
 (fold-left 
  (lambda (x y) (cons y x)) () sequence))

2.40

(define (unique-pairs n)
  (define (iter x y result)
    (cond ((= 0 x) result)
          ((= x y) (iter (- x 1) 1 result))
          ((> x y) (iter x (+ y 1) (cons (list x y) result)))))
  (iter n 1 ()))
(define (enumerate-interval low high)
  (if (> low high)
      ()
      (cons low 
            (enumerate-interval 
             (+ low 1) 
             high))))

(define (flatmap proc seq)
  (accumulate append () (map proc seq)))

(define (unique-pairs n)
        (flatmap
         (lambda (i)
           (map (lambda (j) 
                  (list i j))
                (enumerate-interval 
                 1 
                 (- i 1))))
         (enumerate-interval 1 n)))
(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter 
        prime-sum?
        (unique-pairs n))))

2.56

(define (exponentiation? x)
  (and (pair? x) (eq? (car x) '**)))

(define (base x) (cadr x))
(define (exponent x) (caddr x))

(define (make-exponentiation base exp)
  (cond ((=number? exp 0) 1)
        ((=number? exp 1) base)
        (else (list '** base exp))))

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((exponentiation? exp)
         (make-product
          (make-product (exponent exp)
                        (make-exponentiation (base exp)
                                             (make-sum (exponent exp) -1)))
          (deriv (base exp) var)))
        ((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 
           (deriv (multiplier exp) var)
           (multiplicand exp))))
        (else (error "unknown expression 
                      type: DERIV" exp))))

2.57

(define (augend s)
    (if (> (length s) 3)
        (cons '+ (cddr s))
        (caddr s)))

(define (multiplicand p)
    (if (> (length p) 3)
        (cons '* (cddr p))
        (caddr p)))

2.58

(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))

(define (addend s) (car s))

(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))

(define (multiplier p) (car p))
https://en.wikipedia.org/wiki/Shunting-yard_algorithm

2.59

(define (union-set set1 set2)
  (if (null? set2)
      set1
      (union-set (adjoin-set (car set2) set1) 
                 (cdr set2))))

2.60

(define (adjoin-set x set)
  (cons x set))

(define (intersection-set set1 set2)
  (append set1 set2))
               
(define (union-set set1 set2)
  (append set1 set2))

2.61

(define (adjoin-set x set)
    (define (iter x head tail)
        (cond ((null? tail) (append head (list x)))
              ((< x (car tail)) (append head (cons x tail)))
              ((= x (car tail)) (append head tail))
              (else (iter x (append head (list (car tail))) (cdr tail)))))
    (iter x '() set))
(define (adjoin-set x set)
    (cond ((null? set) (list x))
          ((< x (car set)) (cons x set))
          (else (cons (car set) (adjoin-set x (cdr set))))))

2.62

(define (union-set set1 set2)
    (cond ((null? set2) set1)
          ((null? set1) set2)
          ((< (car set2) (car set1)) (cons (car set2) (union-set set1 (cdr set2))))
          ((= (car set2) (car set1)) (cons (car set2) (union-set (cdr set1) (cdr set2))))
          (else (cons (car set1) (union-set (cdr set1) set2)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment