The blog post discusses the challenge of creating a function banker(n, k, i) that returns an n-bit binary vector representing the i^th subset of length k. The binary vector will have k 1 bits and n-k 0 bits. The author of the blog post provides a Java implementation capable of quickly generating vectors for specified positions.

I thought it would be interesting to experiment with this in Haskell. Here is what I came up with:

import Data.Foldable (foldl')

-- factorial of n
fact n = foldl' (*) 1 [1..n]

-- # of combinations of n things, taken k at a time (AKA binomial coefficient)
comb :: Integer -> Integer -> Integer
comb n k = (foldl' (*) 1 [(n-k+1)..n]) `div` fact k

-- return boolean vector for ith subset of size k from total n items
banker :: Int -> Int -> Integer -> [Int]
banker n k i = take n $ bankerR n k i [] ++ repeat 0
bankerR n k i acc = let k' = k - 1
                        (prefix, rangeLow, n') = bankpart n k' i
                        acc' = acc ++ prefix
                        i' = i - rangeLow
                    in if k' == 0
                         then acc'
                         else bankerR n' k' i' acc'

bankpart :: Int -> Int -> Integer -> ([Int], Integer, Int)
bankpart n k i = let !rangeHi = comb (fromIntegral (n-1)) (fromIntegral k)
                 in bankR1 n (n-k) 0 rangeHi [1]
  where
    bankR1 n nminusk rangeLow rangeHi acc =
      let n' = n - 1
          nminusk' = nminusk - 1
          rangeHi' = (rangeHi * (fromIntegral nminusk)) `div` (fromIntegral n)
          rangeLow' = rangeLow + rangeHi
          acc' = 0:acc
      in if i < rangeLow'
        then (acc, rangeLow, n')
        else bankR1 n' nminusk' rangeLow' rangeHi' acc'

This is a fairly straightforward implementation of the algorithm suggested on the blog post. I started to think of ways to cleanup/improve the code. Some ideas include returning a Bool vector rather than 1s and 0s, consider collapsing the double recursion into a single recursive loop, and consider adding bang patterns to force strict evaluation for possible speed improvement. I actually had bang patterns in initially (a habit I got in while solving Project Euler problems in Haskell), but took them out and didn’t notice much performance difference, although I wasn’t measuring.

Then I looked over the PDF paper again and realized the whole point to this exercise is to efficiently iterate over the subsets, finding the minimal subset that satisfies a certain criterion. I realized that implementing banker(n, k, i) (and presumably needing to wrap that in a couple loops, including one that varies k from 0..n) is not thinking about this in a good lazy functional programming way. Far better to directly provide a lazy list of all subsets, from smallest to largest, then filter this with a predicate, and then the head of the resulting list is the minimal subset we are looking for.

So here’s what I came with for this:

import Data.Maybe (listToMaybe)

-- return smallest sublist of l satisfying filter predicate
minFilterSubset :: ([a] -> Bool) -> [a] -> Int -> Maybe [a]
minFilterSubset p l minLen = listToMaybe $ filterSubsets p l minLen

-- return sub-lists of l, in increasing order of size, that satisfy predicate
filterSubsets :: ([a] -> Bool) -> [a] -> Int -> [[a]]
filterSubsets p l minLen = filter p $ subsets l minLen

-- return sub-lists of l, in increasing order of size
subsets :: [a] -> Int -> [[a]]
subsets l minLen = let maxlen = length l
                       subsetsR len = if len > maxlen
                                        then []
                                        else subsetsRR l len ++ subsetsR (len+1)
                   in subsetsR minLen
subsetsRR _ 0 = [[]]
subsetsRR [] _ = []
subsetsRR (l:ls) curlen = (map (l:) $ subsetsRR ls (curlen-1))
                              ++ subsetsRR ls curlen

No need for factorials or really any numerical manipulation. This seems to operate reasonably quickly. I initially wrote it without the minLen argument since in principle it is not necessary: the predicate can test the length. But for large values of n, if you have a good idea of non-zero lower bound on subset size, it can save a lot of time, and it seems fairly natural to include minLen as an argument.

This does not allow you to immediately jump immediately to the 160,000,000,000,000,000,000,000,000,000th subset of 12 items chosen out of 10,000. But do we really want that? Supposedly we’re looking for the minimal subset, so we’ll be iterating over these subsets, from smallest to largest, looking for the first one that satisfies some criteria. The Haskell implementation implements this directly, cleanly, and elegantly. If I get a chance, I will try to set up some test scenarios, that incorporate the actual iteration over subsets and quantify the performance of the Haskell code with the Java code.

Is any of this new or novel? I doubt it. The PDF paper and blog refers to the Banker’s sequence as though it is a best-kept secret, however the recursive algorithm seems so obvious, and reminiscent of permutation generators, that I would not be surprised to find this already implemented in some library, although maybe not referring to it as Banker’s sequence. If you know of this implemented in some Haskell library, please let me know.

Addendum 5/4/2010

I noticed back in the original blog entry and comments that Calvin Miracle actually wants the maximal subset satisfying the criteria, not the minimal. So I thought about how to accommodate that without a lot of repeated code. This seems to do the trick, and allows you to specify a minimum or maximum size to start with, depending upon which direction you are coming from. Still seems like duplicated code, could probably be factored out to use min, max, and delta, however it’s not clear that would be better. What do you think?

import Data.Maybe (listToMaybe)

-- return smallest sublist of l satisfying filter predicate
minFilterSubset :: ([a] -> Bool) -> [a] -> Int -> Maybe [a]
minFilterSubset p l minLen = listToMaybe $ filter p $ subsetsSmallToLarge l minLen

-- return largest sublist of l satisfying filter predicate
maxFilterSubset :: ([a] -> Bool) -> [a] -> Int -> Maybe [a]
maxFilterSubset p l maxLen = listToMaybe $ filter p $ subsetsLargeToSmall l maxLen

-- return sub-lists of l, in increasing order of size
subsetsSmallToLarge :: [a] -> Int -> [[a]]
subsetsSmallToLarge l minLen = concatMap (subsetsR l) [minLen..length l]

-- return sub-lists of l, in decreasing order of size, from maxLen to 0
subsetsLargeToSmall :: [a] -> Int -> [[a]]
subsetsLargeToSmall l maxLen = concatMap (subsetsR l) [maxLen, maxLen-1..0]

subsetsR _ 0 = [[]]
subsetsR [] _ = []
subsetsR (l:ls) curlen = (map (l:) $ subsetsR ls (curlen-1)) ++ subsetsR ls curlen

10
12
8
3
6
3
4
19
false
4
16
6
16

Exercise 1.2

Normally in Haskell you would express this using infix notation:

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

but it is possible to express it alternately using prefix notation:

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

Exercise 1.3

max2 a b c = let list = [a, b, c]
                 sqs = map (^ 2) list
                 minsq = (minimum list) ^ 2
             in sum sqs - minsq

Exercise 1.4

Evaluates to a plus the absolute value of b

Exercise 1.5

Applicative order evaluation would go into an infinite loop, trying to evaluate the (p) argument, which would keep evaluating to (p), never making any progress. Normal order does not need to fully evaluate the operands first, so it is fine with just leaving in (p). Eventually the if predicate evaluates to true, and it returns the consequent, 0, never needing to evaluate the (p), and so avoiding the infinite loop problem. (Instead of infinite loop, applicative order may actually blow up with a stack or memory overflow problem.) We would describe either of these as divergent, or ⊥ (“bottom”).

Exercise 1.6

The square root program written using “new-if” would never complete successfully, either entering an infinite loop, or blowing up due to exhausting stack space. This is because when it evaluates the first “new-if” it has to evaluate both operands since it is now not a special form. Evaluating the second operand, involves a call one level deeper, again involving a “new-if”, with the exact same requirement to evaluate both operands. We have infinite regress, and can never break out until we abort due to running out of some resource like stack space.

Exercise 1.7

With relatively large numbers, the arbitrary 0.001 absolute value tolerance cutoff works well, because the guess is much larger than 0.001, so getting the guess correct to within +/- 0.001 produces pretty good results. With very small numbers, however, 0.001 is considered large relative to the numbers, so it breaks down in terms of providing “pretty good” results. For example, even a guess of 0 would be considered within tolerance of x = 0.0005, but sqrt(0.0005) == 0 would arguably be a poor answer. A guess of 0.0007 would also be within tolerance of 0.0005, another poor answer.

Computers represent floating point numbers with a limited-precision mantissa and an exponent, similar to “scientific notation”, e.g. 2.3 x 10⁸. Very large numbers do not have precision down to the decimal point, much less past it. So it is quite possible to get into a situation where we reach our best guess, but the difference is considered > 0.001, and due to the limited precision the next guess doesn’t put us any closer to the answer, but perhaps we oscillate between two guess values, never breaking out because it never sees a value that it thinks is within 0.001 tolerance. Alternately, it does return a result, but one that is a lousy answer. For example, the initial good-enough? has sqrt returning about 0.0323 as sqrt of 0.0001 and about 0.03126 as sqrt of 0.000001.

Initial translation of Scheme version to Haskell:

avg a b = (a + b) / 2
sqr a = a * a

improve guess x = avg guess (x / guess)
good_enough guess x = abs ((sqr guess) - x) < 0.001

sqrt_iter guess x = if good_enough guess x
                    then guess
                    else let !guess' = improve guess x
                         in sqrt_iter guess' x
sqrt = sqrt_iter 1.0

Improved version:

avg a b = (a + b) / 2.0
sqr a = a * a

improve guess x = avg guess (x / guess)
good_enough guess prevGuess = abs ((guess - prevGuess) / guess) < 0.001

sqrt x = sqrt_iter 1.0 (-10.0)
  where
    sqrt_iter guess prevGuess = if good_enough guess prevGuess
                                then guess
                                else let !guess' = improve guess x
                                     in sqrt_iter guess' guess

This version does indeed work better on very large and small numbers.

Exercise 1.8

-- Use (x / y^2 + 2y) / 3 for successive approximation of cube root
-- Uses -10 as a dummy distant "prevGuess"
cubert x = cubertR 1.0 (-10.0)
  where cubertR guess prevGuess = if goodEnough guess prevGuess
                                  then guess
                                  else let !guess' = improve guess
                                       in cubertR guess' guess
        goodEnough guess prevGuess = abs (guess - prevGuess) / guess < 0.0001
        improve guess = ((x / guess / guess) + guess + guess) / 3.0

Exercise 1.9 (not translating these trivial examples to Clojure)

(define (+ a b)
  (if (= a 0)
    b
    (inc (+ (dec a) b))))

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

(define (+ a b)
  (if (= a 0)
    b
    (+ (dec a) (inc b))))

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

The first process is linear recursive. The second process is linear iterative.

Exercise 1.10

-- Compute Ackermann function version from SICP Exercise 1.10
-- Cannot name function A due to language restrictions
a x 0 = 0
a 0 y = 2 * y
a _ 1 = 2
a x y = a (x-1) (a x (y-1))

f = a 0
g = a 1
h = a 2

a 1 10 = 1024
a 2 4 = 65536
a 3 3 = 65536

For positive integer values of n,
f n computes 2n
g n computes 2ⁿ
h n computes 2^^n (tetration, 2 exponentiated by itself n times, e.g. 2^^4 =
2²²²

Exercise 1.11

-- compute f where f(n) = n if n < 3 and f(n-1) + 2f(n-2) + 3f(n-3) if n >= 3
-- as a recursive process and a linear process

frecur n | n < 3 = n
         | otherwise = frecur (n-1) + 2*frecur(n-2) + 3*frecur(n-3)

fiter n | n < 3 = n
        | otherwise = fiterR 3 2 1 0
  where fiterR x a b c = let !fx = a + 2*b + 3*c
                         in if x == n
                            then fx
                            else let !x' = x+1
                                 in fiterR x' fx a b

Exercise 1.12

-- Compute (row, column) element of Pascal's triangle where row & column are
-- both 1-based and assuming both are ranged correctly (i.e., no error detection here)

pascal _ 1 = 1
pascal row col | row == col = 1
               | otherwise = let !prevrow = row-1
                                 !prevcol = col-1
                             in pascal prevrow prevcol + pascal prevrow col

Exercise 1.13

Φ = (1 + √5)/2
Ψ = (1 – √5)/2

Fib(0) = 0
Fib(1) = 1
otherwise Fib(n) = Fib(n-1) + Fib(n-2)
^ all of these, by definition
Φ² = (1 + Φ)
Ψ² = (1 + Ψ)

Fib’(n) = (Φ^n – Ψ^n)/√5
Fib’(0) = (Φ^0 – Ψ^0)/√5 = (1 – 1)/√5 = 0/√5 = 0
Fib’(1) = (Φ^1 – Ψ^1)/√5 = √5/√5 = 1
So far, Fib’ is same as Fib. In order for this to hold true in general,
Fib’(n) = Fib’(n-1) + Fib’(n-2)
= (Φ^n-1 – Ψ^n-1 + Φ^n-2 – Ψ^n-2)/√5
= ((Φ + 1)*Φ^n-2 – (Ψ + 1)*Ψ^n-2)/√5
= ((Φ²)*Φ^(n-2) – (Ψ²)*Ψ^(n-2)/√5
= (Φⁿ – Ψⁿ)/√5

therefore Fib(n) = (Φⁿ – Ψⁿ)/√5 holds true in the general case.

Since this equation determines Fib(n) exactly, and |Ψⁿ| < 0.5 for all integer n > 1
then for all n > 1, Φⁿ/√5 differs from Fib(n) by less than 0.5.
Therefore, for all integer n > 1, closest integer to Φⁿ/√5 must be Fib(n).
For n = 0, Φ^n/√5 is approximately .447, and for n = 1, Φⁿ/√5 is
approximately 0.7236, so closest integers are 0 and 1, respectively, therefore for
all integer n >= 0, closest integer to Φⁿ/√5 is equal to Fib(n).

Exercise 1.14

see Clojure version for the solution to this

Exercise 1.15

cube x = x^3
p x = 3*x - 4 * cube x
sine angle | abs angle <= 0.1 = angle
           | otherwise = p $ sine (angle / 3.0)

p is executed 5 times when executing (sine 12.15)

angle is divided by 3 each iteration until it reaches 0.1 or below, so the # of iterations is equal to about logarithm base 3 of 10*angle. The code cannot use tail call optimization, so both the order of growth of space and the number of steps is θ(log a).

Exercise 1.16

-- compute b^n in a fast iterative fashion
fast_expt :: (Fractional a, Integral b) => a -> b -> a
fast_expt b n = fast_exptR 1.0 b n
  where fast_exptR a b 0 = a
        fast_exptR a b n | even n = let !b' = b*b
                                        !n' = n `div` 2
                                    in fast_exptR a b' n'
                         | otherwise = let !a' = a*b
                                           !n' = n-1
                                       in fast_exptR a' b n'

Exercise 1.17

-- compute a*b in a fast fashion

-- double/halve are theoretically our primitives, in addition to +
-- In principle they could for example be a bit shift,
-- but we just use * and / here.
double n = n*2
halve n = n `div` 2

fast_mul a 0 = 0
fast_mul a b | even b = fast_mul (double a) (halve b)
             | otherwise = a + fast_mul a (b-1)

Exercise 1.18

-- compute a*b in a fast fashion

-- double/halve are theoretically our primitives, in addition to +
-- In principle they could for example be a bit shift,
-- but we just use * and / here.
double n = n*2
halve n = n `div` 2

fast_mul a b = fast_mulR 0 a b
fast_mulR s a 0 = s
fast_mulR s a b | even b = let !a' = double a
                               !b' = halve b
                           in fast_mulR s a' b'
                | otherwise = let !s' = s+a
                                  !b' = b-1
                              in fast_mulR s' a b'

Exercise 1.19

Starting with (a0, b0), and applying Tpq once we get (qb0 + qa0 + pa0, pb0 + qa0),
or a1 = qb0 + qa0 + pa0, b1 = pb0 + qa0. Applying Tpq a second time we get (qb1 + qa1 + pa1, pb1 + qa1),
or a2 = b0(pq + qq + pq) + a0(qq + qq + pq + pq + pp), b2 = b0(pp + qq) + a0(pq + qq + pq)

We want a2 = q’b0 + q’a0 + p’a0, b2 = p’b0 + q’a0
therefore if we take p’ = pp + qq, and q’ = 2pq + qq, it works out in one transformation.

-- compute nth Fibonacci number efficiently
fib n = fibR 1 0 0 1 n
  where fibR _ b _ _ 0 = b
        fibR a b p q count | even count = let !p' = p*p + q*q
                                              !q' = 2*p*q + q*q
                                              !count' = count `div` 2
                                          in fibR a b p' q' count'
                           | otherwise = let !a' = b*q + a*q + a*p
                                             !b' = b*p + a*q
                                             !count' = count - 1
                                         in fibR a' b' p q count'

Exercise 1.20

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

Evaluating (gcd 206 40) in normal order:
(gcd
  206
  40)
(if (= 40 0)
  206
  (gcd
    40
    (remainder 206 40)))
(gcd
  40
  (remainder 206 40))
(if (= (remainder 206 40) 0)
  40
  (gcd
    (remainder 206 40)
    (remainder 40 (remainder 206 40))))
(if (= 6 0)        ; 1 remainder performed here
  40
  (gcd
    (remainder 206 40)
    (remainder 40 (remainder 206 40))))
(gcd
  (remainder 206 40)
  (remainder 40 (remainder 206 40)))
(if (= (remainder 40 (remainder 206 40)) 0)
  (remainder 206 40)
  (gcd
    (remainder 40 (remainder 206 40))
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))
(if (= (remainder 40 6) 0)    ; 1 remainder performed here
  (remainder 206 40)
  (gcd
    (remainder 40 (remainder 206 40))
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))
(if (= 4 0)                   ; 1 remainder performed here
  (remainder 206 40)
  (gcd
    (remainder 40 (remainder 206 40))
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))
(gcd
  (remainder 40 (remainder 206 40))
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
(if (= (remainder (remainder 206 40) (remainder 40 (remainder 206 40))) 0)
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= (remainder 6 (remainder 40 6)) 0)    ; 2 remainders performed here
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= (remainder 6 4) 0)                   ; 1 remainder performed here
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= 2 0)                                 ; 1 remainder performed here
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(gcd
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))) 0)
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder 
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= (remainder (remainder 40 6) (remainder 6 (remainder 40 6))) 0)       ; 3 remainders performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder 
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= (remainder 4 (remainder 6 4)) 0)                                     ; 2 remainders performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder 
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= (remainder 4 2) 0)                                                   ; 1 remainder performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder 
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= 0 0)                                                                 ; 1 remainder performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder 
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
(remainder 6 (remainder 40 6))                                              ; 2 remainders performed here
(remainder 6 4)                                                             ; 1 remainder performed here
2                                                                           ; 1 remainder performed here

