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

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.13-todo

-

Ex-2.11 - todo

todo

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.25 - todo

todo

Ex-1.15 - todo

a: 5
b: todo

Ex-1.14 - todo

todo