(define (make-segment p1 p2) (cons p1 p2))
(define (start-segment seg) (car seg))
(define (end-segment seg) (cdr seg))
(define (midpoint-segment seg)
(define (avg x y) (/ (+ x y) 2))
(let ((a (start-segment seg))
(b (end-segment seg)))
(make-point (avg (x-point a) (x-point b))
(avg (y-point a) (y-point b)))))
(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (print-point p)
(newline)
(display "(")
(display (x-point p))
(display ",")
(display (y-point p))
(display ")"))
(define p1 (make-point 1 1))
(define p2 (make-point 2 2))
(define seg1 (make-segment p1 p2))
(define (make-rec tlp blp trp)
(cons (make-segment tlp trp)
(make-segment tlp blp)))
(define (len-rec rec) (car rec))
(define (wid-rec rec) (cdr rec))
;; procedures get four segments of the rectangles
(define (perimeter rec)
(* (+ (len-rec rec) (wid-rec))
2))
(define (area rec)
(* (len-rec rec) (wid-rec)))
(define (cons x y)
(lambda (m) (m x y)))
(define (car z)
(z (lambda (p q) p)))
;; Evaluation
; (car (cons x y))
; (car (lambda (m) (m x y)))
; ((lambda ((lambda (p q) p)) (m x y)))
; (lambda (x y) x)
(define (cdr z)
(z (lambda (p q) q)))
(define (exp base n)
(define (iter n result)
(if (= n 0)
result
(iter (- n 1) (* result base))))
(iter n 1))
(define (fast-exp base n)
(define (iter base n result)
(cond ((= n 0) (* result base))
((= 1 (remainder n 2)) (iter base (- n 1) (* result base)))
(else (iter (* base base) (/ n 2) result))))
(iter base n 1))
(define (count-0-remainder n divisor)
(define (iter try-exp)
(if (= 0 (remainder n (fast-exp divisor try-exp)))
(iter (+ try-exp 1))
(- try-exp 1)))
(iter 1))
(define (cons x y) (* (fast-exp 2 x) (fast-exp 3 y)))
(define (car p) (count-0-remainder p 2))
(define (cdr p) (count-0-remainder p 3))
(define test1 (cons 10000 8000))
(display (car test1))
(newline)
(display (cdr test1))
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
(lambda (f) (lambda (x) (f ((n f) x)))))
(add-1 zero)
(lambda (f)
(lambda (x) (f
((zero f) x))))
(lambda (f)
(lambda (x) (f
(((lambda (f1) (lambda (x) x)) f) x))))
(lambda (f)
(lambda (x) (f x))) ; one
(add-1 one)
(lambda (f) (lambda (x) (f (f x)))) ; two
(define (add a b)
(lambda (f)
(lambda (x)
((a f) ((b f) x)))))
(define (add-interval x y)
(make-interval (+ (lower-bound x) (lower-bound y))
(+ (upper-bound x) (upper-bound y))))
(define (mul-interval x y)
(let ((p1 (* (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))))
;; Exercise 2.10
(define (div-interval x y)
(if (<= 0 (* (lower-bound y) (upper-bound y)))
(error "Division error (interval spans 0)" y)
(mul-interval x
(make-interval (/ 1. (upper-bound y))
(/ 1. (lower-bound y))))))
;; Exercise 2.7
(define (make-interval a b) (cons a b))
(define (upper-bound interval) (max (car interval) (cdr interval)))
(define (lower-bound interval) (min (car interval) (cdr interval)))
;; Exercise 2.8
(define (sub-interval x y)
(make-interval (- (lower-bound x) (upper-bound y))
(- (upper-bound x) (lower-bound y))))
;; Exercise 2.11 - by rjk in http://community.schemewiki.org/?sicp-ex-2.11
; patt | min | max
; ++++ | al bl | ah bh
; ++-+ | ah bl | ah bh
; ++-- | ah bl | al bh
; -+++ | al bh | ah bh
; -+-+ | trouble case
; -+-- | ah bl | al bl
; --++ | al bh | ah bl
; ---+ | al bh | al bl
; ---- | ah bh | al bl
; treat 0 as positive sign
(define (pos? n) (>= 0))
(define (neg? n) (not (pos? y)))
(define (mul-interval a b)
(let ((al (lower-bound a))
(ah (upper-bound a))
(bl (lower-bound b))
(bh (upper-bound b)))
(cond ((and (pos? al) (pos? ah) (pos? bl) (pos? bh))
(make-interval (* al bl) (* ah bh)))
((and (pos? al) (pos? ah) (neg? bl) (pos? bh))
(make-interval (* ah bl) (* ah bh)))
((and (pos? al) (pos? ah) (neg? bl) (neg? bh))
(make-interval (* ah bl) (* al bh)))
((and (neg? al) (pos? ah) (pos? bl) (pos? bh))
(make-interval (* al bh) (* ah bh)))
((and (neg? al) (pos? ah) (neg? bl) (neg? bh))
(make-interval (* ah bl) (* al bl)))
((and (neg? al) (neg? ah) (pos? bl) (pos? bh))
(make-interval (* al bh) (* ah bl)))
((and (neg? al) (neg? ah) (neg? bl) (pos? bh))
(make-interval (* al bh) (* al bl)))
((and (neg? al) (neg? ah) (neg? bl) (neg? bh))
(make-interval (* ah bh) (* al bl)))
((and (neg? al) (pos? ah) (neg? bl) (pos? bh))
; our trouble case
(let ((p1 (* al bl))
(p2 (* al bh))
(p3 (* ah bl))
(p4 (* ah bh)))
(make-interval (min p1 p2 p3 p4)
(max p1 p2 p3 p4)))))))
All 3 problems point to the difficulty of “identity” when dealing with intervals. Suppose we have two numbers A and B which are contained in intervals:
A = [2, 8]
B = [2, 8]
A could be any number, such as 3.782, and B could be 5.42, but we just don’t know.
Now, A divided by itself must be 1.0 (assuming A isn’t 0), but of A/B (the same applies to subtraction) we can only say that it’s somewhere in the interval [0.25, 4].
Unfortunately, our interval package doesn’t say anything about identity, so if we calculated A/A, we would also get [0.25, 4].
So, any time we do algebraic manipulation of an equation involving intervals, we need to be careful any time we introduce the same interval (e.g. through fraction reduction), since our interval package re-introduces the uncertainty, even if it shouldn’t.
So:
2.14. Lem just demonstrates the above.
2.15. Eva is right, since the error isn’t reintroduced into the result in par2 as it is in par1.
(define (par1 r1 r2)
(div-interval (mul-interval r1 r2)
(add-interval r1 r2)))
(define (par2 r1 r2)
(let ((one (make-interval 1 1)))
(div-interval
one (add-interval (div-interval one r1)
(div-interval one r2)))))
2.16. A fiendish question. They say it’s “very difficult” as if it’s doable. I’m not falling for that. Essentially, I believe we’d have to introduce some concept of “identity”, and then have the program be clever enough to reduce equations. Also, when supplying arguments to any equation, we’d need to indicate identity somehow, since [2, 8] isn’t necessarily the same as [2, 8] … unless it is. Capiche?
(define (last-pair list1)
(if (= 1 (length list1))
list1
(last-pair (cdr list1))))
(define (reverse list1)
(if (= 1 (length list1))
list1
(append (reverse (cdr list1)) (cons (car list1) nil))))