Evaluating (gcd 206 40) in applicative order:
(gcd
  206
  40)
(if (= 40 0)
  206
  (gcd 40 (remainder 206 40)))
(gcd 40 (remainder 206 40)))
(gcd 40 6)                                                                  ; 1 remainder performed here
(if (= 6 0)
  40
  (gcd 6 (remainder 40 6)))
(gcd 6 (remainder 40 6))
(gcd 6 4)                                                                   ; 1 remainder performed here
(if (= 4 0)
  6
  (gcd 4 (remainder 6 4)))
(gcd 4 (remainder 6 4))
(gcd 4 2)                                                                   ; 1 remainder performed here
(if (= 2 0)
  4
  (gcd 2 (remainder 4 2)))
(gcd 2 (remainder 4 2))
(gcd 2 0)                                                                   ; 1 remainder performed here
(if (= 0 0)
  2
  (gcd 0 (remainder 2 0)))
2

Total of 18 remainders performed in normal order evaluation of (gcd 206 40)
Only 4 remainders performed in applicative order evaluation of (gcd 206 40)

Exercise 1.21

-- find smallest divisor of n
square n = n*n
divides a b = mod b a == 0

find_divisor n test_divisor | square test_divisor > n = n
                            | divides test_divisor n = test_divisor
                            | otherwise = let !test_divisor' = test_divisor+1
                                          in find_divisor n test_divisor'

