sicp: section 2.3

sicp/2/3/1.scm

+(define a 1)
+(define b 2)
+
+(display (list a b))
+(newline)
+(display (list 'a 'b))
+(newline)
+(display (list 'a b))
+
+(newline)
+(display (car '(a b c)))
+(newline)
+(display (cdr '(a b c)))
+
+(define (memq item x)
+  (cond ((null? x) false)
+        ((eq? item (car x)) x)
+        (else (memq item (cdr x)))))
+
+(newline)
+(display (memq 'apple '(pear banana prune)))
+(newline)
+(display (memq 'apple '(x (apple sauce) y apple pear)))
+(newline)

sicp/2/3/2.scm

+(define (variable? e) (symbol? e))
+(define (same-variable? v1 v2)
+  (and (variable? v1) (variable? v2) (eq? v1 v2)))
+(define (sum? e) (and (pair? e) (eq? (car e) '+)))
+(define (addend e) (cadr e))
+(define (augend e) (caddr e))
+(define (make-sum a1 a2) (list '+ a1 a2))
+(define (product? e) (and (pair? e) (eq? (car e) '*)))
+(define (multiplier e) (cadr e))
+(define (multiplicand e) (caddr e))
+(define (make-product m1 m2) (list '* m1 m2))
+
+(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))))
+        (else (error "unknown expression type -- DERIV" exp))))
+
+(display (deriv '(+ x 3) 'x))
+(newline)
+(display (deriv '(* x y) 'x))
+(newline)
+(display (deriv '(* (* x y) (+ x 3)) 'x))
+
+(define (make-sum a1 a2)
+  (cond ((=number? a1 0) a2)
+        ((=number? a1 0) a1)
+        ((and (number? a1) (number? a1)) (+ a1 a2))
+        (else (list '+ a1 a2))))
+
+(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 (=number? exp num)
+  (and (number? exp) (= exp num)))
+
+(newline)
+(newline)
+(display (deriv '(+ x 3) 'x))
+(newline)
+(display (deriv '(* x y) 'x))
+(newline)
+(display (deriv '(* (* x y) (+ x 3)) 'x))
+(newline)

sicp/2/3/3.scm

+(define (element-of-set? x set)
+  (cond ((null? set) false)
+        ((equal? x (car set)) true)
+        (else (element-of-set? x (cdr set)))))
+
+(define s (list 1 2 3 4 5))
+(display (element-of-set? 5 s))
+(newline)
+(display (element-of-set? 31415 s))
+(newline)
+
+(define (element-of-set? x set)
+  (and (not (null? set))
+       (or (equal? x (car set))
+           (element-of-set? x (cdr set)))))
+
+(display (element-of-set? 5 s))
+(newline)
+(display (element-of-set? 31415 s))
+(newline)
+
+(define (adjoin-set x set)
+  (if (element-of-set? x set)
+    set
+    (cons x set)))
+
+(display (adjoin-set 5 s))
+(newline)
+(display (adjoin-set 31415 s))
+(newline)
+
+(define (intersection-set set1 set2)
+  (cond ((or (null? set1) (null? set2)) '())
+        ((element-of-set? (car set1) set2)
+         (cons (car set1)
+               (intersection-set (cdr set1) set2)))
+        (else (intersection-set (cdr set1) set2))))
+
+(display (intersection-set s (list 1 3 5 31415)))
+(newline)
+
+(define (entry tree) (car tree))
+(define (left-branch tree) (cadr tree))
+(define (right-branch tree0) (caddr tree))
+(define (make-tree entry left right)
+  (list entry left right))
+
+(define (element-of-set? x set)
+  (cond ((null? set) false)
+        ((= x (entry set)) true)
+        ((< x (entry set))
+         (element-of-set? x (left-branch set)))
+        ((> x (entry set))
+         (element-of-set? x (right-branch set)))))
+
+(define (adjoin-set x set)
+  (cond ((null? set) (make-tree x '() '()))
+        ((= x (entry set)) set)
+        ((< x (entry set))
+         (make-tree (entry set)
+                    (adjoin-set x (left-branch set))))
+        ((> x (entry set))
+         (make-tree (entry set)
+                    (left-branch set)
+                    (adjoin-set x (right-branch set))))))
+
+(define (lookup given-key set-of-records)
+  (cond ((null? set-of-records) false)
+        ((equal? given-key (key (car set-of-records)))
+         (car set-of-records))
+        (else (lookup given-key (cdr set-of-records)))))

sicp/2/3/4.scm

+(define (make-leaf symbol weight)
+  (list 'leaf symbol weight))
+(define (leaf? object)
+  (eq? (car object) 'leaf))
+(define (symbol-leaf x) (cadr x))
+(define (weight-leaf x) (caddr x))
+
+(define (make-code-tree left right)
+  (list left
+        right
+        (append (symbols left) (symbols right))
+        (+ (weight left) (weight right))))
+
+(define (left-branch tree) (car tree))
+(define (right-branch tree) (cadr tree))
+(define (symbols tree)
+  (if (leaf? tree)
+    (list (symbol-leaf tree))
+    (caddr tree)))
+(define (weight tree)
+  (if (leaf? tree)
+    (weight-leaf tree)
+    (cadddr tree)))
+
+(define (decode bits tree)
+  (define (decode-1 bits current-branch)
+    (if (null? bits)
+      '()
+      (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))
+(define (choose-branch bit branch)
+  (cond ((= bit 0) (left-branch branch))
+        ((= bit 1) (right-branch branch))
+        (else (error "bad bit -- CHOOSE-BRANCH" bit))))
+
+(define (adjoin-set x set)
+  (cond ((null? set) (list x))
+        ((< (weight x) (weight (car set))) (cons x set))
+        (else (cons (car set)
+                    (adjoin-set x (cdr set))))))
+(define (make-leaf-set pairs)
+  (if (null? pairs)
+    '()
+    (let ((pair (car pairs)))
+      (adjoin-set (make-leaf (car pair)
+                             (cadr pair))
+                  (make-leaf-set (cdr pairs))))))

sicp/2/3/ex_53.scm

+(display (list 'a 'b 'c))
+(newline)
+(display (list (list 'george)))
+(newline)
+(display (cdr '((x1 x2) (y1 y2))))
+(newline)
+(display (cadr '((x1 x2) (y1 y2))))
+(newline)
+(display (pair? (car '(a short list))))
+(newline)
+(display (memq 'red '((red shoes) (blue socks))))
+(newline)
+(display (memq 'red '(red shoes blue socks)))
+(newline)

sicp/2/3/ex_54.scm

+(display (equal? '(this is a list) '(this is a list)))
+(newline)
+(display (equal? '(this is a list) '(this (is a) list)))
+(newline)
+
+(define (equal? x y)
+  (if (and (pair? x) (pair? y))
+    (and (equal? (car x) (car y))
+         (equal? (cdr x) (cdr y)))
+    (eq? x y)))
+
+(display (equal? '(this is a list) '(this is a list)))
+(newline)
+(display (equal? '(this is a list) '(this (is a) list)))
+(newline)

sicp/2/3/ex_55.scm

+(display (car ''abracadabra))
+(newline)
+(display (car (quote 'abracadabra)))
+(newline)
+(display (car (quote (quote abracadabra))))
+(newline)
+(display ''abracadabra)
+(newline)

sicp/2/3/ex_56.scm

+(define (variable? e) (symbol? e))
+(define (same-variable? v1 v2)
+  (and (variable? v1) (variable? v2) (eq? v1 v2)))
+
+(define (sum? e) (and (pair? e) (eq? (car e) '+)))
+(define (addend e) (cadr e))
+(define (augend e) (caddr e))
+(define (make-sum a1 a2)
+  (cond ((=number? a1 0) a2)
+        ((=number? a2 0) a1)
+        ((and (number? a1) (number? a1)) (+ a1 a2))
+        (else (list '+ a1 a2))))
+
+(define (product? e) (and (pair? e) (eq? (car e) '*)))
+(define (multiplier e) (cadr e))
+(define (multiplicand e) (caddr e))
+(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 (exponentiation? e) (and (pair? e) (eq? (car e) '**)))
+(define (base e) (cadr e))
+(define (exponent e) (caddr e))
+(define (make-exponentiation b e)
+  (cond ((=number? e 0) 1)
+        ((and (number? b) (number? e)) (expt b e))
+        (else (list '** b e))))
+
+(define (=number? exp num)
+  (and (number? exp) (= exp num)))
+
+(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
+           (make-product
+             (exponent exp)
+             (make-exponentiation
+               (base exp)
+               (make-sum (exponent exp) '-1)))
+           (deriv (base exp) var)))
+        (else (error "unknown expression type -- DERIV" exp))))
+
+(display (deriv '(+ x 3) 'x))
+(newline)
+(display (deriv '(* x y) 'x))
+(newline)
+(display (deriv '(* (* x y) (+ x 3)) 'x))
+(newline)
+(display (deriv '(** (+ x 2) 3) 'x))
+(newline)

sicp/2/3/ex_57.scm

+(define (variable? e) (symbol? e))
+(define (same-variable? v1 v2)
+  (and (variable? v1) (variable? v2) (eq? v1 v2)))
+
+(define (sum? e) (and (pair? e) (eq? (car e) '+)))
+(define (addend e) (cadr e))
+(define (augend e)
+  (let ((terms (cddr e)))
+    (if (null? (cdr terms)) (car terms)
+      (fold-right make-sum '0 terms))))
+(define (make-sum a1 a2)
+  (cond ((=number? a1 0) a2)
+        ((=number? a2 0) a1)
+        ((and (number? a1) (number? a1)) (+ a1 a2))
+        (else (list '+ a1 a2))))
+
+(define (product? e) (and (pair? e) (eq? (car e) '*)))
+(define (multiplier e) (cadr e))
+(define (multiplicand e)
+  (let ((terms (cddr e)))
+    (if (null? (cdr terms)) (car terms)
+      (fold-right make-product '1 terms))))
+(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 (exponentiation? e) (and (pair? e) (eq? (car e) '**)))
+(define (base e) (cadr e))
+(define (exponent e) (caddr e))
+(define (make-exponentiation b e)
+  (cond ((=number? e 0) 1)
+        ((and (number? b) (number? e)) (expt b e))
+        (else (list '** b e))))
+
+(define (=number? exp num)
+  (and (number? exp) (= exp num)))
+
+(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
+           (make-product
+             (exponent exp)
+             (make-exponentiation
+               (base exp)
+               (make-sum (exponent exp) '-1)))
+           (deriv (base exp) var)))
+        (else (error "unknown expression type -- DERIV" exp))))
+
+(define exp '(+ x y (+ x 3) (* 4 5)))
+(display (addend exp))
+(newline)
+(display (augend exp))
+(newline)
+
+(define exp '(* x y (+ x 3) (* 4 5)))
+(display (multiplier exp))
+(newline)
+(display (multiplicand exp))
+(newline)
+
+(display "(deriv '(+ x 3) 'x)\n")
+(display (deriv '(+ x 3) 'x))
+(newline)
+(display "(deriv '(* x y) 'x)\n")
+(display (deriv '(* x y) 'x))
+(newline)
+(display "(deriv '(* (* x y) (+ x 3)) 'x)\n")
+(display (deriv '(* (* x y) (+ x 3)) 'x))
+(newline)
+(display "(deriv '(* x y (+ x 3)) 'x)\n")
+(display (deriv '(* x y (+ x 3)) 'x))
+(newline)
+(display "(deriv '(** (+ x 2) 3) 'x)\n")
+(display (deriv '(** (+ x 2) 3) 'x))
+(newline)

sicp/2/3/ex_58.scm

+(define (variable? e) (symbol? e))
+(define (same-variable? v1 v2)
+  (and (variable? v1) (variable? v2) (eq? v1 v2)))
+
+(define (sum? e) (and (pair? e) (eq? (car e) '+)))
+(define (addend e) (cadr e))
+(define (augend e)
+  (let ((terms (cddr e)))
+    (if (null? (cdr terms)) (car terms)
+      (fold-right make-sum '0 terms))))
+(define (make-sum a1 a2)
+  (cond ((=number? a1 0) a2)
+        ((=number? a2 0) a1)
+        ((and (number? a1) (number? a1)) (+ a1 a2))
+        (else (list '+ a1 a2))))
+
+(define (product? e) (and (pair? e) (eq? (car e) '*)))
+(define (multiplier e) (cadr e))
+(define (multiplicand e)
+  (let ((terms (cddr e)))
+    (if (null? (cdr terms)) (car terms)
+      (fold-right make-product '1 terms))))
+(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 (exponentiation? e) (and (pair? e) (eq? (car e) '**)))
+(define (base e) (cadr e))
+(define (exponent e) (caddr e))
+(define (make-exponentiation b e)
+  (cond ((=number? e 0) 1)
+        ((and (number? b) (number? e)) (expt b e))
+        (else (list '** b e))))
+
+(define (=number? exp num)
+  (and (number? exp) (= exp num)))
+
+(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
+           (make-product
+             (exponent exp)
+             (make-exponentiation
+               (base exp)
+               (make-sum (exponent exp) '-1)))
+           (deriv (base exp) var)))
+        (else (error "unknown expression type -- DERIV" exp))))
+
+(display (deriv '(+ x 3) 'x))
+(newline)
+(display (deriv '(* x y) 'x))
+(newline)
+(display (deriv '(* (* x y) (+ x 3)) 'x))
+(newline)
+(display (deriv '(* x y (+ x 3)) 'x))
+(newline)
+(display (deriv '(** (+ x 2) 3) 'x))
+
+(define (sum? e) (and (pair? e) (eq? (cadr e) '+)))
+(define (product? e) (and (pair? e) (eq? (cadr e) '*)))
+(define (exponentiation? e) (and (pair? e) (eq? (cadr e) '**)))
+
+(define (addend e) (car e))
+(define (multiplier e) (car e))
+(define (base e) (car e))
+
+(define (make-sum a1 a2)
+  (cond ((=number? a1 0) a2)
+        ((=number? a2 0) a1)
+        ((and (number? a1) (number? a1)) (+ a1 a2))
+        (else (list a1 '+ a2))))
+(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 (make-exponentiation b e)
+  (cond ((=number? e 0) 1)
+        ((and (number? b) (number? e)) (expt b e))
+        (else (list b '** e))))
+
+(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
+           (make-product
+             (exponent exp)
+             (make-exponentiation
+               (base exp)
+               (make-sum (exponent exp) '-1)))
+           (deriv (base exp) var)))
+        (else (error "unknown expression type -- DERIV" exp))))
+
+(newline)
+(newline)
+(display (deriv '(x + 3) 'x))
+(newline)
+(display (deriv '(x * y) 'x))
+(newline)
+(display (deriv '((x * y) * (x + 3)) 'x))
+(newline)
+(display (deriv '((x + 2) ** 3) 'x))
+(newline)
+(display (deriv '(x + (3 * (x + (y + 2)))) 'x))
+(newline)

sicp/2/3/ex_59.scm

+(define (element-of-set? x set)
+  (and (not (null? set))
+       (or (equal? x (car set))
+           (element-of-set? x (cdr set)))))
+
+(define (union-set set1 set2)
+  (append (filter (lambda (x) (not (element-of-set? x set2))) set1)
+          set2))
+
+(display (union-set (list 1 3 5 7) (list 2 3 4 6)))
+(newline)

sicp/2/3/ex_60.scm

+(define (element-of-set? x set)
+  (and (not (null? set))
+       (or (equal? x (car set))
+           (element-of-set? x (cdr set)))))
+
+(define s (list 2 3 2 1 3 2 2))
+(display (element-of-set? 2 s))
+(newline)
+(display (element-of-set? 31415 s))
+(newline)
+
+(define (adjoin-set x set) (cons x set))
+
+(display (adjoin-set 2 s))
+(newline)
+(display (adjoin-set 31415 s))
+(newline)
+
+(define (intersection-set set1 set2)
+  (cond ((or (null? set1) (null? set2)) '())
+        ((element-of-set? (car set1) set2)
+         (cons (car set1)
+               (intersection-set (cdr set1) set2)))
+        (else (intersection-set (cdr set1) set2))))
+
+(display (intersection-set s (list 2 3 5 31415)))
+(newline)
+
+(define (union-set set1 set2)
+  (append set1 set2))
+
+(display (union-set (list 1 3 5 7) (list 2 3 4 6)))
+(newline)

sicp/2/3/ex_61.scm

+(define (adjoin-set x set)
+  (if (or (null? set)
+          (< x (car set)))
+    (cons x