Friday, June 19, 2009

Ex-3.6

(define rand-init 10)
(define rand
(let ((next rand-init))
(define (dispatch msg)
(cond
((eq? msg 'generate)
(set! next (rand-update init))
next)
((eq? msg 'reset)
(lambda (new-val) (set! next new-val)))
(else (error "message not recognized"))))
dispatch))

Ex-3.5

(define (random-in-range low high)
(let ((range (- high low)))
(+ low (random range))))
(define (estimate-integral p x1 x2 y1 y2 n)
(define (experiment)
(let ((x (random-in-range x1 x2))
(y (random-in-range y1 y2)))
(p x y)))
(* (monte-carlo n experiment) (* (- x2 x1) (- y2 y1))))

;procedure that creates a predicate to test whether
;given point lies in a circle
(define (make-in-circle-proc centreX centreY radius)
;for (x,y) to lie in the circle, distance
;between centre and (x,y) should be < radius
(lambda (x y)
(<= (+ (square (- centreX x))
(square (- centreY y)))
(square radius))))


;measuring PI by measuring area of unit circle
1 ]=> (exact->inexact
(estimate-integral
(make-in-circle-proc 0 0 1)
-1 1 -1 1 1000))
;Value: 3.032

1 ]=> (exact->inexact
(estimate-integral
(make-in-circle-proc 0 0 1)
-1 1 -1 1 1000))
;Value: 3.008

1 ]=> (exact->inexact
(estimate-integral
(make-in-circle-proc 0 0 1)
-1 1 -1 1 1000))
;Value: 2.964

1 ]=> (exact->inexact
(estimate-integral
(make-in-circle-proc 0 0 1)
-1 1 -1 1 1000))
;Value: 2.952

1 ]=> (exact->inexact
(estimate-integral
(make-in-circle-proc 0 0 1)
-1 1 -1 1 1000))
;Value: 3.036

1 ]=> (exact->inexact
(estimate-integral
(make-in-circle-proc 0 0 1)
-1 1 -1 1 1000))
;Value: 2.948

Ex-3.4

(define (make-account balance secret-passwd)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(let ((counter 0))
(define (dispatch p m)
(if (eq? p secret-passwd)
(begin
(cond
((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else (error "Unknown request -- MAKE-ACCOUNT"
m)))
(set! counter 0))
(begin
(set! counter (+ counter 1))
(if (> counter 7) "Call the cops"
"Incorrect Password"))))
dispatch))

Ex-3.3

(define (make-account balance secret-passwd)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (dispatch p m)
(if (eq? p secret-passwd)
(cond
((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else (error "Unknown request -- MAKE-ACCOUNT"
m)))
"Incorrect Password"))
dispatch)

Ex-3.2

(define (make-monitored f)
(let ((count 0))
(lambda (x)
(cond
((eq? x 'how-many-calls) count)
((eq? x 'reset-count) (set! count 0))
(else
(set! count (+ count 1))
(f x))))))

Ex-3.1

(define (make-accumulator x)
(lambda (n)
(set! x (+ x n))
x))

Section-2.5.3 - passed

passed

Section-2.5.2; Ex-2.81-2.86

Ex-2.81
a; It will fall into a recursive loop. Why, here is the reason
 1(define (apply-generic op . args)
2 (let ((type-tags (map type-tag args)))
3 (let ((proc (get op type-tags)))
4 (if proc
5 (apply proc (map contents args))
6 (if (= (length args) 2)
7 (let ((type1 (car type-tags))
8 (type2 (cadr type-tags))
9 (a1 (car args))
10 (a2 (cadr args)))
11 (let ((t1->t2 (get-coercion type1 type2))
12 (t2->t1 (get-coercion type2 type1)))
13 (cond (t1->t2
14 (apply-generic op (t1->t2 a1) a2))
15 (t2->t1
16 (apply-generic op a1 (t2->t1 a2)))
17 (else
18 (error "No method for these types"
19 (list op type-tags))))))
20 (error "No method for these types"
21 (list op type-tags)))))))

(exp x y) ;x and y are complex numbers
(apply-generic 'exp x y)

Now since there is no operation called exp is defined for type (complex complex), proc obtained at line 3 will be nil and we'll come to line 6 in above code. At line 11 t1->t2 will again be x and we'll recursively end up calling (apply-generic 'exp x y) again and will never exit.

b;If proc at line 3 is not nil then there is absolutely no issue. But if its nil then apply-generic will unnecessarily try to do the coercion. So, the conclusion is, it will work as is but will try to do the useless coercion.

c;
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(if (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags))
(a1 (car args))
(a2 (cadr args)))
(if (eq? type1 type2)
(error "No method for these types"
(list op type-tags))
(let ((t1->t2 (get-coercion type1 type2))
(t2->t1 (get-coercion type2 type1)))
(cond (t1->t2
(apply-generic op (t1->t2 a1) a2))
(t2->t1
(apply-generic op a1 (t2->t1 a2)))
(else
(error "No method for these types"
(list op type-tags)))))))
(error "No method for these types"
(list op type-tags)))))))

Ex-2.82
This strategy will fail in following situation, let say we call a generic procedure on two arguments whose types are integer and real. Since there is no direct coercion between mentioned types so it'll basically fail even though in reality it is possible to coerce integer into real following the route integer->rational->real.

Ex-2.83
(define (raise x)
(apply-generic 'raise x))

(define (raise-integer x)
(make-rational (contents x) 1))
(put 'raise '(integer) raise-integer)
(define (raise-rational x)
(make-complex-from-real-imag
(exact->inexact (/ (numer x) (denom x))) 0))
(put 'raise '(rational) raise-rational)

Ex-2.84-
;;we can represent the tower with a list
(define tower '(scheme-number rational complex))
;;checks if type1 is at lower level in the tower than
;;type2
;;todo: impl this
(define (before-in-tower type1 type2)
(< (listref type1 tower)))

(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(if (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags))
(a1 (car args))
(a2 (cadr args)))
(cond
((before-in-tower type1 type2)
(apply-generic op (raise a1) a2))
((before-in-tower type2 type1)
(apply-generic op a1 (raise a2)))
(else (error "No method for these types"
(list op type-tags)))))
(error "No method for these types"
(list op type-tags)))))))