smallest_divisor n = find_divisor n 2

Smallest divisors of 199, 1999, and 19999 are 199, 1999, and 7, respectively.

Exercise 1.23 and Exercise 1.24

I wrote a Haskell program using getClockTime, but it did not seem to show any elapsed time. I speculate that it updates its wall clock time during idle time, and if there is no idle time, it doesn’t get updated.

I switched to trying to use the GHC profiler, but found it uses a 20 ms. “tick”, far too coarse to measure timing of individual calls to prime, or even 3 calls to prime.

Nevertheless, I would expect the algorithms to approximately run twice as fast, with half the number of test steps, with maybe some difference due to constant factors.

Exercise 1.25

Alyssa’s suggestion to simply use fast-expt in conjunction with remainder would work in principle, however it is likely to be considerably slower than our expmod version. The reason for this is that we are using arbitrary precision integer math, hence operations on values with more digits take longer. Our expmod implementation applies remainder at each step, keeping values from growing very large, so the overall operation should take less time than waiting until the end to apply remainder once to a large value.

Exercise 1.26

By using explicit multiplication instead of square, each operand of the multiplication has to get evaluated independently. So whereas we only make one recursive call to expmod with the “square” implementation, with the multiplication implementation, we would actually make 2. The whole principle of halving the problem space has been nullified, and the θ(log n) becomes θ(n).

Exercise 1.27

square n = n*n
expmod _ 0 _ = 1
expmod base exp m | even exp = mod (square (expmod base (exp `div` 2) m)) m
                  | otherwise = mod (base * (expmod base (exp-1) m)) m

test_carmichael n = testCarmichaelR 1
  where testCarmichaelR a | a == n = True
                          | expmod a n n == mod a n = testCarmichaelR (a+1)
                          | otherwise = False

This does indeed return true for all the Carmichael numbers mentioned in footnote 47.

Exercise 1.28

import System.Random

-- squaring step in expmod, we check to see if we have discovered a ``nontrivial square root of 1 modulo n,''
-- that is, a number not equal to 1 or n - 1 whose square is equal to 1 modulo n. It is possible to prove that if
-- such a nontrivial square root of 1 exists, then n is not prime. It is also possible to prove that if n is an odd
square n = n*n
expmod _ 0 _ = 1
expmod base exp m | even exp = let !root = expmod base (exp `div` 2) m
                                   !sqr = mod (square root) m
                               in if root /= 1 && root /= (m-1) && sqr == 1
                                     then 0    -- found nontrivial root of 1
                                     else sqr
                  | otherwise = mod (base * (expmod base (exp-1) m)) m

miller_rabin_test :: Int -> IO Bool
miller_rabin_test n = do randint <- getStdRandom (randomR (1,(n-1)))
                         return $ try_it randint
                           where try_it a = expmod a n n == a

fast_prime :: Int -> Int -> IO Bool
fast_prime n 0 = return True
fast_prime n times = do mr_result <- miller_rabin_test n
                        if mr_result
                           then do let !times' = times-1
                                   fast_prime n times'
                           else return False

prime :: Int -> IO Bool
prime n = fast_prime n 4

Exercise 1.29

Computing integral via repeated samples over interval:

sumf term a next b | a > b = 0
                   | otherwise = let !a' = next a
                                 in term a + sumf term a' next b

integral_sample f a b dx = (sumf f (a + dx / 2.0) add_dx b) * dx
  where add_dx x = x+dx

-- SICP Exercise 1.29, Compute integral of f from a to b using n samples, via Simpson's Rule

-- Compute coefficient for term for evaluation
coefficient :: Integral a => a -> a -> a
coefficient 0 _ = 1
coefficient n total_n | n == total_n = 1
                      | even n = 2
                      | otherwise = 4

sum_simp :: (Fractional a, Integral b) => (a -> a) -> a -> a -> b -> a
sum_simp f a h n = sumSimpR 0 0
  where sumSimpR k acc | k > n = acc
                       | otherwise = let !k' = k+1
                                         !acc' = acc + (fromIntegral (coefficient k n)) * (f (a + (fromIntegral k)*h))
                                     in sumSimpR k' acc'

integral :: (Fractional a, Integral b) => (a -> a) -> a -> a -> b -> a
integral f a b n = let !h = (b-a) / fromIntegral n
                   in (sum_simp f a h n)*h / 3

Simpson’s Rule seems to converge to a solution very quickly for cube in the range 0 to 1.
At n = 2, it returns exactly 0.25. At n = 100 and n = 1000 it returns 0.25000000000000006.
The repeated sampling code doesn’t converge quite as well. At dx = 0.01 it returns
0.24998750000000042 and at dx = 0.001 it returns 0.249999875000001.

Exercise 1.30

-- Iterative function to sum terms from a to b
sumf term a next b = sumfR a 0
  where sumfR a result | a > b = result
                       | otherwise = let !a' = next a
                                         !result' = result + term a
                                     in sumfR a' result'

Exercise 1.31

-- Iterative function to multiply terms from a to b
productf :: (Integral a, Fractional b) => (a -> b) -> a -> (a -> a) -> a -> b
productf term a next b = productR a 1.0
  where productR a result | a > b = result
                          | otherwise = let !a' = next a
                                            !result' = result * term a
                                        in productR a' result'

pi_div_4 :: (Integral a, Fractional b) => a -> b
pi_div_4 nterms = productf piterm 0 (+1) nterms
  where piterm n | even n = (fromIntegral n + 2.0) / (fromIntegral n + 3.0)
                 | otherwise = (fromIntegral n + 3.0) / (fromIntegral n + 2.0)

part b, recursive version of productf:

-- Recursive function to multiply terms from a to b
productf term a next b | a > b = 1.0
                       | otherwise = let !a' = next a
                                     in term a * productf term a' next b

Exercise 1.32

Both sum and product iterate over a range of numbers, applying a certain operation to each number in turn, to generate a term, and then applying a binary merge operation to merge the current term into the accumulated result. For sum, the merge operation is + and for product, the merge operation is *. In each case, the accumulator must be initialized with the appropriate identity element for the operation. For sum, the identity element is 0, and for product, the identity element is 1. SICP calls this identity element the null-value or base value.

Part a, written in an iterative style

-- accumulate a collection of terms from a to b using a combiner function
accumulate combiner null_value term a next b = accumulateR null_value a
  where accumulateR acc n | n > b = acc
                          | otherwise = let !acc' = combiner acc (term n)
                                            !n' = next n
                                        in accumulateR acc' n'

sumf term a next b = accumulate (+) 0 term a next b
productf term a next b = accumulate (*) 1 term a next b

Part b, written in a recursive style

