Tagged as LISP, Self-Learning, SICP
Written on 2008-08-07 20:54:02
It's taken far too long to post this up and the last four problems remain unfinished. That said, I want to get more of the solutions I've worked written up and I shouldn't have waited this long in the first place. With any luck Section 2.2 will follow within a week. I'm around half done with it and you can see some solutions here.
(define (make-rat n d)
(let ((g (gcd n d)))
(if (positive? (/ n d))
(cons (abs (/ n g)) (abs (/ d g)))
(cons (- (/ n g)) (abs (/ d g))))))
;Value: make-rat
(define (make-point x y)
(cons x y))
;Value: make-point
(define (x-point point)
(car point))
;Value: x-point
(define (y-point point)
(cdr point))
;Value: y-point
(define (start-segment segment)
(car segment))
;Value: start-segment
(define (end-segment segment)
(cdr segment))
;Value: end-segment
(define (make-segment p1 p2)
(cons p1 p2))
;Value: make-segment
(define (print-point p)
(newline)
(display "(")
(display (x-point p))
(display ",")
(display (y-point p))
(display ")"))
;Value: print-point
(define (midpoint-segment s)
(make-point (average (x-point (start-segment s))
(x-point (end-segment s)))
(average (y-point (start-segment s))
(y-point (end-segment s)))))
;Value: midpoint-segment
;;representation 1 - procedure based, working by magic:
(define (rect-area r)
(* (length r) (width r)))
;Value: rect-area
(define (rect-perimeter r)
(* 2 (+ (length r) (width r))))
;Value: rect-perimeter
(define (make-rect top-left bottom-right)
(cons top-left bottom-right))
;Value: make-rect
(define (length r)
(- (y-point (car r)) (y-point (cdr r))))
;Value: length
(define (width r)
(- (x-point (cdr r)) (x-point (car r))))
;Value: width
;;representation 2 - not procedure based, working by reality:
(define (make-rect top bottom)
(cons top bottom))
;Value: make-rect
(define (rect-top r)
(car r))
;Value: rect-top
(define (rect-bottom r)
(cdr r))
;Value: rect-bottom
(define (rect-left r)
(make-segment (start-segment top)
(start-segment bottom)))
;Value: rect-left
(define (rect-right r)
(make-segment (end-segment top)
(end-segment bottom)))
;Value: rect-right
(define (length r)
(- (y-point (start-segment (rect-top r)))
(y-point (start-segment (rect-bottom r)))))
;Value: length
(define (width r)
(- (x-point (end-segment (rect-top r)))
(x-point (start-segment (rect-top r)))))
;Value: width
(define (cons x y)
(lambda (m) (m x y)))
;Value: cons
(define (car z)
(z (lambda (p q) p)))
;Value: car
(define (cdr z)
(z (lambda (p q) q)))
;Value: cdr
(define (cons a b)
(* (expt 2 a) (expt 3 b)))
;Value: cons
(define (what-exponent x y)
(define (exp-iter count)
(if (= (modulo y (expt x count)) 0)
(exp-iter (+ count 1))
(- count 1)))
(exp-iter 1))
;Value: what-exponent
(define (car x)
(what-exponent 2 x))
;Value: car
(define (cdr x)
(what-exponent 3 x))
;Value: cdr
(define zero (lambda (f) (lambda (x) x)))
;Value: zero
(define (add-1 n)
(lambda (f) (lambda (x) (f ((n f) x)))))
;Value: add-1
(add-1 zero)
(lambda (f) (lambda (x) (f ((zero f) x))))
(lambda (f) (lambda (x) (f x))) ;; this was the difficult step for me. why? i couldn't understand how ((zero f) x) got worked down to x. I knew that the identity function was what eventually got returned but I figured it received f as it's argument. The trick was recalling that f gets passed into a function which does NOTHING WITH F and returns the identity function anyway. (zero f) reduces to the identity function because of the first lambda in zero that just throws it's argument away. Hence, you have (identity x) which is just x and leaves this result as one. somewhat sadly, formatting my code so that the substitution wasn't all on one line also could've made the difference and saved me a week or so.
(define one (lambda (f) (lambda (x) (f x))))
;Value: one
(add-1 one)
(lambda (f) (lambda (x) (f ((one f) x))));; again the f arg is thrown away and x is put into the second lambda to give...
(lambda (f) (lambda (x) (f (f x))))
(define two (lambda (f) (lambda (x) (f (f x)))))
;Value: two
;;clearly we're adding an application of f each time we add one. for example...
((two square) 5)
;Value: 625
;; which is the square of the square of 5 (* 25 25)
;;now i'm supposed to define an addition function which should perform like so:
(add one two)
(add (lambda (f) (lambda (x) (f x)))
(lambda (f) (lambda (x) (f (f x)))))
...
(lambda (f) (lambda (x) (f (f (f x)))))
;;and then allow us to do this
(((add one two) square) 5)
(square (square (square 5)))
;Value: 390625
;;maybe the hard part of this problem is holding multiple levels of evaluation in your head at the same time. anyway...
;;it seems like what we really want to do is feed the f chains into each other somehow...p
(define (add a b)
(lambda (f) (lambda (x) ((a f) (b f)) x)))
;Value: add
;;this is tempting but wrong. i realized you had to pass the f in to make sure you got the correct repeated calls but missed that if you passed (b f) into the resulting function you were passing a procedure instead of a value.
(define (add a b)
(lambda (f) (lambda (x) ((a f) ((b f) x)))))
;Value: add
(add one two)
(lambda (f) (lambda (x) ((one f) ((two f) x))))
(lambda (f) (lambda (x) ((one f)
((lambda (x) (f (f x))) x))))
(lambda (f) (lambda (x)
(lambda (x) ((f x)
(lambda (x) (f (f x)) x)))
(lambda (f) (lambda (x) (f (f (f x)))))
;;you want to hear what's really gross? i found that this worked for odd numbers but not even numbers and tried unsuccessfully to figure out what was wrong for an hour before re-evaluating my definitions for one and two and seeing it "just work".
(((add one two) square) 5)
(define (test churchnum)
(define (inc x)
(+ x 1))
((churchnum inc) 0))
;Value: test
(test (add one two))
;Value: 3
;;it's sort of insulting that after writing all that code you realize
you just implemented a fancy lambda version of repeated for
functions/church numerals.
;;proving above point:
(define (compose f g)
(lambda (x) (f (g x))))
;Value: compose
(define (repeated f n)
(if (= n 1)
f
(compose f (repeated f (- n 1)))))
;Value: repeated
(define (add a b)
(lambda (f) (repeated f (+ a b))))
;Value: add
;;of course, this pretends that church numerals are integers but...you get the idea.
(define (lower-bound i)
(car i))
;Value: lower-bound
(define (upper-bound i)
(cdr i))
;Value: upper-bound
(define (sub-interval x y)
(let ((p1 (- (lower-bound x) (lower-bound y)))
(p2 (- (lower-bound x) (upper-bound y)))
(p3 (- (upper-bound x) (lower-bound y)))
(p4 (- (upper-bound x) (upper-bound y))))
(make-interval (min p1 p2 p3 p4)
(max p1 p2 p3 p4))))
;Value: sub-interval
(define (width-interval x)
(/ (- (upper-bound x) (lower-bound x))
2))
;Value: width-interval
(width-interval (mul-interval inter1 inter2))
;Value: 24
(width-interval (div-interval inter1 inter2))
;Value: .5333333333333334
(width-interval (add-interval inter1 inter2))
;Value: 4
(width-interval (sub-interval inter1 inter2))
;Value: 4
(define (div-interval x y)
(if (<= (or (upper-bound y) (lower-bound y)) 0)
(error "Cannot divide by an interval that spans zero." y)
(mul-interval x
(make-interval (/ 1.0 (upper-bound y))
(/ 1.0 (lower-bound y))))))
;Value: div-interval
(define (mul-interval x y) ;;even with lets this is ugly. i object!
(let ((a (lower-bound x))
(b (upper-bound x))
(c (lower-bound y))
(d (upper-bonud y)))
(cond ((and (> a 0) (> b 0) (> c 0) (> d 0))
(make-interval (* a c) (* b d)))
((and (> a 0) (> b 0) (< c 0) (> d 0))
(make-interval (* b c) (* b d)))
((and (< a 0) (> b 0) (> c 0) (> d 0))
(make-interval (* a d) (* b d)))
((and (< a 0) (> b 0) (< c 0) (< d 0))
(make-interval (* b d) (* a d)))
((and (< a 0) (< b 0) (< c 0) (> d 0))
(make-interval (* b d) (* b c)))
((and (< a 0) (< b 0) (< c 0) (< d 0))
(make-interval (* a c) (* b d)))
((or (and (> a 0) (> b 0) (< c 0) (< d 0))
(and (< a 0) (< b 0) (> c 0) (> d 0)))
(make-interval (* b d) (* a c)))
(else (make-interval (min (* a d) (* b c))
(max (* a c) (* b d)))))))
;Value: mul-interval
(define (make-center-percent center tolerance)
(make-center-width center (* (/ tolerance 100) center)))
;Value: make-center-percent
(define (percent i)
(* (/ (width i) (center i)) 100))
;Value: percent
(percent (make-center-percent 8 5))
;Value: 5