## February 6, 2010

at Saturday, February 06, 2010 Labels: , , Posted by Billy

```;;;; SICP Section 2.3

;;; 2.54
(defun my-equals (list1 list2)
(cond ((and (null list1) (null list2)) t)
((and (consp (car list1)) (consp (car list2)))
(and (my-equals (car list1) (car list2))
(my-equals (cdr list1) (cdr list2))))
(t (and (equalp (car list1) (car list2))
(my-equals (cdr list1) (cdr list2))))))

;;; 2.55
;; ''abc => (quote (quote abc))
;; (car (quote (quote abc))) = > quote

;;; 2.56
;;; Differentiation definitions
(defun variablep (x)
(symbolp x))

(defun same-variable-p (v1 v2)
(and (variablep v1) (variablep v2) (equal v1 v2)))

(defun sump (x)
(and (consp x) (equal (car x) '+)))

(defun augend (s)

(defun productp (x)
(and (consp x) (equal (car x) '*)))

(defun multiplier (p)

(defun multiplicand (p)

(defun =number (exp num)
(and (numberp exp) (= exp num)))

(defun make-sum (a1 a2)
(cond ((=number a1 0) a2)
((=number a2 0) a1)
((and (numberp a1) (numberp a2)) (+ a1 a2))
(t (list '+ a1 a2))))

(defun make-product (m1 m2)
(cond ((or (=number m1 0) (=number m2 0)) 0)
((=number m1 1) m2)
((=number m2 1) m1)
((and (numberp m1) (numberp m2)) (* m1 m2))
(t (list '* m1 m2))))

;;; Exponent definitions
(defun exponentiationp (x)
(and (consp x) (equal (car x) '^)))

(defun base (exp)

(defun exponent (exp)

(defun make-exponentiation (base exp)
(cond ((=number exp 0) 1)
((=number exp 1) base)
((and (numberp base) (numberp exp)) (expt base exp))
(t (list '^ base exp))))

(defun deriv (exp var)
(cond ((numberp exp) 0)
((variablep exp)
(if (same-variable-p exp var) 1 0))
((sump exp)
(deriv (augend exp) var)))
((productp exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiationp exp)
(make-product
(exponent exp)
(make-product
(make-exponentiation (base exp) (- (exponent exp) 1))
(deriv (base exp) var))))
(t "unknown expression type")))

;;; 2.57

(defun augend (s)
(let ((augend (cddr s)))
(if (= 1 (length augend))
(car augend)
(make-sum (car augend) (cdr augend)))))

(defun multiplier (p)

(defun multiplicand (p)
(let ((multiplicand (cddr p)))
(if (= 1 (length multiplicand))
(car multiplicand)
(make-product (car multiplicand)
(cdr multiplicand)))))

(defun make-sum (a1 a2)
(cond ((=number a1 0) a2)
((=number a2 0) a1)
((and (numberp a1) (numberp a2)) (+ a1 a2))
((sump a2) (list '+ a1 (addend a2) (augend a2)))
((productp a2) (list '+ a1 (make-product
(multiplier a2)
(multiplicand a2))))
((and (consp a2) (> (length a2) 1))
(list '+ a1 (make-sum (car a2) (cdr a2))))
((consp a2) (list '+ a1 (car a2)))
(t (list '+ a1 a2))))

(defun make-product (m1 m2)
(cond ((or (=number m1 0) (=number m2 0)) 0)
((=number m1 1) m2)
((=number m2 1) m1)
((and (numberp m1) (numberp m2)) (* m1 m2))
((productp m2) (list '* m1 (multiplier m2) (multiplicand m2)))
((sump m2) (list '* m1 (make-sum (addend m2) (augend m2))))
((and (consp m2) (> (length m2) 1))
(list '* m1 (make-product (car m2) (cdr m2))))
((consp m2) (list '* m1 (car m2)))
(t (list '* m1 m2))))

;;; 2.58
(defun sump (x)
(and (consp x) (equal (cadr x) '+)))

(car s))

(defun augend (s)

(defun productp (x)
(and (consp x) (equal (cadr x) '*)))

(defun multiplier (p)
(car p))

(defun multiplicand (p)

(defun make-sum (a1 a2)
(cond ((=number a1 0) a2)
((=number a2 0) a1)
((and (numberp a1) (numberp a2)) (+ a1 a2))
(t (list a1 '+  a2))))

(defun make-product (m1 m2)
(cond ((or (=number m1 0) (=number m2 0)) 0)
((=number m1 1) m2)
((=number m2 1) m1)
((and (numberp m1) (numberp m2)) (* m1 m2))
(t (list m1 '* m2))))

;;; lookup b

;;; 2.59
(defun element-of-set-p (x set)
(cond ((null set) nil)
((equal x (car set)) t)
(t (element-of-set-p x (cdr set)))))

(if (element-of-set-p x set)
set
(cons x set)))

(defun intersection-set (set1 set2)
(cond ((or (null set1) (null set2)) nil)
((element-of-set-p (car set1) set2)
(cons (car set1)
(intersection-set (cdr set1) set2)))
(t (intersection-set (cdr set1) set2))))

(defun union-set (set1 set2)
(cond ((null set1) set2)
((null set2) set1)
((element-of-set-p (car set1) set2)
(union-set (cdr set1) set2))
(t (cons (car set1)
(union-set (cdr set1) set2)))))

;;; 2.60
(cons x set))

(defun union-set-2 (set1 set2)
(cond ((null set1) set2)
((null set2) set1)
(t (cons (car set1)
(union-set-2 (cdr set1) set2)))))

;;; 2.61
(let ((first (car set)))
(cond ((null set) (list x))
((= x first) set)
((> x first) (cons first (adjoin-set-2 x (cdr set))))
(t (cons x set)))))

;;; 2.62
(defun union-set-2 (set1 set2)
(cond ((null set1) set2)
((null set2) set1)
((= (car set1) (car set2))
(cons (car set1) (union-set-2 (cdr set1) (cdr set2))))
((> (car set1) (car set2))
(cons (car set2) (union-set-2 set1 (cdr set2))))
(t (cons (car set1) (union-set-2 (cdr set1) set2)))))

;;; 2.66
(defun lookup (given-key set-of-records)
(let ((current-record (car set-of-records))
(key (key current-record)))
(cond ((null set-of-records) nil)
((= given-key key) current-record)
((> given-key key)
(lookup given-key (right-tree set-of-records)))
(t (lookup given-key (left-tree set-of-records))))))

;;; Huffman tree representation
(defun make-leaf (symbol weight)
(list 'leaf symbol weight))

(defun leaf? (object)
(equalp (car object) 'leaf))

(defun make-code-tree (left right)
(list left
right
(append (symbols left) (symbols right))
(+ (weight left) (weight right))))

(defun left-branch (tree) (car tree))

(defun symbols (tree)
(if (leaf? tree)
(list (symbol-leaf tree))

(defun weight (tree)
(if (leaf? tree)
(weight-leaf tree)

(defun decode (bits tree)
(defun decode-1 (bits current-branch)
(if (null bits)
nil
(let ((next-branch
(choose-branch (car bits) current-branch)))
(if (leaf? next-branch)
(cons (symbol-leaf next-branch)
(decode-1 (cdr bits) tree))
(decode-1 (cdr bits) next-branch)))))
(decode-1 bits tree))

(defun choose-branch (bit branch)
(cond ((= bit 0) (left-branch branch))
((= bit 1) (right-branch branch))

(cond ((null set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(t (cons (car set) (adjoin-set x (cdr set))))))

(defun make-leaf-set (pairs)
(if (null pairs)
nil
(let ((pair (car pairs)))
(make-leaf-set (cdr pairs))))))

;;; 2.67
(defparameter *sample-tree*
(make-code-tree (make-leaf 'a 4)
(make-code-tree
(make-leaf 'b 2)
(make-code-tree (make-leaf 'd 1)
(make-leaf 'c 1)))))

(defparameter *sample-message* '(0 1 1 0 0 1 0 1 0 1 1 1 0))

(decode *sample-message* *sample-tree*) ; => (A D A B B C A)

;;; 2.68
(defun encode (message tree)
(if (null message)
nil
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))

(defun encode-symbol (symbol tree)
(cond ((or (null tree) (leaf? tree)) nil)
((member symbol (symbols (left-branch tree)))
(cons 0 (encode-symbol symbol (left-branch tree))))
((member symbol (symbols (right-branch tree)))
(cons 1 (encode-symbol symbol (right-branch tree))))
(t (error "Symbol not in tree."))))

;;; 2.69
(defun generate-huffman-tree (pairs)
(successive-merge (make-leaf-set pairs)))

(defun successive-merge (leaf-set &optional sub-tree)
(cond ((null (cdr leaf-set))
(make-code-tree (car leaf-set) sub-tree))
((null sub-tree)
(successive-merge (cdr leaf-set) (car leaf-set)))
(t (successive-merge (cdr leaf-set)
(make-code-tree (car leaf-set)
sub-tree)))))

;;; 2.70
(defparameter *lyric-huff-tree*
(generate-huffman-tree '((a 2) (boom 1) (get 2) (job 2)
(na 16) (sha 3) (yip 9) (wah 1))))

(defparameter *song* '(get a job sha na na na na na na na na
get a job sha na na na na na na na
wah yip yip yip yip yip yip yip yip
yip Sha boom))

(length (encode *song* *lyric-huff-tree*)) ; => 86

;; 2.71
;; Most frequent = 1, least = N - 1

```

at Saturday, February 06, 2010 Labels: Posted by Billy

The novel 1984 left me feeling dreadful. Not because of the quality of the writing or story, but because of the hopeless world the author created and because, as I read through the book and put myself in Winston's shoes, I could not imagine how to rebel and defeat the party. At times I thought some parts extreme, but then when reflecting about all the slavery and hardships in past society I thought perhaps this novel's world may not be so far fetched after all.

The story started slow for my tastes but the vivid writing and lucid details kept me interested. I felt some parts a bit too drawn out, such as when Winston read a couple chapters of Goldstein's book. But once I hit the book's turning point I found it hard to put down.

Overall, this book was a great change of pace for me. I'm glad I finally took the time to read it, as so many others have before me, and I recommend it to people who love drama, history, politics, or simply great writing.