-- accumulate a collection of terms from a to b using a combiner function
accumulate combiner null_value term a next b | a > b = null_value
                                             | otherwise = let !a' = next a
                                                               !thisTerm = term a
                                                           in combiner (accumulate combiner null_value term a' next b) thisTerm

sumf term a next b = accumulate (+) 0 term a next b
productf term a next b = accumulate (*) 1 term a next b

Exercise 1.33

-- accumulate a filtered collection of terms from a to b using a combiner
filtered_accumulate combiner null_value term a next b filterp = filter_accR null_value a
  where filter_accR acc n | n > b = acc
                          | otherwise = let !curTerm = term n
                                            !n' = next n
                                        in if filterp curTerm
                                              then let !acc' = combiner acc curTerm
                                                   in filter_accR acc' n'
                                              else filter_accR acc n'

sum_prime_squares a b = filtered_accumulate combiner 0 id a (+1) b isPrime
  where combiner acc n = acc + n*n

-- compute product of all positive integers less than n that are relatively prime to n
prod_relative_primes n = filtered_accumulate (*) 1 id 1 (+1) (n-1) filterp
  where filterp i = (gcd i n) == 1
        gcd a 0 = a
        gcd a b = gcd b (mod a b)

-- find smallest divisor of n
square n = n*n
divides a b = mod b a == 0

find_divisor n test_divisor | square test_divisor > n = n
                            | divides test_divisor n = test_divisor
                            | otherwise = let !test_divisor' = test_divisor+1
                                          in find_divisor n test_divisor'

smallest_divisor n = find_divisor n 2
isPrime n = smallest_divisor n == n

Exercise 1.34

f g = g 2

Trying to evaluate f f fails because of Haskell’s strong typing. For f, it expects an argument of function that takes in integral argument. Instead we are passing it a function that takes a function argument, and it cannot coerce the value.

Exercise 1.35

Fixed point of x -> 1 + 1/x is the value x such that x = 1 + 1/x.
We are given Φ² = Φ + 1 by definition of the golden ratio. Dividing
each side by Φ we get Φ = 1 + 1/Φ, and can immediately see that
Φ serves as a fixed point for x -> 1 + 1/x.

tolerance = 0.00001
fixed_point f first_guess = try first_guess
  where try guess = let !guess' = f guess
                    in if closeEnough guess guess'
                          then guess'
                          else try guess'
        closeEnough v1 v2 = abs (v1-v2) < tolerance

*Main> fixed_point (\x -> 1.0 + 1.0/x) 1.0
1.6180327868852458

Exercise 1.36

import Debug.Trace (trace)

tolerance = 0.00001
fixed_point f first_guess = try first_guess
  where try guess = let !guess' = f (trace ("guess = " ++ show guess) guess)
                    in if closeEnough guess guess'
                          then guess'
                          else try guess'
        closeEnough v1 v2 = abs (v1-v2) < tolerance

*Main> fixed_point (\x -> log 1000 / log x) 10
guess = 10.0
guess = 2.9999999999999996
guess = 6.2877098228681545
guess = 3.7570797902002955
guess = 5.218748919675316
guess = 4.1807977460633134
guess = 4.828902657081293
guess = 4.386936895811029
guess = 4.671722808746095
guess = 4.481109436117821
guess = 4.605567315585735
guess = 4.522955348093164
guess = 4.577201597629606
guess = 4.541325786357399
guess = 4.564940905198754
guess = 4.549347961475409
guess = 4.5596228442307565
guess = 4.552843114094703
guess = 4.55731263660315
guess = 4.554364381825887
guess = 4.556308401465587
guess = 4.555026226620339
guess = 4.55587174038325
guess = 4.555314115211184
guess = 4.555681847896976
guess = 4.555439330395129
guess = 4.555599264136406
guess = 4.555493789937456
guess = 4.555563347820309
guess = 4.555517475527901
guess = 4.555547727376273
guess = 4.555527776815261
guess = 4.555540933824255
4.555532257016376
*Main> 

Now, with average damping:

*Main> fixed_point (\x -> (x + (log 1000 / log x)) / 2) 10
guess = 10.0
guess = 6.5
guess = 5.095215099176933
guess = 4.668760681281611
guess = 4.57585730576714
guess = 4.559030116711325
guess = 4.55613168520593
guess = 4.555637206157649
guess = 4.55555298754564
guess = 4.555538647701617
4.555536206185039
*Main>

It only took 11 steps with average damping, versus 34 steps without damping.

Exercise 1.37

Recursive version

-- Evaluate continued fraction based upon n and d which return terms for
-- the numerator and denominator, and k is number of terms (indexed by 1).
cont_frac n d k = contR 1
  where contR i | i == k = (n i) / (d i)
                | otherwise = (n i) / ((d i) + contR (i+1))

It takes k of 10 to approximate golden ratio to 4 decimal digits:

*Main> cont_frac (const 1.0) (const 1.0) 10
0.6179775280898876

Iterative version:

-- Evaluate continued fraction based upon n and d which return terms for
-- the numerator and denominator, and k is number of terms (indexed by 1).
-- this version uses an iterative process
cont_frac n d k = cont_fracR k 0
  where cont_fracR 0 acc = acc
        cont_fracR i acc = let !i' = i-1
                               !acc' = (n i) / ((d i) + acc)
                           in cont_fracR i' acc'

Exercise 1.38

-- compute e via Euler's continued fraction, using k steps
-- all Ni = 1, Di = 1,2,1,1,4,1,1,6,1,1,8,...
compute_e :: (Integral a, Fractional b) => a -> b
compute_e k = 2.0 + cont_frac (const 1.0) d k
  where d i | i `mod` 3 == 2 = fromIntegral (i + i + 2) / 3.0
            | otherwise = 1.0

-- Evaluate continued fraction based upon n and d which return terms for
-- the numerator and denominator, and k is number of terms (indexed by 1).
-- this version uses an iterative process
cont_frac :: (Integral a, Fractional b) => (a -> b) -> (a -> b) -> a -> b
cont_frac n d k = cont_fracR k 0.0
  where cont_fracR 0 acc = acc
        cont_fracR i acc = let !i' = i-1
                               !acc' = (n i) / ((d i) + acc)
                           in cont_fracR i' acc'

Exercise 1.39

-- compute tangent function via Lambert's continued fraction
-- N1 = r; all other Ni = -r^2;  Di = 2i-1;  x is angle in radians; k is # steps
tan_cf :: (Integral a, Fractional b) => b -> a -> b
tan_cf x k = let mxx = -x * x
                 n 1 = x
                 n _ = mxx
             in cont_frac n (\i -> 2.0 * fromIntegral i - 1.0) k

-- Evaluate continued fraction based upon n and d which return terms for
-- the numerator and denominator, and k is number of terms (indexed by 1).
-- this version uses an iterative process
cont_frac :: (Integral a, Fractional b) => (a -> b) -> (a -> b) -> a -> b
cont_frac n d k = cont_fracR k 0.0
  where cont_fracR 0 acc = acc
        cont_fracR i acc = let !i' = i-1
                               !acc' = (n i) / ((d i) + acc)
                           in cont_fracR i' acc'

Exercise 1.40

-- return function that computes f(x) -> x^3 + ax^2 + bx + c"
cubic a b c x = x^3 + a*x^2 + b*x + c

Exercise 1.41

-- takes 1-arg procedure and returns procedure that applies original twice
double f = f . f

((double (double double)) (+ 1)) 5 equals 21

Exercise 1.42

-- compose f after g: create function that takes x and returns f(g(x))
compose = (.)

Exercise 1.43

-- nth repeated application of f
repeated f n = (\x -> if n == 0
                         then x
                         else (f . (repeated f (n-1))) x)

Exercise 1.44

-- nth repeated application of f
repeated f n = (\x -> if n == 0
                         then x
                         else (f . (repeated f (n-1))) x)

-- create smoothed version that averages f(x) with f(x-dx) and f(x+dx)
dx = 0.0001
smooth f x = (f (x-dx) + f x + f (x+dx)) / 3

-- create the n-fold smoothed function based upon f
smooth_repeated f n = (repeated smooth n) f

Exercise 1.45

Experimentation when I was working the exercise in Clojure with fixed-point instrumented with debugging println empirically shows that the number of applications of average damping required for the nth root calculation increases by 1 each time n reaches another power of 2. For n = 2, 1 application required, but for n = 32, 5 applications are required. For n = 31, 4 applications required. So a should be equal to the floor of log-base-2 of n.

This leads to the following code in Haskell:

-- return a modified version of function that averages its value with its arg
average_damp :: Fractional a => (a -> a) -> a -> a
average_damp f x = (x + f x) / 2.0

tolerance = 0.00001
fixed_point f first_guess = try first_guess
  where try guess = let !guess' = f guess
                    in if closeEnough guess guess'
                          then guess'
                          else try guess'
        closeEnough v1 v2 = abs (v1-v2) < tolerance

-- nth repeated application of f
repeated :: (Integral b) => (a -> a) -> b -> (a -> a)
repeated f n = (\x -> if n == 0
                         then x
                         else (f . (repeated f (n-1))) x)

-- return floor of log base 2 of n for positive n
floor_log2 n = floor_log2R 0 2
  where floor_log2R l ll | ll > n = n
                         | otherwise = let !l' = l+1
                                           !ll' = 2*ll
                                       in floor_log2R l' ll'

-- find nth root of x using repeated applications of average damping
nthroot n x = fixed_point ((repeated average_damp (floor_log2 n)) (\y -> x / y^(n-1))) 2.0

Exercise 1.46

tolerance=0.00001

-- perform iterative improvements of guess until it's good enough
iterative_improve goodEnough improve initialGuess = iterR initialGuess (improve initialGuess)
  where iterR prevGuess newGuess | goodEnough newGuess prevGuess = newGuess
                                 | otherwise = let !newGuess' = improve newGuess
                                               in iterR newGuess newGuess'

-- return true when successive guesses are within one hundredth of one percent of each other
goodEnough guess prevGuess = abs ((guess - prevGuess) / guess) < 0.0001

-- calculate square root of x via iterative improvement
sqrt x = (iterative_improve goodEnough improveSqrt) 1.0
  where improveSqrt guess = (guess + x/guess) / 2.0

-- implement fixed-point using iterative improvement
fixed_point f firstGuess = (iterative_improve goodEnough (\x -> f x)) firstGuess

10
12
8
3
6
#’user/a {using def instead of define}
#’user/b
19
false
4
16 {different syntax for Clojure: (cond (= a 4) 6 (= b 4) (+ 6 7 a) true 25)}
6
16 {different syntax, as above: (* (cond (> a b) a (< a b) b true -1) (+ a 1)) }

Exercise 1.2

(assuming fraction is correctly read as 4/5)

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

Exercise 1.3

(defn sum-squares [a b] (+ (* a a) (* b b)))
(defn sum-max2-squares [a b c]
  (cond (> a b) (if (> b c)
                    (sum-squares a b)
                    (sum-squares a c))
        (< a b) (if (> a c)
                    (sum-squares b a)
                    (sum-squares b c))
        :else   (if (> a c)
                    (sum-squares a b)
                    (sum-squares a c))))

Exercise 1.4

Evaluates to a plus the absolute value of b

Exercise 1.5

Applicative order evaluation would go into an infinite loop, trying to evaluate the (p) argument, which would keep evaluating to (p), never making any progress. Normal order does not need to fully evaluate the operands first, so it is fine with just leaving in (p). Eventually the if predicate evaluates to true, and it returns the consequent, 0, never needing to evaluate the (p), and so avoiding the infinite loop problem. (Instead of infinite loop, applicative order may actually blow up with a stack or memory overflow problem.)

Exercise 1.6

The square root program written using “new-if” would never complete successfully, either entering an infinite loop, or blowing up due to exhausting stack space. This is because when it evaluates the first “new-if” it has to evaluate both operands since it is now not a special form. Evaluating the second operand, involves a call one level deeper, again involving a “new-if”, with the exact same requirement to evaluate both operands. We have infinite regress, and can never break out until we abort due to running out of some resource like stack space.

Exercise 1.7

With relatively large numbers, the arbitrary 0.001 absolute value tolerance cutoff works well, because the guess is much larger than 0.001, so getting the guess correct to within +/- 0.001 produces pretty good results. With very small numbers, however, 0.001 is considered large relative to the numbers, so it breaks down in terms of providing “pretty good” results. For example, even a guess of 0 would be considered within tolerance of x = 0.0005, but sqrt(0.0005) == 0 would arguably be a poor answer. A guess of 0.0007 would also be within tolerance of 0.0005, another poor answer.

Computers represent floating point numbers with a limited-precision mantissa and an exponent, similar to “scientific notation”, e.g. 2.3 x 10^8. Very large numbers do not have precision down to the decimal point, much less past it. So it is quite possible to get into a situation where we reach our best guess, but the difference is considered > 0.001, and due to the limited precision the next guess doesn’t put us any closer to the answer, but perhaps we oscillate between two guess values, never breaking out because it never sees a value that it thinks is within 0.001 tolerance. Alternately, it does return a result, but one that is a lousy answer. For example, the initial good-enough? has sqrt returning about 0.0323 as sqrt of 0.0001 and about 0.03126 as sqrt of 0.000001.

Code showing previous linear iterative Clojure version and new version (with suffix 2 on functions.) Ad hoc testing shows that it does indeed work much better for very large and very small numbers.

(defn average [a b] (/ (+ a b) 2))
(defn square [x] (* x x))
(defn abs [x] (if (< x 0) (- x) x))

(defn improve [guess x]
  (average guess (/ x guess)))

(defn good-enough?
  [guess x]
  (< (abs (- (square guess) x)) 0.001))
(defn good-enough2?
  [guess prevGuess]
  (< (/ (abs (- guess prevGuess)) guess) 0.0001))

(def sqrt-iter
  (fn [guess x]
    (loop [guess guess x x]
      (if (good-enough? guess x)
        guess
        (recur (improve guess x) x)))))

(def sqrt-iter2
  (fn [guess x]
    (loop [guess guess prevGuess -10]
      (if (good-enough2? guess prevGuess)
        guess
        (recur (improve guess x) guess)))))

(defn sqrt [x] (sqrt-iter2 1.0 x))

Exercise 1.8

; Use (x / y^2 + 2y) / 3 for successive approximation of cube root

(defn abs [x] (if (< x 0) (- x) x))

(defn improve [guess x]
  (/ (+ (/ x guess guess) guess guess) 3.0))

(defn good-enough? [guess prevGuess] (< (/ (abs (- guess prevGuess)) guess) 0.0001))

(def cubert-iter
  (fn [guess x]
    (loop [guess guess prevGuess -10]
      (if (good-enough? guess prevGuess)
        guess
        (recur (improve guess x) guess)))))

(defn cubert [x] (cubert-iter 1.0 x))

Exercise 1.9

(not translating these trivial examples to Clojure)

(define (+ a b)
  (if (= a 0)
    b
    (inc (+ (dec a) b))))

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

(define (+ a b)
  (if (= a 0)
    b
    (+ (dec a) (inc b))))

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

The first process is linear recursive. The second process is linear iterative.

Exercise 1.10 Ackermann’s function

(defn A [x y]
  (cond (= y 0) 0
        (= x 0) (* 2 y)
        (= y 1) 2
        :else (A (- x 1)
                 (A x (- y 1)))))

(A 1 10) = 1024
(A 2 4) = 65536
(A 3 3) = 65536

(define (f n) (A 0 n))
(define (g n) (A 1 n))
(define (h n) (A 2 n))

For positive integer values of n,
(f n) computes 2n
(g n) computes 2^n
(h n) computes 2^^n (tetration, 2 exponentiated by itself n times, e.g. 2^^4 = 2^(2^(2^2))

Exercise 1.11

; compute f where f(n) = n if n = 3
; as a recursive process and a linear process

(defn frecur [n]
  (if (< n 3) n
              (+ (frecur (- n 1)) (* 2 (frecur (- n 2))) (* 3 (frecur (- n 3))))))

; a, b, c track f(x-1), f(x-2), and f(x-3) respectively
(defn fiter [n]
  (if (< n 3) n
              (loop [x 3 a 2 b 1 c 0]
                (let [fx (+ a b b c c c)]
                  (if (= x n) fx
                              (recur (inc x) fx a b))))))

Exercise 1.12

; Compute (row, column) element of Pascal's triangle where row & column are
; both 1-based and assuming both are ranged correctly (i.e., no error detection here)

(defn pascal [row col]
  (cond (= col 1) 1
        (= col row) 1
        :else (let [prevrow (dec row)]
                (+ (pascal prevrow (dec col)) (pascal prevrow col)))))

Exercise 1.13

Φ = (1 + √5)/2
Ψ = (1 – √5))/2

Fib(0) = 0
Fib(1) = 1
otherwise Fib(n) = Fib(n-1) + Fib(n-2)
^ all of these, by definition
Φ² = (1 + Φ)
Ψ² = (1 + Ψ)

Fib’(n) = (Φⁿ – Ψⁿ)/√5
Fib’(0) = (Φ⁰ – Ψ⁰)/√5 = (1 – 1)/√5 = 0/√5 = 0
Fib’(1) = (Φ¹ – Ψ¹)/√5 = √5/√5 = 1
So far, Fib’ is same as Fib. In order for this to hold true in general,
Fib’(n) = Fib’(n-1) + Fib’(n-2)
= (Φ^(n-1) – Ψ^(n-1) + Φ^(n-2) – Ψ^(n-2))/√5
= ((Φ + 1) * Φ^(n-2) – (Ψ + 1) * Ψ^(n-2))/√5
= ((Φ²) * Φ^(n-2) – (Ψ²) * Ψ^(n-2))/√5
= (Φⁿ – Ψⁿ)/√5

therefore Fib(n) = (Φⁿ – Ψⁿ)/√5 holds true in the general case.

Since this equation determines Fib(n) exactly, and |Ψⁿ| < 0.5 for all integer n > 1
then for all n > 1, Φⁿ/√5 differs from Fib(n) by less than 0.5. Therefore, for all integer n > 1, closest integer to Φⁿ/√5 must be Fib(n). For n = 0, Φⁿ/√5 is approximately .447, and for n = 1, Φⁿ/√5 is approximately 0.7236, so closest integers are 0 and 1, respectively, therefore for all integer n >= 0, closest integer to Φⁿ/√5 is equal to Fib(n).

Exercise 1.14

(count-change 11)
     |
(cc 11 5) -- (cc -39 5) -- 0
     |
(cc 11 4) -- (cc -14 4) -- 0
     |
(cc 11 3) ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- (cc 1 3) -- (cc -1 3) -- 0
     |                                                                                                                                                                                                                                                                                      |
(cc 11 2) ------------------------------------------------------------------------------------------------------------------------------------------- (cc 6 2) ----------------------------------------------------------------------------- (cc 1 2) -- (cc -4 2) -- 0                 (cc 1 2) -- (cc -4 2) -- 0
     |                                                                                                                                                    |                                                                                      |                                          |
(cc 11 1) -- (cc 10 1) -- (cc 9 1) -- (cc 8 1) -- (cc 7 1) -- (cc 6 1) -- (cc 5 1) -- (cc 4 1) -- (cc 3 1) -- (cc 2 1) -- (cc 1 1) -- (cc 0 1) -- 1   (cc 6 1) -- (cc 5 1) -- (cc 4 1) -- (cc 3 1) -- (cc 2 1) -- (cc 1 1) -- (cc 0 1) -- 1  (cc 1 1) -- (cc 0 1) -- 1                  (cc 1 1) -- (cc 0 1) -- 1
     |           |            |           |           |           |           |           |           |           |           |                           |           |           |           |           |           |                          |                                          |
(cc 11 0)    (cc 10 0)    (cc 9 0)    (cc 8 0)    (cc 7 0)    (cc 6 0)    (cc 5 0)    (cc 4 0)    (cc 3 0)    (cc 2 0)    (cc 1 0)                    (cc 6 0)    (cc 5 0)    (cc 4 0)    (cc 3 0)    (cc 2 0)    (cc 1 0)                   (cc 1 0)                                   (cc 1 0)
     |           |            |           |           |           |           |           |           |           |           |                           |           |           |           |           |           |                          |                                          |
     0           0            0           0           0           0           0           0           0           0           0                           0           0           0           0           0           0                          0                                          0

I reckon the tree size (# steps) to be theta(n^2) and maximum depth (space) theta(n).

Exercise 1.15

p is executed 5 times when executing (sine 12.15)

Angle is divided by 3 each iteration until it reaches 0.1 or below, so the # of iterations is equal to about logarithm base 3 of 10*angle. The code cannot use tail call optimization, so both the order of growth of space and the number of steps is theta(log a).

Exercise 1.16

; compute b^n in a fast iterative fashion
(defn fast-expt [b n]
  (loop [a 1 b b n n]
    (cond (= n 0) a
          (even? n) (recur a (* b b) (/ n 2))
          :else (recur (* a b) b (- n 1)))))

Exercise 1.17

; compute a*b in a fast fashion
; doubl/halve are theoretically our primitives, in addition to (+)
; In principle they could for example be a bit shift,but we just use * and / here.
; Spelled doubl since double is reserved.
(defn doubl [n] (* n 2))
(defn halve [n] (/ n 2))

(defn fast-mul [a b]
  (cond (= b 0) 0
        (even? b) (fast-mul (doubl a) (halve b))
        :else (+ a (fast-mul a (- b 1)))))

Exercise 1.18

; compute a*b in a fast iterative fashion
; doubl/halve are theoretically our primitives, in addition to (+)
; In principle they could for example be a bit shift,
; but we just use * and / here. Spelled doubl since double is reserved.
(defn doubl [n] (* n 2))
(defn halve [n] (/ n 2))

(defn fast-mul [a b]
  (loop [s 0 a a b b]
    (cond (= b 0) s
          (even? b) (recur s (doubl a) (halve b))
          :else (recur (+ s a) a (- b 1)))))

Exercise 1.19

Starting with (a0, b0), and applying Tpq once we get (qb0 + qa0 + pa0, pb0 + qa0), or a1 = qb0 + qa0 + pa0, b1 = pb0 + qa0. Applying Tpq a second time we get (qb1 + qa1 + pa1, pb1 + qa1), or a2 = b0(pq + qq + pq) + a0(qq + qq + pq + pq + pp), b2 = b0(pp + qq) + a0(pq + qq + pq)

We want a2 = q’b0 + q’a0 + p’a0, b2 = p’b0 + q’a0 therefore if we take p’ = pp + qq, and q’ = 2pq + qq, it works out in one transformation.

; compute nth Fibonacci number efficiently
(defn fib-iter [a b p q count]
  (loop [a a b b p p q q count count]
    (cond (= count 0) b
          (even? count)
            (recur a
                   b
                   (+ (* p p) (* q q))    ; compute p'
                   (+ (* 2 p q) (* q q))  ; compute q'
                   (/ count 2))
          :else (recur (+ (* b q) (* a q) (* a p))
                       (+ (* b p) (* a q))
                       p
                       q
                       (- count 1)))))

(defn fib [n]
  (fib-iter 1 0 0 1 n))

Exercise 1.20

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

Evaluating (gcd 206 40) in normal order:

(gcd
  206
  40)
(if (= 40 0)
  206
  (gcd
    40
    (remainder 206 40)))
(gcd
  40
  (remainder 206 40))
(if (= (remainder 206 40) 0)
  40
  (gcd
    (remainder 206 40)
    (remainder 40 (remainder 206 40))))
(if (= 6 0)        ; 1 remainder performed here
  40
  (gcd
    (remainder 206 40)
    (remainder 40 (remainder 206 40))))
(gcd
  (remainder 206 40)
  (remainder 40 (remainder 206 40)))
(if (= (remainder 40 (remainder 206 40)) 0)
  (remainder 206 40)
  (gcd
    (remainder 40 (remainder 206 40))
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))
(if (= (remainder 40 6) 0)    ; 1 remainder performed here
  (remainder 206 40)
  (gcd
    (remainder 40 (remainder 206 40))
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))
(if (= 4 0)                   ; 1 remainder performed here
  (remainder 206 40)
  (gcd
    (remainder 40 (remainder 206 40))
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))
(gcd
  (remainder 40 (remainder 206 40))
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
(if (= (remainder (remainder 206 40) (remainder 40 (remainder 206 40))) 0)
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= (remainder 6 (remainder 40 6)) 0)    ; 2 remainders performed here
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= (remainder 6 4) 0)                   ; 1 remainder performed here
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= 2 0)                                 ; 1 remainder performed here
  (remainder 40 (remainder 206 40))
  (gcd
    (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(gcd
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
(if (= (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))) 0)
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= (remainder (remainder 40 6) (remainder 6 (remainder 40 6))) 0)       ; 3 remainders performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= (remainder 4 (remainder 6 4)) 0)                                     ; 2 remainders performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= (remainder 4 2) 0)                                                   ; 1 remainder performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(if (= 0 0)                                                                 ; 1 remainder performed here
  (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
  (gcd
    (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
    (remainder
      (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
      (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))))
(remainder (remainder 206 40) (remainder 40 (remainder 206 40)))
(remainder 6 (remainder 40 6))                                              ; 2 remainders performed here
(remainder 6 4)                                                             ; 1 remainder performed here
2                                                                           ; 1 remainder performed here

Evaluating (gcd 206 40) in applicative order:

(gcd
  206
  40)
(if (= 40 0)
  206
  (gcd 40 (remainder 206 40)))
(gcd 40 (remainder 206 40)))
(gcd 40 6)                                                                  ; 1 remainder performed here
(if (= 6 0)
  40
  (gcd 6 (remainder 40 6)))
(gcd 6 (remainder 40 6))
(gcd 6 4)                                                                   ; 1 remainder performed here
(if (= 4 0)
  6
  (gcd 4 (remainder 6 4)))
(gcd 4 (remainder 6 4))
(gcd 4 2)                                                                   ; 1 remainder performed here
(if (= 2 0)
  4
  (gcd 2 (remainder 4 2)))
(gcd 2 (remainder 4 2))
(gcd 2 0)                                                                   ; 1 remainder performed here
(if (= 0 0)
  2
  (gcd 0 (remainder 2 0)))
2

Total of 18 remainders performed in normal order evaluation of (gcd 206 40)
Only 4 remainders performed in applicative order evaluation of (gcd 206 40)

Exercise 1.21

; find smallest divisor of n
(defn remainder [a b] (mod a b))
(defn square [n] (* n n))
(defn divides? [a b]
  (= (remainder b a) 0))
(defn find-divisor [n test-divisor]
  (loop [n n test-divisor test-divisor]
    (cond (> (square test-divisor) n) n
          (divides? test-divisor n) test-divisor
          :else (recur n (+ test-divisor 1)))))
(defn find-divisor [n test-divisor]
  (cond (> (square test-divisor) n) n
        (divides? test-divisor n) test-divisor
        :else (find-divisor n (+ test-divisor 1))))
(defn smallest-divisor [n]
  (find-divisor n 2))

Smallest divisors of 199, 1999, and 19999 are 199, 1999, and 7, respectively.

Exercise 1.22

; find smallest divisor of n
(defn remainder [a b] (mod a b))
(defn square [n] (* n n))
(defn divides? [a b]
  (= (remainder b a) 0))
(defn find-divisor [n test-divisor]
  (loop [n n test-divisor test-divisor]
    (cond (> (square test-divisor) n) n
          (divides? test-divisor n) test-divisor
          :else (recur n (+ test-divisor 1)))))
(defn smallest-divisor [n]
  (find-divisor n 2))

(defn prime? [n]
  (= n (smallest-divisor n)))

(defn report-prime [elapsed-time]
  (print " *** ")
  (print elapsed-time))
(defn start-prime-test [n start-time]
  (if (prime? n)
      (report-prime (- (System/currentTimeMillis) start-time))))

(defn timed-prime-test [n]
  (newline)
  (print n)
  (start-prime-test n (System/currentTimeMillis)))

(defn search-for-primes [min]
  (loop [n min remaining 3]
    (cond (= remaining 0) (newline)
          (prime? n)
            (do
              (timed-prime-test n)
              (recur (+ 2 n) (- remaining 1)))
          :else (recur (+ 2 n) remaining))))

Timing tests frustrated by multiple factors including millisecond granularity (quite rough compared to current processor speeds.) So couldn’t get reliable timing numbers from primes around 1,000. Around 1,000,000, it took about 1 ms, and at 10,000,000, it took about 2-3 ms, and at 100,000,000 it took about 7-9 ms, and at 1,000,000,000 it took about 25-26 ms. We would expect order sqrt(n) timing, so each factor of 10 increase in n should cause a factor of sqrt(10) or about 3.2 increase in runtime. Our timing measurements seem to confirm that the timing numbers are approximately proportional to the number of steps taken.

Exercise 1.23

; cannot use name next because it is reserved
(defn next-divisor
  "return next divisor value to test for find-divisor"
  [n]
  (if (= n 2) 3 (+ n 2)))

; find smallest divisor of n
(defn remainder [a b] (mod a b))
(defn square [n] (* n n))
(defn divides? [a b]
  (= (remainder b a) 0))
(defn find-divisor [n test-divisor]
  (loop [n n test-divisor test-divisor]
    (cond (> (square test-divisor) n) n
          (divides? test-divisor n) test-divisor
          :else (recur n (+ test-divisor 1)))))
(defn smallest-divisor [n]
  (find-divisor n 2))

(defn prime? [n]
  (= n (smallest-divisor n)))

(defn report-prime [elapsed-time]
  (print " *** ")
  (print elapsed-time))
(defn start-prime-test [n start-time]
  (if (prime? n)
      (report-prime (- (System/currentTimeMillis) start-time))))

(defn timed-prime-test [n]
  (newline)
  (print n)
  (start-prime-test n (System/currentTimeMillis)))

(defn search-for-primes [min]
  (loop [n min remaining 3]
    (cond (= remaining 0) (newline)
          (prime? n)
            (do
              (timed-prime-test n)
              (recur (+ 2 n) (- remaining 1)))
          :else (recur (+ 2 n) remaining))))

At around 10,000,000 this test takes about 1-2 ms., and at 100,000,000 the test takes about 4-5 ms. and at around 1,000,000,000 it takes around 14-16 ms. In principle we expect a 2x speedup, however we do not quite realize a full 2x speedup because part of the savings in fewer iterations of find-divisor are offset by the overhead of calling next-divisor.

Exercise 1.24

(defn expmod [base exp m]
   (cond (= exp 0) 1
         (even? exp)
           (remainder (square (expmod base (/ exp 2) m))
                      m)
         :else (remainder (* base (expmod base (- exp 1) m))
                          m)))

(defn fermat-test [n]
  (defn try-it [a]
    (= (expmod a n n) a))
  (try-it (+ 1 (rand-int (- n 1)))))
(defn fast-prime? [n times]
  (loop [n n times times]
    (cond (= times 0) true
          (fermat-test n) (recur n (- times 1))
          :else false)))

(defn prime? [n] (fast-prime? n 4))

(defn report-prime [elapsed-time]
  (print " *** ")
  (print elapsed-time))
(defn start-prime-test [n start-time]
  (if (prime? n)
      (report-prime (- (System/currentTimeMillis) start-time))))

(defn timed-prime-test [n]
  (newline)
  (print n)
  (start-prime-test n (System/currentTimeMillis)))

(defn search-for-primes [min]
  (loop [n min remaining 3]
    (cond (= remaining 0) (newline)
          (prime? n)
            (do
              (timed-prime-test n)
              (recur (+ 2 n) (- remaining 1)))
          :else (recur (+ 2 n) remaining))))

Times on the 1.24 version are barely measureable, even only measuring a ms. or so around 10,000,000,000 and even when the number gets 2 or 3 orders of magnitude higher. For this reason, it is difficult to confirm the actual log n growth, however it is clear that the runtime is much better than the prev. ones, and the growth pattern seems equally so, so it is reasonable to assume that we have approximate log n growth rate.

Exercise 1.25

Alyssa’s suggestion to simply use fast-expt in conjunction with remainder would work in principle, however it is likely to be considerably slower than our expmod version. The reason for this is that we are using arbitrary precision integer math, hence operations on values with more digits take longer. Our expmod implementation applies remainder at each step, keeping values from growing very large, so the overall operation should take less time than waiting until the end to apply remainder once to a large value.

Exercise 1.26

By using explicit multiplication instead of square, each operand of the multiplication has to get evaluated independently. So whereas we only make one recursive call to expmod with the “square” implementation, with the multiplication implementation, we would actually make 2. The whole principle of halving the problem space has been nullified, and the theta(log n) becomes theta(n).

Exercise 1.27

(defn expmod [base exp m]
   (cond (= exp 0) 1
         (even? exp)
           (remainder (square (expmod base (/ exp 2) m))
                      m)
         :else (remainder (* base (expmod base (- exp 1) m))
                          m)))

(defn test-carmichael [n]
  (loop [a 1]
    (cond (= n a) true
          (= (expmod a n n) (remainder a n)) (recur (+ 1 a))
          :else false)))

This does indeed return true for all the Carmichael numbers mentioned in footnote 47.

Exercise 1.28

; squaring step in expmod, we check to see if we have discovered a ``nontrivial square root of 1 modulo n,''
; that is, a number not equal to 1 or n - 1 whose square is equal to 1 modulo n. It is possible to prove that if
; such a nontrivial square root of 1 exists, then n is not prime. It is also possible to prove that if n is an odd
(defn expmod [base exp m]
   (cond (= exp 0) 1
         (even? exp)
           (let [root (expmod base (/ exp 2) m) sqr (remainder (square root) m)]
             (if (and (not= root 1) (not= root (- m 1)) (= sqr 1))
               0        ; signal that found nontrivial square root of 1
               sqr))
         :else (remainder (* base (expmod base (- exp 1) m))
                          m)))

(defn fermat-test [n]
  (defn try-it [a]
    (= (expmod a n n) a))
  (try-it (+ 1 (rand-int (- n 1)))))
(defn fast-prime? [n times]
  (loop [n n times times]
    (cond (= times 0) true
          (fermat-test n) (recur n (- times 1))
          :else false)))

(defn prime? [n] (fast-prime? n 4))

(defn report-prime [elapsed-time]
  (print " *** ")
  (print elapsed-time))
(defn start-prime-test [n start-time]
  (if (prime? n)
      (report-prime (- (System/currentTimeMillis) start-time))))

(defn timed-prime-test [n]
  (newline)
  (print n)
  (start-prime-test n (System/currentTimeMillis)))

(defn search-for-primes [min]
  (loop [n min remaining 3]
    (cond (= remaining 0) (newline)
          (prime? n)
            (do
              (timed-prime-test n)
              (recur (+ 2 n) (- remaining 1)))
          :else (recur (+ 2 n) remaining))))

Exercise 1.29

(defn coefficient
  "Compute coefficient for term for evaluation via Simpson's Rule"
  [n total-n]
  (cond (= 0 n) 1
        (= total-n n) 1
        (even? n) 2
        :else 4))

(defn sum-simp [f a h n]
  (loop [k 0 acc 0]
    (if (> k n)
      acc
      (recur (inc k) (+ acc (* (coefficient k n) (f (+ a (* k h)))))))))

(defn integral
  "Compute integral of f from a to b using n samples, via Simpson's Rule"
  [f a b n]
  (let [h (/ (- b a) n)]
    (/ (* h (sum-simp f a h n)) 3)))

This implementation uses rational rather than floating point math.
For computing integral of cube from 0 to 1, it computes exactly 1/4 for any
even n > 0, including 100 and 1000.

From the way the exercise is worded, perhaps the authors expected the
implementation to use floating point, but it seems silly to rewrite it to
make it less precise.

Exercise 1.30

(defn sum
  "Iterative function to sum terms from a to b"
  [term a next b]
  (loop [a a result 0]
    (if (> a b)
        result
        (recur (next a) (+ result (term a))))))

Exercise 1.31

Implemented using floating point this time.

(defn product
  "Iterative function to multiply terms from a to b"
  [term a next b]
  (loop [a a result 1.0]
    (if (> a b)
        result
        (recur (next a) (* result (term a))))))

(defn pi-div-4 [nterms]
  (defn piterm [n]
    (if (even? n)
        (/ (+ n 2) (+ n 3))
        (/ (+ n 3) (+ n 2))))
  (product piterm 0 inc nterms))

part b)

(defn product
  "Recursive function to multiply terms from a to b"
  [term a next b]
  (if (> a b)
      1.0
      (* (term a) (product term (next a) next b))))

Exercise 1.32

Both sum and product iterate over a range of numbers, applying a certain operation to each number in turn, to generate a term, and then applying a binary merge operation to merge the current term into the accumulated result. For sum, the merge operation is + and for product, the merge operation is *. In each case, the accumulator must be initialized with the appropriate identity element for the operation. For sum, the identity element is 0, and for product, the identity element is 1. SICP calls this identity element the null-value or base value.

(defn accumulate
  "accumulate a collection of terms from a to b using a combiner function"
  [combiner null-value term a next b]
  (loop [acc null-value n a]
    (if (> n b)
        acc
        (recur (combiner acc (term n)) (next n)))))

(defn sum [term a next b]
  (accumulate + 0 term a next b))

(defn product [term a next b]
  (accumulate * 1 term a next b))

part b) implement accumulator as a recursive procedure

