As I move towards a proper computer science education, I figure it'd be worthwhile to document my work. Perhaps someone in the future learning SICP will find an answer key written in CL helpful. The code provided is not polished nor checked very thoroughly. But I did see that most of my answers matched with the ones provided here. (link dead at time of writing)
NB: I realize I'm missing answers for 1.14 and 1.15 . They should be uploaded shortly.
;; answers for 1.1
;; 10
;; 12
;; 8
;; 3
;; -16
;; switched define->defparameter
;; A
;; B
;; nil
;; 4
;; 16
;; 6
;; 16
=
;; 1.2
(defparameter *ans2* (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) (* 3 (- 6 2) (- 2 7))))
;; 1.3
(defun ans3 (a b c)
(defun square (x) (* x x))
(defun sum-of-squares (a b) (+ (square a) (square b)))
(cond
((and (<= c a) (<= c b)) (sum-of-squares a b))
((and (<= b c) (<= b a)) (sum-of-squares a c))
('t (sum-of-squares b c))))
;; 1.4
;; describe the following function
;; ( (if (> b 0) + -) a b) )
;; Adds a plus the absolute value of b. in CL would need explicit funcall.
;; 1.5
;; infinite loop if applicative order, 0 if normal order
(defun p () (p))
(defun test (x y) (if (equal x 0) 0 y))
;; 1.6
;; The function gets caught in an infinite loop, because all the parameters are evaluated
;; first so it doesn't have a base case.
(defun square (x) (* x x))
(defun good-enough? (guess x) (< (abs (- (square guess) x)) .0001))
(defun average (a b) (/ (+ a b) 2))
(defun improve (guess x) (average guess (/ x guess)))
(defun sqrt-itr (guess x)
(if (good-enough? guess x)
guess
(sqrt-itr (improve guess x) x)))
;; 1.7
(defun new-sqrt-itr (guess x)
(if (< ( / (abs (- (improve guess x) guess)) guess) (* guess .0001))
guess
(new-sqrt-itr (improve guess x) x)))
;; 1.8
(defun cube (x) (* x x x))
(defun cube-good-enough?
(guess x)
(<= (abs (- (cube-improve guess x) guess)) (abs (* .0001 guess))))
(defun cube-improve (guess x) (/ (+ (/ x (square guess)) (* 2 guess)) 3))
(defun cube-root-itr (guess x)
(print (float guess))
(if (cube-good-enough? guess x)
guess
(cube-root-itr (cube-improve guess x) x)))
;; 1.9
;; First one is recursive process
;; Second one is iterative process
;; 1.10
;; (A 1 10) = 2^10
;; (A 2 4) = 2^16
;; (A 3 3) = (A 2 4) = 2^16
;; (f n) = 2n
;; (g n) = 2^n
;; (h n) = 2 ^ h(n-1) h(0) = 0
;; 1.11
(defun f-recursive (n)
(if (< n 3)
n
(+ (f-recursive (- n 1)) (* 2 (f-recursive (- n 2))) (* 3 (f-recursive (- n 3))))))
(defun f-iterative (n)
(defun f-iterative-helper (f1 f2 f3 count final)
(if (equal count final)
f3
(f-iterative-helper f2 f3 (+ (* f1 3) (* f2 2) f3) (+ count 1) final)))
(if (< n 3) n
(f-iterative-helper 0 1 2 2 n)))
;; 1.12
(defun pascals-triangle (n)
(defun get-harmonic-addition (n) (/ (- (sqrt (+ 1 (* 8 n))) 1) 2))
(defun is-on-edge? (n)
(defun is-mod-addition-whole-integer (x)
(equal (mod (get-harmonic-addition x) 1) 0.0))
(or (is-mod-addition-whole-integer n) (is-mod-addition-whole-integer (+ n 1))))
(defun get-current-level (n) (floor (get-harmonic-addition n)))
(if (is-on-edge? n)
1
(+ (pascals-triangle (- n (get-current-level n) 1))
(pascals-triangle (- n (get-current-level n))))))
1.14 -> 1.15 coming soon
;; 1.16
(defun iterative-repeated-squaring (b n)
"page 46"
(defun square (x) (* x x))
(defun is-evenp (x) (equal (mod x 2) 0))
(defun iter-expt (b n a)
(cond
((equal n 0) a)
((is-evenp n) (iter-expt (square b) (- (/ n 2) 1) (* a (square b))))
('t (iter-expt b (- n 1) (* a b)))))
(iter-expt b n 1))
(defun is-evenp (x) (equal (mod x 2) 0))
;; 1.17
(defun my-multiply (a b)
(defun my-double (x) (* x 2))
(defun half (x) (/ x 2))
(cond
((equal b 0) 0)
((is-evenp b) (my-multiply (my-double a) (half b)))
(t (+ a (my-multiply a (- b 1))))))
;; 1.18
(defun my-mult-iterative (a b)
(defun my-double (x) (* x 2))
(defun half (x) (/ x 2))
(defun my-mult-itr (a b c)
(cond
((equal b 0) c)
((is-evenp b) (my-mult-itr (my-double a) (half b) c))
(t (my-mult-itr a (- b 1) (+ c a)))))
(my-mult-itr a b 0))
;; 1.19
(defun fib (n) (fast-fib 1 0 0 1 n))
(defun fast-fib (a b p q count)
(defun square (x) (* x x))
(cond ( (equal count 0) b)
((is-evenp count)
(fast-fib a b (+ (square p) (square q)) (+ (* 2 p q) (square q)) (/ count 2)))
(t (fast-fib (+ (* b q) (* a q) (* a p))
(+ (* b p) (* a q))
p
q
(- count 1)))))
;; 1.20 18 / 4 (the big thing here is that the if statement is where the actual reduction of the gcd happens)
;; 1.21 199, 1999, 7
(defun smallest-divisor (n)
(defun dividesp (a b) (equal (mod b a) 0))
(defun find-divisor (n test-divisor)
(cond ( (> (square test-divisor) n) n)
((dividesp test-divisor n) test-divisor)
(t (find-divisor n (+ test-divisor 1)))))
(find-divisor n 2))
(defun primep (n)
(equal (smallest-divisor n) n))
(defun timed-prime-test (n)
(defun prime-test (n start-time)
(if (primep n)
(progn
(princ n)
(princ "*****")
(princ (- (get-internal-run-time) start-time))
(print "")
)))
(prime-test n (get-internal-run-time)))
;; 1.22
;; 1013, 1019, 1021 (0 seconds all)
;; 10009, 10037, 10039 (0 seconds all)
;; 100019, 100043, 100049, (0 seconds)
;; 1000033, 1000037, 1000039, (0 seconds)
(defun search-for-primes (n limit)
(if (< n limit)
(progn (timed-prime-test n) (search-for-primes (+ n 2) limit))))
;; 1.25 problem is that the number gets super big, should be taking mod m along the way.
;; 1.26 logn height but number of leaves are doubling every round since u call expmod recursively twice.
(defun expmod (base exp m)
(cond ( (equal exp 0) 1)
((evenp exp) (mod (square (expmod base (/ exp 2) m)) m))
(t (mod (* base (expmod base (- exp 1) m)) m))))
(defun expmod-miller (base exp m)
;; i had a bug where i wasn't checking > exp 0...caused issues for a bit with infinite loop
(let ( (mod-of-half-exp (if (and (> exp 0) (evenp exp)) (expmod-miller base (/ exp 2) m))))
(cond ( (equal exp 0) 1)
((and (evenp exp)
(not (or (equal mod-of-half-exp 1) (equal mod-of-half-exp (- m 1))))
(equal (mod (square mod-of-half-exp) m) 1)) 0)
((evenp exp) (mod (square mod-of-half-exp) m))
(t (mod (* base (expmod-miller base (- exp 1) m)) m)))))
(defun fermat-full-test (n)
(defun fermat-test (a n)
(if (>= a n) t (and (equal (expmod a n n) a) (fermat-test (+ a 1) n))))
(fermat-test 2 n))
(defun miller-rabin-full-test (n)
(defun miller-rabin-test (a n)
(if (>= a n) t (and (equal (expmod-miller a n n) a) (miller-rabin-test (+ a 1) n))))
(miller-rabin-test 2 n))
;; 1.29
(defun simpson-integrate (f a b n)
(defun get-h () (/ (- b a) n))
(defun simpson-integrate-itr (h k current-sum)
(defun current-step-value () (funcall f (+ a (* h k))))
(cond
((equal k n) (+ current-sum (current-step-value)))
((equal k 0) (simpson-integrate-itr h (+ k 1) (current-step-value)))
((evenp k) (simpson-integrate-itr h (+ k 1) (+ current-sum (* 2 (current-step-value)))))
(t (simpson-integrate-itr h (+ k 1) (+ current-sum (* 4 (current-step-value)))))))
(* (/ (get-h) 3) (simpson-integrate-itr (get-h) 0 0)))
;; 1.30
(defun my-sum (term a next b)
(defun iter (a result)
(if (> a b)
result
(iter (funcall next a) (+ result (funcall term a)))))
(iter a 0))
;; 1.31 recursive process
(defun pi-over-4-term (a)
(/ (+ (* (floor a 2) 2) 2)
(+ (* (floor (+ a 1) 2) 2) 1)))
(defun pi-over-4-next (a) (+ a 1))
;; a
(defun my-product (term a next b)
(if (> a b)
1
(* (funcall term a) (my-product term (funcall next a) next b))))
;; b
(defun my-product-itr (term a next b)
(defun iter (a result)
(if (> a b)
result
(iter (funcall next a) (* result (funcall term a)))))
(iter a 1))
;; 1.32 accumulate
;; a
;; (accumulate-recursive #'+ 0 (lambda (x) x) 0 (lambda (x) (+ x 1)) 10)
;; (accumulate-recursive #'* 1 (lambda (x) x) 1 (lambda (x) (+ x 1)) 4)
(defun accumulate-recursive (combiner null-value term a next b)
(if (> a b)
null-value
(funcall combiner (funcall term a)
(accumulate-recursive combiner null-value term (funcall next a) next b))))
;; b
;; (accumulate-iterative #'* 1 (lambda (x) x) 1 (lambda (x) (+ x 1)) 4)
;; (accumulate-iterative #'+ 0 (lambda (x) x) 0 (lambda (x) (+ x 1)) 10)
(defun accumulate-iterative (combiner null-value term a next b)
(defun iter (a result)
(if (> a b)
result
(iter (funcall next a) (funcall combiner result (funcall term a)))))
(iter a null-value))
;; 1.33
;; (filter-accumulate #'primep #'+ 0 #'square 2 (lambda (x) (+ x 1)) 5)
;; kept to show error i made. notice how i accidently call accumulate-recursive
;; because i was copying and pasting the previous code without fully changing it.
;; i also didn't notice the bug because it was hard to tell for low values, since it filters
;; the first value correctly.
(defun filter-accumulate-broken (filter combiner null-value term a next b)
(if (> a b)
null-value
(cond
((funcall filter a)
(funcall combiner (funcall term a)
(accumulate-recursive combiner null-value term (funcall next a) next b)))
(t (funcall combiner
null-value
(accumulate-recursive combiner null-value term (funcall next a) next b))))))
(defun filter-accumulate (filter combiner null-value term a next b)
(if (> a b)
null-value
(funcall combiner (if (funcall filter a) (funcall term a) null-value)
(filter-accumulate filter combiner null-value term (funcall next a) next b))))
(defun sum-of-squares-of-primes (n)
(filter-accumulate #'primep #'+ 0 #'square 2 (lambda (x) (+ x 1)) n))
(defun product-of-relative-primes-less-than-n (n)
(filter-accumulate
(lambda (x) (equal (gcd n x) 1)) #'* 1 (lambda (x) x) 2 (lambda (x) (+ x 1)) (- n 1)))
;; 1.34
;; (f f) -> (f 2) -> (2 2)
;; 1.35
;; x -> 1 + 1 / x
;; x^2 = 1 + x
(defun average-damp (f) (lambda (x) (average x (funcall f x))))
;; This originally had (average-damp f) in the if statement, but it was removed after doing the q.
(defun fixed-point (f &optional (first-guess 1))
(defun iter (old new)
(if (< (abs (- new old)) .0001)
new
(iter new (funcall f new))))
(iter first-guess (funcall f first-guess)))
;; 1.36
;; = 30 iterations with tolerance .0001 and no average damping.
;; = 9 iterations with tolerance .0001 and average damping.
(defun fixed-point-expanded (f &optional (first-guess 1))
(defun iter (old new)
(print new)
(if (< (abs (- new old)) .0001)
new
(iter new (funcall (average-damp f) new))))
(iter first-guess (funcall f first-guess)))
;; 1.37
;; a)
;; it takes k=11 to get it right to 4 decimal places.
;; recursive version
(defun infinite-continued-fraction (n d k)
(defun iter (i)
(/ (funcall n i) (+ (funcall d i) (if (equal i k) 0 (iter (+ i 1))))))
(iter 1))
;; b)
;; iterative version
(defun infinite-continued-fraction-iterative (n d k)
;; work backwards for iterative process
(defun iter (i current-denominator)
(cond
((equal i 1) (/ (funcall n i) current-denominator))
(t (iter (- i 1) (+ (funcall d (- i 1)) (/ (funcall n i) current-denominator))))))
(iter k (funcall d k)))
;; euler expansion e - 2
;; 1.38 infinite continued fraction with ni = 1 and di = 1,2,1,1,4,6,1,1,8
(defun euler-e-expanion (&optional (steps 10))
(defun ni (i) 1.0)
(defun di (i)
(if (equal (mod i 3) 2)
(* (+ (floor i 3) 1) 2)
1.0))
(infinite-continued-fraction #'ni #'di steps))
;; 1.39 Lambert tanx
(defun tan-cf (x k)
(defun ni (i) (if (equal i 1) x (- (square x))))
(defun di (i) (+ (* 2 (- i 1)) 1))
(infinite-continued-fraction #'ni #'di k))
;; 1.40
(defun deriv (f &optional (dx .0001))
(lambda (x) (/ (- (funcall f (+ x dx)) (funcall f x)) dx)))
(defun newton-transform (f)
(lambda (x) ( - x (/ (funcall f x) (funcall (deriv f) x)))))
(defun newtons-method (g guess)
(fixed-point (newton-transform g) guess))
(defun cubic (a b c)
(lambda (x) (+ (expt x 3) (* a (expt x 2)) (* b x) c)))
;; 1.41
(defun inc (x) (+ x 1))
(defun double-compose (f)
(lambda (x) (funcall f (funcall f x))))
; (funcall (funcall (double-compose (double-compose #'double-compose)) #'inc) 5) = 21
;; 1.42
(defun compose (f g)
(lambda (x) (funcall f (funcall g x))))
;; 1.43
(defun repeated-composition (f n)
(if (equal n 1)
f
(compose f (repeated-composition f (- n 1)))))
;; 1.44
(defun smooth (f)
(lambda (x)
(let ( (dx .0001))
(/ (+ (funcall f (- x dx))
(funcall f x)
(funcall f (+ x dx)))
3))))
(defun n-fold-smooth (f n)
(funcall (repeated-composition #'smooth n) f))
;; 1.45
(defun fixed-point-of-transform (g transform guess)
(fixed-point (funcall transform g) guess))
;;
;; I had issues with this because it was running out of memory for a different reason-namely from
;; display huge fractions. It only works consistently if you make sure that n is a float!
(defun nth-root (x n)
(fixed-point-of-transform
(lambda (y) (/ x (iterative-repeated-squaring y (- n 1))))
(repeated-composition #'average-damp (floor (log n 2)))
1))
;; 1.46
(defun iterative-improve (improve-guess good-enoughp)
(defun iter (guess)
(if (funcall good-enoughp guess)
guess
(iter (funcall improve-guess guess))))
#'iter)
(defun sqrt-iter-improve (n)
(funcall (iterative-improve
(average-damp (lambda (guess) (/ n guess)))
(lambda (guess) (< (abs (- (square guess) n)) .0001))) 1))
(defun fixed-point-iter-improve (f)
(funcall (iterative-improve
(lambda (guess) (funcall f guess))
(lambda (guess) (< (abs (- (funcall f guess) guess)) .0001))) 1))