Ex-2.85- passed
Ex-2.86- passed

Tuesday, June 16, 2009

section-2.5.1, Ex-2.77-2.80

Ex-2.77
(magnitude z)
(apply-generic 'magnitude z)
(apply (get 'magnitude '(complex)) (list (contents z)))
Now let say content of z is z1 wihch is a complex number in polar notation and
(magnitude polar-z)
(apply-generic 'magnitude polar-z)
(apply (get 'magnitude '(polar)) (list (contents polar-z)))
This will find the concrete magnitude procedure to get magnitude of a complex number in polar representation. apply-generic is called two times as we have two level of abstraction. Number->Complex->Polar(or Rectangular).

Ex-2.78
(define (attach-tag type-tag contents)
(if (number? contents) contents
(cons type-tag contents)))
(define (type-tag datum)
(cond
((number? datum) 'scheme-number)
((pair? datum) (car datum))
(else (error "Bad tagged datum -- TYPE-TAG" datum))))

(define (contents datum)
(cond
((number? datum) datum)
((pair? datum) (cdr datum))
(else (error "Bad tagged datum -- CONTENTS" datum))))

Ex-2.79
(define (equ? x y)
(apply-generic 'equ? x y))

(define (equ-scheme-number? x y)
(= x y))
(put 'equ? '(scheme-number scheme-number) equ-scheme-number?)

(define (equ-rational-number? x y)
(and (= (numer x) (numer y))
(= (denom x) (denom y))))
(put 'equ? '(rational rational) equ-rational-number?)

(define (equ-complex-number? x y)
(and (= (real-part x) (real-part y))
(= (imag-part x) (imag-part y))))
(put 'equ? '(complex complex) equ-complex-number?)

Ex-2.80
(define (=zero? x)
(apply-generic '=zero? x))

(put '=zero? '(scheme-numer)
(lambda (x) (= x 0)))

(put '=zero? '(rational)
(lambda (x) (= (numer x) 0)))

(put '=zero? '(complex)
(lambda (x) (and
(= (real-part x) 0)
(= (imag-part x) 0))))

Sunday, June 14, 2009

Ex-2.76

I'm going to present views on all three strategies with respect to adding new data type and operations.

Explicit dispatch programming:
Adding new Data Type:
We must put appropriate code to support new data type in *all* generic operation definitions and write constructor for it.
Adding new Operation:
Implement it for all data types and We must create a generic operation for it that does type dispatch on all the data types.

Data directed programming:
Adding new Data Type:
No change to generic operation, but need to put all the operations for this data type into operation-type table.
Adding new Operation:
Put the new operation definitions for all data types into operation-type table and Need to create a generic operation which is very simple in this case, that will just do a get on the table to find appropriate procedure.

Message passing style programming:
Adding new Data Type:
We just need to create a new constructor for it(that returns dispatch procedure).
Adding new Operation:
We have to modify all the constructors to include this new operations.

Most appropriate organization for frequent addition of new data types would be the message passing style and same for frequent addition of operations would be data directed programming.

Ex-2.75

(define (make-from-mag-ang mag ang)
(define (dispatch op)
(cond ((eq? op 'real-part)
(* mag (cos ang)))
((eq? op 'imag-part)
(* mag (sin ang)))
((eq? op 'magnitude) mag)
((eq? op 'angle) ang)
(else
(error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
dispatch)

Ex-2.74

a:We can give each division's personnel record file a tag and that is the division's name itself.
(
define (get-record file employee-name)
((get 'get-record (get-division file))
file employee-name))

b:Each employee record is also given a tag and that is the the division's name itself.
(define (get-salary employee-record)
((get 'get-salary (get-division employee-record))
employee-record))

c:
(define (find-employee-record files name)
(cond
((null? files) nil)
((null? (get-record (car files) name))
(find-employee-record (cdr files) name))
(else
(get-record (car files) name))))

d:A new division needs to be added with its appropriate procedures into the type-operations table.

Ex-2.73

a:
We moved from dispatch on type way of programming to data directed programming that helps bring modularity into the program that is it makes easier to change one part of the program independent of the others. We can't put number, variable into same data directed dispatch as they really don't have type tags and can't be put in operation-type table.

b:
(define (deriv-sum exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
(define (deriv-product exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
;aux code to put them in table
(put 'deriv '(+) deriv-sum)
(put 'deriv '(*) deriv-product)

c:
(define (deriv-exponent exp)
(make-product
(exponent exp)
(make-product
(make-exponentiation (base exp)
(- (exponent exp) 1))
(deriv (base exp) var))))
(put 'deriv '(**) deriv-exponent)

d: none

Section-2.3.4; Ex-2.67-2.72

Ex 2.67
1 ]=> (decode sample-message sample-tree)
;Value 1: (a d a b b c a)

Ex-2.68
(define (encode-symbol symbol tree)
(define (iter tree-or-leaf result)
(cond
((leaf? tree-or-leaf)
(if (eq? symbol (symbol-leaf tree-or-leaf))
result
(error "symbol is not in given tree")))
((memq symbol (symbols tree-or-leaf))
(if (memq symbol (symbols (left-branch tree-or-leaf)))
(iter (left-branch tree-or-leaf) (cons 0 result))
(iter (right-branch tree-or-leaf) (cons 1 result))))
(else (error "symbol is not in given tree"))))
(reverse (iter tree '())))

1 ]=> (encode '(a d a b b c a) sample-tree)
;Value 3: (0 1 1 0 0 1 0 1 0 1 1 1 0)
1 ]=> (equal? (encode '(a d a b b c a)
sample-tree)
sample-message)
;Value: #t

Ex-2.69
(define (successive-merge leafs)
(cond
((null? leafs) nil)
((= (length leafs) 1)
(make-code-tree (car leafs) nil))
((= (length leafs) 2)
(make-code-tree (cadr leafs) (car leafs)))
(else
(successive-merge
(cons (make-code-tree (cadr leafs) (car leafs))
(cddr leafs))))))


Ex-2.70
(define rock-pairs '((na 16)
(yip 9)
(sha 3)
(job 2)
(get 2)
(a 2)
(boom 1)
(wah 1)))
(define encoded-message
(encode
'(Get a job
Sha na na na na na na
na na Get a job Sha na
na na na na na na na
Wah yip yip yip yip yip
yip yip yip yip
Sha boom)
(generate-huffman-tree rock-pairs)))

;number of bits used
1 ]=> (length encoded-message)
;Value: 87

For fixed length encoding:
there are 8 distinct symbols, so we need atleast 3 bits for each symbol, and message has 36 symbols, so for fixed-length code we would need
3 X 36 = 108 bits

Ex-2.71
For most frequent symbol we need just 1 bit for any value of n.
For least frequent symbol:
number of bits needed =
depth of the generated tree =
(ceiling (log n)) ;where base=2 in log

Ex-2.72 - todo

Sunday, June 7, 2009

Ex-2.66

(define (look-up given-key set)
(cond
((null? set) #f)
((= given-key (key (car set))) #t)
((< given-key (key (car set)))
(look-up given-key (left-branch set)))
((> given-key (key (car set)))
(look-up given-key (right-branch set)))))

Ex-2.65

;set1, set2 are ordered lists
(define (union-set-aux set1 set2)
(cond
((null? set1) set2)
((null? set2) set1)
((< (car set1) (car set2))
(cons (car set1) (union-set-aux (cdr set1) set2)))
((= (car set1) (car set2))
(cons (car set1) (union-set-aux (cdr set1) (cdr set2))))
(else
(union-set-aux set2 set1))))
;set1, set2 are binary trees
(define (union-set set1 set2)
(list->tree
(union-set-aux
(tree->list-2 set1)
(tree->list-2 set2))))

Ex-2.64

;a
Once again, this demonstrates the power of wishful thinking. (partial-tree elt n) assumes that a left-sub-tree with first (quotien (- n 1) 2) elements of elt and a right-sub-tree of last (- n (+ left-size 1)) elements of elt is available and then it just constructs the tree using left-sub-tree, right-sub-tree and this-entry(the middle entry thats not included in any of the sub-trees).

1 ]=> (list->tree '(1 3 5 7 9 11))
;Value 19: (5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))

;b
t(n) = 2t(n/2), hence O(n)

Ex-2.63

;a
Both procedures do in-order traversal of the tree to create the list, hence both produce the same results.
;List produced for figures of 2.16 is same
(define tree-1 '(7 (3 (1 () ()) (5 () ()))
(9 () (11 () ()))))
(define tree-2 '(3 (1 () ())
(7 (5 () ()) (9 () (11 () ())))))
(define tree-3 '(5 (3 (1 () ()) ())
(9 (7 () ()) (11 () ()))))
;which is (1 3 5 7 9 11)

;b
For tree->list-1
t(n) = steps-to-append + t(n/2) + t(n/2)
= a + bn + 2t(n/2)
solving above recurrance equation will get
its O(nlogn)

For tree->list-2
t(n) = 2t(n/2)
its O(n)

clearly tree->list-1 is slower version.

Ex-2.62

(define (union-set set1 set2)
(cond
((null? set1) set2)
((null? set2) set1)
((< (car set1) (car set2))
(cons (car set1) (union-set (cdr set1) set2)))
((= (car set1) (car set2))
(cons (car set1) (union-set (cdr set1) (cdr set2))))
(else
(union-set set2 set1))))

Ex-2.61

(define (adjoin-set x set)
(cond
((null? set) (list x))
((< x (car set)) (cons x set))
(else
(cons (car set) (adjoin-set x (cdr set))))))

Ex-2.60

;element-of-set? stays the same and
; is O(n) operation

;adjoin-set
;its a O(1) operation now
(define (adjoin-set x set)
(cons x set))

;union-set
;its a O(n) operation now
(define (union-set set1 set2)
(append set1 set2))

;intersection-set stays the same and
;is O(n^2) operation

Ex-2.59

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

Section-2.3.2;Ex-2.56,2.57,2.58

This section is dedicated to create a symbolic differentiation program that demonstrates the concept of data-abstraction. The main derivation algorithm works on the abstract objects such as sum, variable and product with no knowledge of how they are represented, so we can change their representation any time without touching derivation algorithm.
Another thing to notice is the power of the lisp-notation, author first describes the rules of derivation and then translates them into scheme using cond and that translation into scheme just looks straight forward. What I'm saying is that how easy it was to convert math rules into working scheme program.
;code from book  to run the examples
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (make-sum a1 a2) (list '+ a1 a2))
(define (make-product m1 m2) (list '* m1 m2))
(define (sum? x)
(and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
(define (product? x)
(and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p) (caddr p))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a2)) (+ a1 a2))
(else (list '+ a1 a2))))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))

;Ex-2.56
(define (make-exponentiation base exponent)
(cond
((= exponent 0) 1)
((= exponent 1) base)
(else
(list '** base exponent))))
(define (exponentiation? exp)
(eq? (car exp) '**))
(define (base exp)
(cadr exp))
(define (exponent exp)
(caddr exp))

(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(make-product
(exponent exp)
(make-product
(make-exponentiation (base exp)
(- (exponent exp) 1))
(deriv (base exp) var))))
(else
(error "unknown expression type -- DERIV" exp))))

;Ex-2.57
(define (make-sum a1 a2 . a)
;find sum of all the numbers in given args
(define (number-sum args sum)
(cond
((null? args) sum)
((number? (car args))
(number-sum (cdr args) (+ sum (car args))))
(else (number-sum (cdr args) sum))))
;list only the symbols from given list of args
(define (symbols-only args)
(filter (lambda (x) (not (number? x))) args))

(let ((sum (number-sum (cons a1 (cons a2 a)) 0))
(symbols (symbols-only (cons a1 (cons a2 a)))))
(cond
((and (= 0 sum)
(= 0 (length symbols))) 0)
((and (= 0 sum)
(= 1 (length symbols))) (car symbols))
((and (= 0 sum)
(apply list (cons '+ symbols))))
((= (length symbols) 0) sum)
(else (apply list (cons '+ (cons sum symbols)))))))

(define (addend exp)
(cadr exp))
(define (augend exp)
(if (> (length (cddr exp)) 1)
(apply make-sum (cddr exp))
(caddr exp)))
;tests for make-sum
(make-sum 1 2) ;3
(make-sum 1 'a) ;(+ 1 a)
(make-sum 1 -1 'a) ;a
(make-sum 1 -1) ;0
(make-sum 1 -2 'a 'b) ;(+ -1 a b)
(make-sum 1 'a 'b 'c '3) ;(+ 4 a b c)

(define (make-product a1 a2 . a)
;find sum of all the numbers in given args
(define (number-prod args prod)
(cond
((null? args) prod)
((number? (car args))
(number-prod (cdr args) (* prod (car args))))
(else (number-prod (cdr args) prod))))
;list only the symbols from given list of args
(define (symbols-only args)
(filter (lambda (x) (not (number? x))) args))

(let ((prod (number-prod (cons a1 (cons a2 a)) 1))
(symbols (symbols-only (cons a1 (cons a2 a)))))
(cond
((= prod 0) 0)
((and (= 1 prod)
(= 0 (length symbols))) 1)
((and (= 1 prod)
(= 1 (length symbols))) (car symbols))
((and (= 1 prod)
(apply list (cons '* symbols))))
((= 0 (length symbols)) prod)
(else
(apply list (cons '* (cons prod symbols)))))))

(define (multiplier exp)
(cadr exp))
(define (multiplicand exp)
(if (> (length (cddr exp)) 1)
(apply make-product (cddr exp))
(caddr exp)))
;tests for make-product
(make-product 1 2) ;2
(make-product 1 'a) ;a
(make-product 1 -1 'a) ;(* -1 a)
(make-product 1 -1 'a 'b) ;(* -1 a b)
(make-product 1 'a 'b 'c 3) ;(* 3 a b c)
(make-product 1 'a 'b 'c 3 0) 0

;Ex-2.58
;a

(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a2)) (+ a1 a2))
(else (list a1 '+ a2))))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list m1 '* m2))))
(define (sum? x)
(and (pair? x)
(pair? (cdr x))
(eq? (cadr x) '+)))
(define (addend s) (car s))
(define (augend s) (caddr s))
(define (product? x)
(and (pair? x)
(pair? (cdr x))
(eq? (cadr x) '*)))
(define (multiplier p) (car p))
(define (multiplicand p) (caddr p))

;b - TODO

Ex-2.55

Internally 'abc translates to (quote abc).

(car ''abracadabra)
(car '(quote abracadabra))
quote => first element of (list 'quote 'abracadabra)

Ex-2.54

(define (equal? o1 o2)
(cond
((and (pair? o1) (pair? o2))
(and (eq? (car o1) (car o2))
(equal? (cdr o1) (cdr o2))))
((or (pair? o1) (pair? o2)) #f)
(else (eq? o1 o2))))

Ex-2.43

passed

Ex-2.42

;positions on the board are represented using pair
;(row col) where 1<=row,col<= board-size
(define empty-board '())
(define (adjoin-position row col rest-of-queens)
(cons (cons row col) rest-of-queens))
(define (safe? k positions)
;returns #t if a pos is safe with respect to other
;positions
(define (safe-position? pos positions)
(if (null? positions) true
(and (safe-two-positions? pos (car positions))
(safe-position? pos (cdr positions)))))

;returns #t if two positions are safe for each other
(define (safe-two-positions? pos1 pos2)
(cond
((= (car pos1) (car pos2)) #f)
((= (cdr pos1) (cdr pos2)) #f)
((same-diagonal? pos1 pos2) #f)
(else #t)))

;returns #t if two positions are on same diagonal
(define (same-diagonal? pos1 pos2)
(= (abs (- (car pos1) (car pos2)))
(abs (- (cdr pos1) (cdr pos2)))))

;here we made the assumption that first position
;in given positions is the one which has queen
;on k'th column, this holds true because of the
;way code written in procedure queens, this is
;not really right assumption to make but then we
;can change that anytime.
(safe-position? (car positions) (cdr positions)))

Ex-2.40,2.41

2.40
(define (unique-pairs n)
(accumulate
(lambda (x y)
(append (map (lambda (z)
(cons x z)) (enumerate-interval 1 (- x 1))) y))
nil (enumerate-interval 1 n)))

(define (prime-sum-pairs n)
(filter prime-sum?
(map
(lambda (x)
(list (car x) (cdr x) (+ (car x) (cdr x))))
(unique-pairs n))))

2.41
;this generates ordered triples of distinct positive
;integers i, j, and k less than or equal to a given
;integer n

(define (enumerate-all-triplets n)
(flatmap (lambda (x) x)
(map
(lambda (x)
(map (lambda (y)
(list y (car x) (cdr x)))
(enumerate-interval (+ (car x) 1) n)))
(unique-pairs n))))

(define (triplet-with-sum-s n s)
(filter (lambda (x)
(= s
(+ (car x) (cadr x) (caddr x))))
(enumerate-all-triplets n)))

Ex-2.39

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

Ex-2.38

Result from fold-left and fold-right is same only when op is such that (op x y) is equal to (op y x), mathematically its called the commutative property.

Ex-2.37

(define (matrix-*-vector m v)
(map
(lambda (w)
(dot-product v w)) m))
(define (transpose mat)
(accumulate-n
(lambda (x y) (cons x y))
'() mat))
(define (matrix-*-matrix m n)
(let ((cols (transpose n)))
(map
(lambda (v)
(map (lambda (w) (dot-product v w)) cols))
m)))

Ex-2.36

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

Ex-2.35

basically with map we create a flat list containing number of leaves in each subtree and then accumulate is used to sum them up.
(define (count-leaves t)
(accumulate
+ 0
(map (lambda (x)
(if (pair? x)
(count-leaves x) 1)) t)))

Ex-2.34

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

Ex-2.33

(define (map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) nil sequence))
(define (append seq1 seq2)
(accumulate cons seq2 seq1))
(define (length sequence)
(accumulate (lambda (x y) (+ y 1)) 0 sequence))

Ex-2.32

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

Why it works?
Wishful thinking :)
we assumed that we got subsets of (cdr s), now all we need to think is how to get additional subsets of s that contain (car s) and the answer is simply to include (car s) in all the subsets of (cdr s).

Ex-2.31

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

Ex-2.30

;without using any higher order procedures
(define (square-tree tree)
(cond
((null? tree) '())
((list? (car tree))
(append (list (square-tree (car tree)))
(square-tree (cdr tree))))
(else
(cons (square (car tree))
(square-tree (cdr tree))))))

;using higher order procedures
(define (square-tree tree)
(map
(lambda (x)
(if (pair? x)
(square-tree x) (square x))) tree))

Ex-2.29

;a
(define (left-branch m)
(car m))
(define (right-branch m)
(cadr m))
(define (branch-length b)
(car b))
(define (branch-structure b)
(cadr b))

;b
;total weight of a mobile
(define (total-weight m)
(+ (branch-total-weight (left-branch m))
(branch-total-weight (right-branch m))))


;find total weight of a branch
(define (branch-total-weight b)
(if (pair? (branch-structure b))
(total-weight (branch-structure b))
(branch-structure b)))

;test
(define b1 (make-branch 1 2))
(define b2 (make-branch 1 3))
(define m1 (make-mobile b1 b2))
(define b3 (make-branch 1 5))
(define b4 (make-branch 1 m1))
(define m (make-mobile b3 b4))
(total-weight m)
;Value: 10

;c
(define (balanced? m)
(let ((lb (left-branch m))
(rb (right-branch m)))
(and
(branch-balanced? lb)
(branch-balanced? rb)
(=
(* (branch-length lb) (branch-total-weight lb))
(* (branch-length rb) (branch-total-weight rb))))))
;see if a branch has a mobile structure and its
;balanced, if it has weight then return true
(define (branch-balanced? b)
(if (pair? (branch-structure b))
(balanced? (branch-structure b))
#t))

;test
(define b1 (make-branch 1 2))
(define b2 (make-branch 1 3))
(define m1 (make-mobile b1 b2))
(define b3 (make-branch 1 5))
(define b4 (make-branch 1 m1))
(define m (make-mobile b3 b4))
(balanced? m)
;Value: #f
(define b2 (make-branch 1 2))
(define m1 (make-mobile b1 b2))
(define b4 (make-branch 1 m1))
(define m (make-mobile b4 b4))
;value: #t

;d
Since we abstracted out the details of how we select various component of mobile and branch, so only selectors need to change.
(define (left-branch m)
(car m))
(define (right-branch m)
(cdr m))
(define (branch-length b)
(car b))
(define (branch-structure b)
(cdr b))

Ex-2.28

(define (fringe tree)
(cond
((null? tree) '())
((pair? tree)
(append (fringe (car tree)) (fringe (cdr tree))))
(else (list tree))))


Used wishful thinking here. I thought like this, If we knew the fringes of left and right subtree then the answer would be to just append them and this does the trick :).

Ex-2.27

(define (deep-reverse l)
(define (iter a r)
(cond ((null? a) r)
((list? (car a))
(iter (cdr a) (cons (deep-reverse (car a)) r)))
(else (iter (cdr a) (cons (car a) r)))))
(iter l '()))

Ex-2.26

passed

Ex-2.25

(car (cdaddr '(1 3 (5 7) 9)))
(caar '((7)))
(cadadr (cadadr (cadadr '(1 (2 (3 (4 (5 (6 7)))))))))

Ex-2.24

1 ]=> (list 1 (list 2 (list 3 4)))
;Value 9: (1 (2 (3 4)))

Ex-2.23

(define (for-each proc l)
(if (not (null? l))
(begin (proc (car l))
(for-each proc (cdr l)))))

Ex-2.22

Why reverse order is obtained?
Let us see the execution of iter...
(iter '(1 2 3 4) '())
(iter '(2 3 4) '(1))
(iter '(3 4) '(4 1))
(iter '(4) '(9 4 1))
(iter '() '(16 9 4 1))
'(16 9 4 1)

After trying to "fix" here is what the execution of iter looks like..
(iter '(1 2) '())
(iter '(2) (cons '() 1))
(iter '() (cons (cons '() 1) 4))
(cons (cons '() 1) 4) => this is not (list 1 4)

Ex-2.21

(define (square-list items)
(if (null? items)
'()
(cons (square (car items)) (square-list (cdr items)))))
(define (square-list items)
(map (lambda (x) (square x)) items))

Ex-2.20

(define (same-parity x . r)
(let ((proc (if (even? x) even? odd?)))
(cons x
(filter proc r))))

Ex-2.19

(define (cc amount coin-values)
(cond ((= amount 0) 1)
((or (< amount 0) (no-more? coin-values)) 0)
(else
(+ (cc amount
(except-first-denomination coin-values))
(cc (- amount
(first-denomination coin-values))
coin-values)))))
(define (first-denomination coins)
(car coins))
(define (no-more? coin-values)
(= (length coin-values) 0))
(define (except-first-denomination coin-values)
(cdr coin-values))

Order of coin-values doesn't affect the answer produced, because in the cc we're treating coin-values as just a set of values without any assumption of its order.

Ex-2.18

(define (reverse l)
(define (iter a r)
(if (null? a) r
(iter (cdr a) (cons (car a) r))))
(iter l '()))

Ex-2.17

(define (last-pair l)
(list (list-ref l (- (length l) 1))))

Ex-2.16

passed

Ex-2.15

Yes, She is right. And the reason is, more the uncertain number is repeated more uncertainity it brings to the system(overall calculation).

Ex-2.14

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


Indeed the results are different:
1 ]=> (par1 (make-interval 3 4) (make-interval 5 7))
;Value 1: (1.3636363636363638 . 3.5)
1 ]=> (par2 (make-interval 3 4) (make-interval 5 7))
;Value 2: (1.875 . 2.5454545454545454)

with center-percent form also the results are different
1 ]=> (par1 (make-center-percent 5 10) (make-center-percent 10 5))
;Value 4: (2.671875 . 4.125)
1 ]=> (par2 (make-center-percent 5 10) (make-center-percent 10 5))
;Value 5: (3.053571428571429 . 3.609375)

Ex-2.13-todo

-

Ex-2.12

(define (make-center-percent c p)
(let ((width (/ (* c p) 100)))
(make-center-width c width)))
(define (percent i)
(let ((w (width i))
(c (center i)))
(/ (* w 100) c)))

Ex-2.11 - todo

todo

Ex-2.10

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

Ex-2.9

Using the add-interval definition, for add-interval:
width(x+y) =  (upper-bound(x) + upper-bound(y))
- (lower-bound(x) + lower-bound(y))
= width(x) + width(y)


Using the sub-interval definition, for sub-interval
width(x-y) = (upper-bound(x) - lower-bound(y))
-(lower-bound(x) - upper-bound(y))
= width(x) + width(y)

Ex-2.8

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

Ex-2.7

(define (make-interval a b)
(cons (min a b) (max a b)))
(define (lower-bound interval)
(car interval))
(define (upper-bound interval)
(cdr interval))

Thursday, June 4, 2009

Ex-2.6

passed

Ex-2.5

This is another interesting way to implelment pairs for non-negative integers.
(define (cons a b)
(* (expt 2 a) (expt 3 b)))
(define (car z)
(define (iter a count)
(if (= (remainder a 2) 0)
(iter (quotient a 2) (+ count 1))
count))
(iter z 0))
(define (cdr z)
(define (iter a count)
(if (= (remainder a 3) 0)
(iter (quotient a 3) (+ count 1))
count))
(iter z 0))

Ex-2.4

Take a moment to realize how we are able to represent pairs using just procedures.
(define (cdr z)
(z (lambda (p q) q)))

Ex-2.3

Using message passing style of data abstraction here, so that procedures(which are the users of data abstraction make-rect) are independent of representation and will work even when the implementation is changed. In this style we make the data abstraction intelligent.
(define (perimeter rect)
(* 2
(+ (length rect) (breadth rect))))
(define (area rect)
(* (length rect) (breadth rect)))

;;universal selectors
(define (length rect)
(rect 'length))
(define (breadth rect)
(rect 'breadth))

;; representations..
;; a representation that takes length, and breadth of
;; the rectangle as input
(define (make-rect l b)
(define (dispatch msg)
(cond
((eq? msg 'length) l)
((eq? msg 'breadth) b)
(else (error "Message not recognized!"))))
dispatch)

If we think carefully, then the bean style of data abstraction we use in java when there are just getters/setters in the class implements this message passing style for data abstraction.

Ex-2.2

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

(define (make-segment p1 p2)
(cons p1 p2))
(define (start-segment s)
(car s))
(define (end-segment s)
(cdr s))

(define (midpoint-segment s)
(make-point
(/ (+ (x-point (start-segment s))
(x-point (end-segment s))) 2)
(/ (+ (y-point (start-segment s))
(y-point (end-segment s))) 2)))

Ex-2.1

(define (make-rat n d)
(let ((n1 (if
(or (and (< n 0) (< d 0))
(and (> n 0) (> d 0)))
(abs n) (* -1 (abs n))))
(d1 (abs d))
(g (gcd n d)))
(cons (/ n1 g) (/ d1 g))))

Wednesday, June 3, 2009

Ex-1.46

(define (iterative-improve good-enough? improve-guess)
(define (proc guess)
(if (good-enough? guess) guess
(proc (improve-guess guess))))
proc)

;sqrt
(define (average x y)
(/ (+ x y) 2.0))
(define (sqrt x)
((iterative-improve
(lambda (guess)
(< (abs (- (square guess) x)) 0.001))
(lambda (guess)
(average guess (/ x guess)))) x))

;fixed-point
(define tolerance 0.00001)
(define (fixed-point f first-guess)
((iterative-improve
(lambda (guess)
(< (abs (- guess (f guess))) tolerance))
(lambda (guess) (f guess))) first-guess))

Ex-1.45-todo

(define tolerance 0.00001)
(define (fixed-point f first-guess)
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(define (try guess)
(let ((next (f guess)))
(if (close-enough? guess next)
next
(try next))))
(try first-guess))
(define (average-damp f)
(lambda (x) (average x (f x))))
(define (average x y)
(/ (+ x y) 2))
(define (fast-expt b n)
(cond ((= n 0) 1)
((even? n) (square (fast-expt b (/ n 2))))
(else (* b (fast-expt b (- n 1))))))
(define (even? n)
(= (remainder n 2) 0))
(define expt fast-expt)

;this needs to go only
(define (nth-root x n)
(fixed-point (repeated
(average-damp
(lambda (y) (/ x (expt y (- n 1)))))
n) 1.0))

above isn't really working for (nth-root 3125 5)..

Ex-1.44

(define dx 0.001) ;set it to whatever
(define (smooth f)
(lambda (x)
(/ (+ (f (- x dx))
(f x)
(f (+ x dx))) 3)))
;nfold smooth
(repeated (smooth f) n)

Ex-1.43

 (define (repeated f n)
(define (iter i x)
(if (= i n) x
(iter (+ i 1) (f x))))
(lambda (x) (iter 0 x)))

Ex-1.42

(define (compose f g)
(lambda (x)
(f (g x))))

Ex-1.41

(define (double proc)
(lambda (x)
(proc (proc x))))

(define (inc x) (+ x 1))
(((double (double double)) inc) 5)
;Value: 21

Ex-1.40

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

Ex-1.39

(define (tan-cf x k)
(cont-frac
(lambda (i)
(if (= i 1) x (- 0 (square x))))
(lambda (i) (- (* 2 i) 1)) k))

Ex-1.38

;series 2,1,1,4,1,1,6,1,1..
;i starts with 0 that is (T 0) = 2 and so on
(define (T i)
(if (= (remainder i 3) 0)
(+ (* 2 (quotient i 3)) 2)
1))

;series 1,2,1,1,4,1,1,6,1,1,..
;i starts with 1 that is (D 1) = 1, (D 2)=2 and so on
(define (D i)
(if (= i 1) 1
(T (- i 2))))

;computing e
(+ 2 (cont-frac (lambda (i) 1.0) D 100))
;Value: 2.7182818284590455

Ex-1.37

;a
(define (incf i) (+ i 1))
(define (cont-frac n d k)
(define (cont-frac-aux i)
(if (= i k)
(/ (n i) (d i))
(/ (n i) (+ (d i) (cont-frac-aux (incf i))))))
(cont-frac-aux 1))

;computing golden-ratio
(/ 1 (cont-frac (lambda (i) 1.0) (lambda (i) 1.0) 12))
;Value: 1.6180555555555558 :for k>=12 golden-ratio
;is accurate upto 4 decimal places

;b
(define (cont-frac n d k)
(define (cont-frac-iter i result)
(if (= i 0) result
(cont-frac-iter (- i 1) (/ (n i) (+ (d i) result)))))
(cont-frac-iter k 0))

Ex-1.36

(define (fixed-point f first-guess)
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(define (try guess)
(display guess)
(newline)
(let ((next (f guess)))
(if (close-enough? guess next)
next
(try next))))
(try first-guess))


;solve x^x = 1000
;without average damping
(fixed-point
(lambda (y) (/ (log 1000) (log y))) 2)
;Value: 4.555532270803653
;steps taken: 34

;with average damping
; y = log(1000)/log(y)
; add y on both side and get following
; y = (log(1000)/log(y) + y)/2

(fixed-point
(lambda (y) (/ (+ y (/ (log 1000) (log y))) 2)) 2)
;Value: 4.555537551999825
;steps-taken: 9

Ex-1.35

(define tolerance 0.00001)
(define (fixed-point f first-guess)
(define (close-enough? v1 v2)
(< (abs (- v1 v2)) tolerance))
(define (try guess)
(let ((next (f guess)))
(if (close-enough? guess next)
next
(try next))))
(try first-guess))

I'm denoting golden ratio by gr. Its given in section-1.2.2 that
gr2 = gr + 1
=> gr = 1 + 1/gr
so gr is fixed point of above transformation.

;compute gr
(fixed-point
(lambda (y) (+ 1 (/ 1 y)))
1.0)
;Value: 1.6180327868852458

Ex-1.34

It fails because (f f)->(f 2)->(2 2) and 2 is not a procedure.

Ex-1.33

(define (filtered-accumulate filter combiner
null-value term a next b)
(cond ((> a b) null-value)
((filter a)
(combiner (term a)
(filtered-accumulate filter combiner
null-value term
(next a) next b)))
(else
(filtered-accumulate filter combiner null-value
term (next a) next b))))
;a
(define (incf i) (+ i 1))
(define (sum-sq-prime-nums a b)
(filtered-accumulate prime? + 0 square a incf b))

;b
(define (return-arg arg) arg)
(define (prod-nums-lt-n n)
(define (relative-prime? x)
(if (> (gcd x n) 1) #f #t))
(filtered-accumulate relative-prime? * 1
return-arg 1 incf n))

Ex-1.32

;a
(define (accumulate combiner null-value term a next b)
(if (> a b)
null-value
(combiner (term a)
(accumulate combiner null-value term
(next a) next b))))

;sum
(define (sum term a next b)
(accumulate + 0 term a next b))
;product
(define (product term a next b)
(accumulate * 1 term a next b))

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

Important thing to notice is that how we reached to accumulator, we wrote sum, product & identified a common pattern and abstracted it out in accumulate. Higher order procedure give more flexibility to apply this concept.

Ex-1.31

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

;facrotial in terms of product function
(define (return-arg arg) arg)
(define (incf x) (+ x 1))
(define (factorial n)
(product return-arg 1 incf n))

;PI calculation - TODO

(define (add2 x) (+ x 2))
(* (square
(/ (product return-arg 2.0 add2 100.0)
(product return-arg 3.0 add2 101.0))) 4)

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

Ex-1.30

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

Ex-1.29

(define (integral f a b n)
(define (sum-iter partial-sum h count coefficient)
(cond ((= count n)
(+ partial-sum (f (+ a (* n h)))))
((= count 0)
(sum-iter (+ partial-sum (f a)) h (+ count 1) 4))
(else
(sum-iter
(+ partial-sum
(* coefficient (f (+ a (* count h)))))
h (+ count 1) (if (= coefficient 2) 4 2)))))
(* (/ (/ (- b a) n) 3)
(sum-iter 0 (/ (- b a) n) 0 1)))

(define (cube x) (* x x x))

1 ]=> (integral cube 0.0 1.0 100)
;Value: .25000000000000006
1 ]=> (integral cube 0.0 1.0 1000)
;Value: .25000000000000006

Ex-1.28

passed

Ex-1.27

(define (fermat-test-1-to-n n)
(define (try-it a)
(= (expmod a n n) a))
(define (fermat-iter a)
(cond ((= a n) #f)
((try-it a) #t)
(else (fermat-iter (+ a 1)))))
(fermat-iter 1))

1 ]=> (fermat-test-1-to-n 561)
;Value: #t
1 ]=> (fermat-test-1-to-n 1105)
;Value: #t
1 ]=> (fermat-test-1-to-n 1729)
;Value: #t
1 ]=> (fermat-test-1-to-n 2465)
;Value: #t
1 ]=> (fermat-test-1-to-n 2821)
;Value: #t
1 ]=> (fermat-test-1-to-n 6601)
;Value: #t

Its clear that these number fool the fermat test as all of them are passing the fermat test but none of them are prime.

Ex-1.26

In this case (expmod base (/ exp 2) m) is evaluated twice at each level of recursion and hence logarithmic process becomes linear.

Ex-1.25 - todo

todo

Ex-1.22, 1.23, 1.24

Ex-1.22:
;changed runtime to get-universal-time
(define (timed-prime-test n)
(newline)
(display n)
(start-prime-test n (get-universal-time)))
(define (start-prime-test n start-time)
(if (prime? n)
(report-prime (- (get-universal-time) start-time))))
(define (report-prime elapsed-time)
(display " *** ")
(display elapsed-time))


; its assumed that start and end are odd numbers
; start <= end
(define (search-for-primes start end)
(if (not (= start end))
(begin
(timed-prime-test start)
(search-for-primes (+ start 2) end))))

3 primes above 1000:
1009, time-taken: 0
1013, time-taken: 0
1019, time-taken: 0

3 primes above 10000:
10007, time-taken: 0
10009, time-taken: 0
10037, time-taken: 0

3 primes above 100000:
100003, time-taken: 0
100019, time-taken: 0
100043, time-taken: 0

3 primes above 1000000:
1000003, time-taken: 0
1000033, time-taken: 0
1000037, time-taken: 0

machines now a days are quite faster, I can see the observable difference at following numbers
3 primes above 1000000000000:
1000000000039, time-taken: 4 s
1000000000061, time-taken: 4 s
1000000000063, time-taken: 4 s

3 primes above 10000000000000:
10000000000037, time-taken: 13 s
10000000000051, time-taken: 13 s
10000000000099, time-taken: 13 s

3 primes above 100000000000000:
100000000000031, time-taken: 41 s
100000000000067, time-taken: 41 s
100000000000097, time-taken: 42 s

and indeed the (sqrt 10) factor is visible for above 3 data-sets. So, yes execution time on the machine is proportional to the number of steps required for the computation.

Ex-1.23:
(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (next test-divisor)))))
(define (next test-divisor)
(if (= test-divisor 2) 3
(+ test-divisor 2)))

3 primes above 1000000000000:
1000000000039, time-taken: 2 s
1000000000061, time-taken: 2 s
1000000000063, time-taken: 3 s

3 primes above 10000000000000:
10000000000037, time-taken: 7 s
10000000000051, time-taken: 8 s
10000000000099, time-taken: 7 s

3 primes above 100000000000000:
100000000000031, time-taken: 23 s
100000000000067, time-taken: 25 s
100000000000097, time-taken: 24 s

If we compare these results with those in Ex-1.22, they're indeed halved(not exactly but close).

Ex-1.24-
(define (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))))
(define (fermat-test n)
(define (try-it a)
(= (expmod a n n) a))
(try-it (+ 1 (random (- n 1)))))
(define (fast-prime? n times)
(cond ((= times 0) true)
((fermat-test n) (fast-prime? n (- times 1)))
(else false)))
(define (timed-prime-test n)
(newline)
(display n)
(start-prime-test n (get-universal-time)))
(define (start-prime-test n start-time)
(if (fast-prime? n 10)
(report-prime (- (get-universal-time) start-time))))
(define (report-prime elapsed-time)
(display " *** ")
(display elapsed-time))

3 primes above 1000000000000:
1000000000039, time-taken: 0 s
1000000000061, time-taken: 0 s
1000000000063, time-taken: 0 s

3 primes above 10000000000000:
10000000000037, time-taken: 0 s
10000000000051, time-taken: 0 s
10000000000099, time-taken: 0 s

3 primes above 100000000000000:
100000000000031, time-taken: 0 s
100000000000067, time-taken: 0 s
100000000000097, time-taken: 0 s

no observable time difference at these numbers using fermat's test

Conclusion: Execution time on the machine is roughly proportional to the number of steps required in doing the computation.

Ex-1.21

1 ]=> (smallest-divisor 199)
;Value: 199
1 ]=> (smallest-divisor 1999)
;Value: 1999
1 ]=> (smallest-divisor 19999)
;Value: 7

Ex-1.20

passed

Ex-1.19

Applying Tpq first time
a->bq + aq + ap
b->bp + aq

Applying Tpq second time
a-> (bp + aq)q + (bq + aq + ap)q + (bq + aq + ap)p
-> b(2pq + q2) + a(2q2 + 2pq + p2)
-> b(2pq + q2) + a(2pq + q2) + a(p2 + q2)

b-> (bp + aq)p + (bq + aq + ap)q
-> b(p2 + q2) + a(2pq + q2)

clearly
p' = p2 + q2
q' = q2 + 2pq

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


Note: Whoa, take a moment to notice how this example generalized the approach of fast-expt to reach logarithmic number of steps using square to fib.

Ex-1.18

(define (double x) (* 2 x))
(define (halve x) (/ x 2))
(define (even? n)
(= (remainder n 2) 0))

;to find multiplication of a and b, call
; (mul-iter 0 a b)
(define (mul-iter r a b)
(cond ((= b 0) r)
((even? b)
(mul-iter r (double a) (halve b)))
(else
(mul-iter (+ r a) a (- b 1)))))

Ex-1.17

(define (double x) (* 2 x))
(define (halve x) (/ x 2))
(define (even? n)
(= (remainder n 2) 0))

(define (mul a b)
(cond
((= b 1) a)
((even? b)
(double (mul a (halve b))))
(else (+ a (mul a (- b 1))))))

Ex-1.16

;to calculate (expt b n) call (fast-expt-iter 1 b n)
(define (fast-expt-iter a b n)
(cond ((= n 0) a)
((even? n)
(fast-expt-iter a (square b) (/ n 2)))
(else (fast-expt-iter (* a b) b (- n 1)))))
(define (even? n)
(= (remainder n 2) 0))