(defn accumulate
  "accumulate a collection of terms from a to b using a combiner function"
  [combiner null-value term a next b]
  (if (> a b)
      null-value
      (combiner (accumulate combiner null-value term (next a) next b) (term a))))

Exercise 1.33

(defn filtered-accumulate
  "accumulate a filtered collection of terms from a to b using a combiner"
  [combiner null-value term a next b filterp]
  (loop [acc null-value n a]
    (if (> n b)
      acc
      (let [cur-term (term n) next-n (next n)]
        (if (filterp cur-term)
            (recur (combiner acc cur-term) next-n)
            (recur acc next-n))))))

(defn sum-prime-squares [a b]
  (defn square [n] (* n n))
  (defn id [n] n)
  (defn combiner [acc n] (+ acc (* n n)))
  (filtered-accumulate combiner 0 id a inc b prime?))

(defn prod-relative-primes
  "compute product of all positive integers less than n that are relatively prime to n"
  [n]
  (defn id [n] n)
  (defn gcd [a b]
    (if (= b 0)
        a
        (gcd b (remainder a b))))
  (defn filterp [i] (= (gcd i n) 1))
  (filtered-accumulate * 1 id 1 inc (- n 1) filterp))

Exercise 1.34

(defn f [g] (g 2))

Trying to evaluate (f f) with Clojure blows up with a ClassCastException because it will evaluate to (f 2) and then balk when trying to further evaluate because it’s expecting a function as the argument to f, and it cannot cast integer 2 to an integer function.

Exercise 1.35

Fixed point of x -> 1 + 1/x is the value x such that x = 1 + 1/x.
We are given Phi^2 = Phi + 1 by definition of the golden ratio. Dividing
each side by Phi we get Phi = 1 + 1/Phi, and can immediately see that
Phi serves as a fixed point for x -> 1 + 1/x.

Have to use tryf in place of try since try is a Clojure reserved word.

(defn fixed-point [f first-guess]
  (defn abs [x] (if (< x 0.0) (- x) x))
  (defn close-enough? [v1 v2]
    (let [tolerance 0.00001]
      (< (abs (- v1 v2)) tolerance)))
  (defn tryf [guess]
    (let [next (f guess)]
      (if (close-enough? guess next)
          next
          (tryf next))))
  (tryf first-guess))

Or iteratively:

(defn fixed-point [f first-guess]
  (defn abs [x] (if (< x 0.0) (- x) x))
  (defn close-enough? [v1 v2]
    (let [tolerance 0.00001]
      (< (abs (- v1 v2)) tolerance)))
  (defn tryf [guess]
    (loop [guess guess next (f guess)]
      (if (close-enough? guess next)
          next
          (recur next (f next)))))
  (tryf first-guess))

user=> (fixed-point (fn [x] (+ 1 (/ 1 x))) 1.0)
1.6180327868852458

Exercise 1.36

(defn fixed-point [f first-guess]
  (defn abs [x] (if (< x 0.0) (- x) x))
  (defn close-enough? [v1 v2]
    (let [tolerance 0.00001]
      (< (abs (- v1 v2)) tolerance)))
  (defn tryf [guess]
    (loop [guess guess next (f guess)]
      (println guess)
      (if (close-enough? guess next)
          next
          (recur next (f next)))))
  (tryf first-guess))

user=> (fixed-point (fn [x] (/ (Math/log 1000) (Math/log x))) 10)
10
2.9999999999999996
6.2877098228681545
3.7570797902002955
5.218748919675316
4.1807977460633134
4.828902657081293
4.386936895811029
4.671722808746095
4.481109436117821
4.605567315585735
4.522955348093164
4.577201597629606
4.541325786357399
4.564940905198754
4.549347961475409
4.5596228442307565
4.552843114094703
4.55731263660315
4.554364381825887
4.556308401465587
4.555026226620339
4.55587174038325
4.555314115211184
4.555681847896976
4.555439330395129
4.555599264136406
4.555493789937456
4.555563347820309
4.555517475527901
4.555547727376273
4.555527776815261
4.555540933824255
4.555532257016376
user=>

Now, with average damping:

user=> (fixed-point (fn [x] (average x (/ (Math/log 1000) (Math/log x)))) 10)
10
6.5
5.095215099176933
4.668760681281611
4.57585730576714
4.559030116711325
4.55613168520593
4.555637206157649
4.55555298754564
4.555538647701617
4.555536206185039
user=>

It only took 11 steps with average damping, versus 34 steps without damping.

Exercise 1.37

a.

; Evaluate continued fraction based upon n and d which return terms for
; the numerator and denominator, and k is number of terms (indexed by 1).
(defn cont-frac [n d k]
  (defn contR [i]
    (if (= i k)
        (/ (n i) (d i))
        (/ (n i) (+ (d i) (contR (inc i))))))
  (contR 1))

It takes k of 10 to approximate golden ratio to 4 decimal digits:

user=> (cont-frac (fn [x] 1.0) (fn [x] 1.0) 10)
0.6179775280898876

b. Iterative process version:

; Evaluate continued fraction based upon n and d which return terms for
; the numerator and denominator, and k is number of terms (indexed by 1).
; this version uses an iterative process
(defn cont-frac [n d k]
  (loop [i k acc 0]
    (if (= i 0)
        acc
        (recur (dec i) (/ (n i) (+ (d i) acc))))))

Exercise 1.38

; compute e via Euler's continued fraction, using k steps
; all Ni = 1, Di = 1,2,1,1,4,1,1,6,1,1,8,...
(defn compute-e [k]
  (defn d [i]
    (if (= (rem i 3) 2)
        (/ (+ i i 2) 3)
		1))
  (+ 2 (cont-frac (fn [x] 1.0) d k)))

Exercise 1.39

; compute tangent function via Lambert's continued fraction
; N1 = r; all other Ni = -r^2;  Di = 2i-1;  x is angle in radians; k is # steps
(defn tan-cf [x k]
  (let [mxx (- (* x x))]
    (defn n [i]
      (if (= i 1)
          x
          mxx))
    (cont-frac n (fn [i] (+ i i -1)) k)))

Exercise 1.40

(defn cubic
  "return function that computes f(x) -> x^3 + ax^2 + bx + c"
  [a b c]
  (fn [x] (+ (* x x x) (* a x x) (* b x) c)))

Exercise 1.41

(defn doublef
  "takes 1-arg procedure and returns procedure that applies original twice"
  [f]
  (fn [x] (f (f x))))

(((doublef (doublef doublef)) inc) 5) returns 21

Exercise 1.42

(defn compose
  "compose f after g: create function that takes x and returns f(g(x))"
  [f g]
  (fn [x] (f (g x))))

Exercise 1.43

(defn compose
  "compose f after g: create function that takes x and returns f(g(x))"
  [f g]
  (fn [x] (f (g x))))

(defn repeated
  "nth repeated application of f"
  [f n]
  (fn [x] (if (= n 0)
              x
              ((compose f (repeated f (dec n))) x))))

Exercise 1.44

(defn smooth
  "create smoothed version that averages f(x) with f(x-dx) and f(x+dx)"
  [f]
  (let [dx 0.0001]
    (fn [x] (/ (+ (f (- x dx)) (f x) (f (+ x dx))) 3))))

(defn smooth-repeated
  "create the n-fold smoothed function based upon f"
  [f n]
  ((repeated smooth n) f))

Exercise 1.45

(defn nthroot
  "try to find nth root of x using a repeated applications of average damping"
  [n x a]
  (fixed-point ((repeated average-damp a) (fn [y] (/ x (Math/pow y (- n 1))))) 2.0))

Experimentation with the above code with fixed-point instrumented with debugging println empirically shows that the number of applications of average damping required for the nth root calculation increases by 1 each time n reaches another power of 2. For n = 2, 1 application required, but for n = 32, 5 applications are required. For n = 31, 4 applications required. So a should be equal to the floor of log-base-2 of n.

This leads to the following code:

(defn average2 [x y] (/ (+ x y) 2))
(defn average-damp
  "return a modified version of function that averages its value with its arg"
  [f]
  (fn [x] (average2 x (f x))))

(defn fixed-point [f first-guess]
  (defn abs [x] (if (< x 0.0) (- x) x))
  (defn close-enough? [v1 v2]
    (let [tolerance 0.00001]
      (< (abs (- v1 v2)) tolerance)))   (defn tryf [guess]     (loop [guess guess next (f guess)]       (if (close-enough? guess next)           next           (recur next (f next)))))   (tryf first-guess)) (defn compose   "compose f after g: create function that takes x and returns f(g(x))"   [f g]   (fn [x] (f (g x)))) (defn repeated   "nth repeated application of f"   [f n]   (fn [x] (if (= n 0)               x               ((compose f (repeated f (dec n))) x)))) (defn floor-log2   "return floor of log base 2 of n for positive n"   [n]   (loop [l 0 ll 2]     (if (> ll n)
        l
        (recur (inc l) (* 2 ll)))))

(defn nthroot
  "try to find nth root of x using repeated applications of average damping"
  [n x]
  (fixed-point
    ((repeated average-damp (floor-log2 n)) (fn [y] (/ x (Math/pow y (- n 1)))))
    2.0))

Exercise 1.46

(def tolerance 0.00001)
(defn iterative-improve
  "perform iterative improvements of guess until it's good enough"
  [good-enough? improve]
  (fn [initial-guess]
    (loop [prev-guess initial-guess new-guess (improve initial-guess)]
      (if (good-enough? new-guess prev-guess)
          new-guess
          (recur new-guess (improve new-guess))))))

(defn average [x y] (/ (+ x y) 2))
(defn abs [x] (if (< x 0) (- x) x))
(defn good-enough?
  [guess prevGuess]
  (< (/ (abs (- guess prevGuess)) guess) 0.0001))

(defn sqrt [x]
  (defn improve-sqrt [guess]
    (average guess (/ x guess)))
  ((iterative-improve good-enough? improve-sqrt) 1.0))

(defn fixed-point
  [f first-guess]
  ((iterative-improve good-enough? (fn [x] (f x))) first-guess))

I am starting some blog pages here to share the SICP exercise solutions in Clojure, and hopefully eventually in Haskell. Stay tuned!

PDF file containing full SICP textbook
MIT SICP Lecture videos
Alternate source for lecture videos

Exercise solutions

http://sicpinclojure.com/
http://learnclojure.blogspot.com/
Online REPL for Scheme and Clojure (and more)

Here is my attempt at a simple Haskell implementation. In some ways not as concise as the original Haskell version, it seems easy to read and extend.

-- Parser returns whether string is composed of balanced
-- brackets and parens (e.g., "[()]", "[]()", "", etc.)
-- returns false if not balanced or any other character found

pairs = [('[',']'), ('(',')')]

parse = match []
-- ss is stack of closing chars to match, cs is input string
match (s:ss) (c:cs) | c == s = match ss cs
match ss (c:cs) =
  case lookup c pairs of
    Nothing -> False
    Just s  -> match (s:ss) cs
match ss [] = null ss