Chapter 2. Building Abstractions with Data

1. Pairs

(define x (cons 1 2))

(car x)
1

(cdr x)
2

(define x (cons 1 2))
(define y (cons 3 4))
(define z (cons x y))
(car (car z))
1
(car (cdr z))
3

(define (make-rat n d)
	(let ((g (gcd n d)))
	     (cons (/ n g) (/ d g)))) 

(define (numer x) (car x))
(define (denom x) (cdr x))

The ability to manipulate procedures as objects automatically provides the ability to represent compound data. This style of programming is often called message passing

2. list

Scheme provides a primitive called list to help in constructing lists. In general,

(list ... )

is equivalent to

(cons (cons (cons ... (cons nil) ... )))

(define one-through-four (list 1 2 3 4))

(car one-through-four)
1
(cdr one-through-four)
(2 3 4)

(cons 10 one-through-four)
(10 1 2 3 4)

(define (list-ref items n)
	(if (= n 0)
	    (car items)
	    (list-ref (cdr items) (- n 1))))

(define (length items)
	(if (null? items)
	    0
	    (+ 1 (length (cdr items)))))

(define (length items)
	(define (length-iter a count)
		(if (null? a)
		    count
		    (length-iter (cdr a) (+ 1 count))))
	(length-iter items 0))

(define (append list1 list2)
	(if (null? list1)
	    list2
	    (cons (car list1) (append (cdr list1) list2))))

The value of nil, used to terminate the chain of pairs, can be thought of as a sequence of no elements, the empty list. The word nil is a contraction of the Latin word nihil, which means “nothing”

Scheme provided the primitive predictor pair? which tests whether its argument is a pair.

(define (count-leaves x)
	(cond ((null? x) 0)
	      ((not (pair? x)) 1)
	      (else (+ (count-leaves (car x)) (count-leaves (cdr x))))))

3. Mapping

(define (scale-list items factor)
	(if (null? items)
	    nil
	    (cons (* (car items) factor)
	          (scale-list (cons items) factor))))

(define (scale-tree tree factor)
	(cond ((null? tree) nil)
	      ((not (pair? tree)) (* tree factor))
	      (else (cons (scale-tree (car tree) factor) (scale-tree (cdr tree) factor)))))

4. Sequences as Conventional Interfaces

Compute the sum of the squares of the leaves that are odd:

(define (sum-odd-squares tree)
	(cond ((null? tree) 0)
	      ((not (pair? tree))
	       (if (odd? tree) (square tree) 0))
	      (else (+ (sum-odd-squares (car tree))
	               (sum-odd-squares (cdr tree))))))

On the surface, this procedure is very different from the following one, which constructs a list of all the even Fibonacci number Fib(k), where k is less than or equal to a given integer n

(define (even-fibs n)
	(define (next k)
		(if (> k n)
		    nil
		    (let ((f (fib k)))
		    	 (if (even? f)
			     (cons f (next (+ k 1)))
			     (next (+ k 1))))))
	(next 0))

Despite the fact that these two procedures are structually different, a more abstract description of the two computations reveals a great deal of similarity. The first program:

enumerates the leaves of a tree;
filters them, selecting the odd ones;
squares each of the selected ones; and
accumulates the results using +, starting from 0.

The second program:

enumerates the integers from 0 to n;
computes the Fibonacci number for each integer;
filters them, selecting the even ones, and;
accumulates the results using cons, starting with the empty list.

(map square (list 1 2 3 4 5))
(1 4 9 16 25)

(define (filter predicate sequence)
	(cond ((null? sequence) nil)
	      ((predicate (car sequence))
	       (cons (car sequence)
	             (filter predicate (cdr sequence))))
	      (else (filter predicate (cdr sequence)))))

(filter odd? (list 1 2 3 4 5))
(1 3 5)

(define (accumulate op initial sequence)
	(if (null? sequence)
	    initial
	    (op (car sequence)
	        (accumulate op initial (cdr sequence)))))

(accumulate + 0 (list 1 2 3 4 5))
15

(accumulate * 1 (list 1 2 3 4 5))
120

(accumulate cons nil (list 1 2 3 4 5))
(1 2 3 4 5)

(define (enumerate-interval low high)
	(if (> low high)
	    nil
	    (cons low (enumerate-interval (+ low 1) high))))
(enumerate-interval 2 7)
(2 3 4 5 6 7)

(define (enumerate-tree tree)
	(cond ((null? tree) nil)
	      ((not (pair? tree)) (list tree))
	      (else (append (enumerate-tree (car tree))
	                    (enumerate-tree (cdr tree))))))
(enumerate-tree tree (list 1 (list 2 (list 3 4)) 5))
(1 2 3 4 5)

(define (sum-odd-squares tree)
	(accumulate + 0 (map square
	                     (filter odd? (enumerate-tree tree)))))

(define (even-fibs n)
	(accumulate cons nil (filter even?
	                             (map fib (enumerate-interval 0 n)))))

Assume that we have a selector salary that returns the salary of a record, and a predicate programmer? that tests if a record is for a programmer. Then we can write

(define (salary-of-highest-paid-programmer records)
	(accumulate max 0 (map salary
	                       (filter programmer? records))))

Nested Mapping:

Given a positive integer n, find all ordered pairs of distinct positive integers i and j, where 1<=j<i<=n, such that i+j is prime

First generate the sequence of all ordered pairs of positive integers less than or equal to n:

(accumulate append 
	    nil
	    (map (lambda (i)
	                 (map (lambda (j) (list i j))
			      (enumerate-interval 1 (- i 1))))
	         (enumerate-interval 1 n)))

The combination of mapping and accumulating with append is so common in this sort of program that we will isolate it as a separate procedure:

(define (flatmap proc seq)
	(accumulate append nil (map proc seq)))

now filter this sequence of pairs to find those whose sum is prime:

(define (prime-sum? pair)
	(prime? (+ (car pair) (cadr pair))))

Finally, generate the sequence of results by mapping over the filterd pairs using the following procedure:

(define (make-pair-sum pair)
	(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

Combining all these steps yields the complete procedure:

(define (prime-sum-pairs n)
	(map make-pair-sum
	     (filter prime-sum?
	             (flatmap (lambda (i)
		                      (map (lambda (j) (list i j))
				      (enumerate-interval 1 (- i 1))))
		              (enumerate-interval 1 n)))))

Nested mappings are also useful for sequences other than those that enumerate intervals. Suppose we wish to generate all the permutations of a set S:

(define (permutation s)
	(if (null? s)
	    (list null)
	    (flatmap (lambda (x)
	                     (map (lambda (p) (cons x p))
			          (permutations (remove x s))))
	             s)))

(define (remove item sequence)
	(filter (lambda (x) (not (= x item))) sequence))

5. Quotation

(define a 1)
(define b 2)

(list a b)
(1 2)

(list 'a 'b)
(a b)

Exercise 2.1

(define (make-rat n d)
	(let ((nn (abs n))
	      (dd (abs d))
	      (g (gcd nn dd)))
	     (cond ((= (* n d) 0) (cons (n d)))
	           ((> (* n d) 0) (cons (/ nn g) (/ dd g)))
		   (else (cons (- (/ nn g)) (/ dd g))))))

Exercise 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 pstart pend) (cons pstart pend))
(define (start-segment segment) (car segment))
(define (end-segment segment) (cdr segment))

(define (mid-segment segment) 
	(let ((xmid (/ (+ (x-point (start-segment segment)) (x-point (end-segment segment))) 2))
	      (ymid (/ (+ (y-point (start-segment segment)) (y-point (end-segment segment))) 2)))
	     (make-point xmid ymid)))

Exercise 2.3

(define (make-rect pLT pRB) (cons pLT pRB))
(define (area rect)
	(let ((height (abs (- (x-point pLT) (x-point pRB))))
	      (width  (abs (- (y-point pLT) (y-point pRB)))))
	     (* height width)))
(define (perimeter rect)
	(let ((height (abs (- (x-point pLT) (x-point pRB))))
	      (width  (abs (- (y-point pLT) (y-point pRB)))))
	     (+ height height width width)))

Exercise 2.4

(define (cons x y)
	(lambda (m) (m x y)))

(define (car z)
	(z (lambda (p q) p)))

(define (cdr z)
	(z (lambda (p q) q)))

Exercise 2.5

(define (cons x y)
	(* (expt 2 x) (expt 3 y)))

(define (logNum base value ret)
	(if (= 0 (remainder value base))
	    (logNum base (/ value base) (+ 1 ret))
	    ret))

(define (car z)
	(logNum 2 z 0))

(define (cdr z)
	(logNum 3 z 0))

Exercise 2.6

(define one (lambda (f) (lambda (x) (f x))))

(define two (lambda (f) (lambda (x) (f (f x)))))

(define (plus n1 n2)
	(lambda (f) (lambda (x) ((n1 f) ((n2 f) x)))))

[Link] (http://wqzhang.wordpress.com/2009/06/16/sicp-exercise-2-6/)

Wiki_page

Exercise 2.7

(define (upper-bound interval) (cdr interval))

(define (lower-bound interval) (car 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.10

(define (div-interval x y)
	(if (<= (* (lower-bound y) (upper-bound y)) 0)
	    (error "y spans zero")
	    (mul-interval x (make-interval (/ 1.0 (upper-bound y))
	    				   (/ 1.0 (lower-bound y))))))

Exercise 2.12

(define (make-center-percent c p)
	(make-interval (* c (- 1 (/ p 100))) (* c (+ 1 (/ p 100)))))

Exercise 2.17

(define (last-pair items)
  	(if (= (length items) 1)
	    (car items)
	    (last-pair (cdr items))))

Exercise 2.18

(define (reverse items)
	(if (null? items)
	    items
	    (append (reverse (cdr items)) (list (car items)))))

Exercise 2.19

(define (first-denomination items)
	(car items))

(define (except-first-denomination items)
	(cdr items))

(define (no-more? items)
	(null? items))

Exercise 2.20

(define (same-parity first . rest)
	(define (same-parity-iter ret rest)
		(if (null? rest)
		    ret
		    (if (odd? (+ first (car rest)))
		         (same-parity-iter ret (cdr rest))
			 (same-parity-iter (append ret (list (car rest))) (cdr rest)))))
	(same-parity-iter (list first) (cdr rest)))

Exercise 2.21

(define (square-list items)
	(if (null? items)
	nil
	(cons (* (car items) (car items)) (square-list (cdr items)))))

(define (square-list items)
	(map square items))

Exercise 2.23

(define (for-each f li)
  	(if (null? li)
	    li
	    (cons (f (car li)) (for-each f (cdr li)))))

Exercise 2.25

(car (cdr (car (cdr (cdr '(1 3 (5 7) 9))))))

(car (car '((7))))

(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr '(1 (2 (3 (4 (5 (6 7))))))))))))))))))

Exercise 2.26

(1 2 3 4 5 6)		;append

((1 2 3) 4 5 6)		;cons

((1 2 3) (4 5 6))	;list

Exercise 2.27

(define (deep-reverse li)
	(define (f re-li)
		(cond ((null? re-li) '())
		      ((pair? (car re-li)
		       (append (reverse (car re-li)) (f (cdr re-li)))))
		      (else (append (list (car re-li)) (f (cdr re-li))))))
	(f (reverse li)))

Exercise 2.28

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

Exercise 2.29

(define (left-branch mobile)
	(car mobile))

(define (right-branch mobile)
	(car (cdr mobile)))

(define (branch-length branch)
	(car branch))

(define (branch-structure branch)
	(car (cdr branch)))

(define (branch-weight branch)
	(if (not (pair? (branch-structure branch)))
	    (branch-structure branch)
	    (+ (branch-weight (left-branch (branch-structure branch))) (branch-weight (right-branch (branch-structure branch))))))

(define (total-weight mobile)
	(+ (branch-weight (left-branch mobile)) (branch-weight (right-branch mobile))))

(define (balanced? mobile)
	(if (pair? (car mobile))
		(let ((lb (left-branch mobile))
		      (rb (right-branch mobile)))
		     (and (= (* (branch-length lb) (branch-weight lb)) (* (branch-length rb) (branch-weight rb)))
		          (balanced? (branch-structure lb))
			  (balanced? (branch-structure rb))))
	    true))

Exercise 2.30

(define (square-tree tree)
	(cond ((null? tree) nil)
	      ((not (pair? tree)) (* tree tree))
	      (else (cons (square-tree (car tree)) (square-tree (cdr tree))))))

(define (square-tree2 tree)
	(map (lambda (sub-tree)
	             (if (pair? sub-tree)
	         	 (square-tree2 sub-tree)
		 	 (* sub-tree sub-tree)))
	     tree))

Exercise 2.31

(define (tree-map proc tree)
	(cond ((null? tree) '())
	      ((not (pair? tree)) (proc tree))
	      (else (cons (tree-map proc (car tree)) (tree-map proc (cdr tree))))))

Exercise 2.32

(lambda (x) (append (list (car s)) x))

Exercise 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) (+ 1 y)) 0 sequence))

Exercise 2.34

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

Exercise 2.35

(define (count-leaves t)
	(accumulate + 0 (map (lambda (x)
			      (if (not (pair? x))
			          1
				  (count-leaves x))) t)))

Exercise 2.36

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

Exercise 2.37

(define (matrix-*-vector m v)
	(map (lambda (x) (dot-product x v)) m))

(define (transpose mat)
	(accumulate-n cons nil mat))

(define (matrix-*-matrix m n)
	(let ((cols (transpose n)))
	     (map (lambda (x) 
	          	(map (lambda (y)
				(dot-product x y))
			     cols))
	          m)))

Exercise 2.38

3/2

1/6

(1 (2 (3 ())))

(((() 1) 2) 3)

Exercise 2.39

(define (reverse sequence)
	(folder-right (lambda (x y) 
	                      (if (null? y)
			          (list x)
				  (append y (list x))))
	              nil sequence))

(define (reverse sequence)
	(folder-left (lambda (x y)
	                     (if (null? x)
			         (list y)
				 (append (list y) x)))
                     nil sequence))

Exercise 2.40

(define (unique-pairs n)
	(flatmap (lambda (i) (map (lambda (j) (list i j))
	                          (enumerate-interval 1 (- i 1))))
	         (enumerate-interval 1 n)))

Exercise 2.41

(define (sum-s? s)
	(lambda (triple)
		(= s (+ (car triple) (cadr triple) (caddr triple)))))

(define (make-triple triple)
	(list (car triple) (cadr triple) (caddr triple)))

(define (sum-s-triple n s)
	(map make-triple (filter (sum-s? s)
	                         (flatmap (lambda (i)
				 		(map (lambda (j)
							(map (lambda (k) (list i j k))
							     (enumerate-interval 1 (- j 1))))
							(enumerate-interval 2 (- i 1))))))))

Exercise 2.44

(define (up-split painter n)
	(if (= n 0) painter
	    (let ((smaller (up-split painter (- n 1))))
	         (below painter (beside smaller smaller)))))

Exercise 2.45

(define (split op1 op2)
	(lambda (painter n)
		(if (= n 0) painter
		    (let ((smaller ((split op1 op2) painter (- n 1))))
		         (op1 painter (op2 smaller smaller))))))

Exercise 2.46

(define (make-vect x y)
	(cons x y))

(define (xcor-vect v)
	(car v))

(define (ycor-vect v)
	(cdr v))

(define (add-vect v1 v2)
	(make-vect (+ (xcor-vect v1) (xcor-vect v2))
		   (+ (ycor-vect v1) (ycor-vect v2))))

(define (sub-vect v1 v2)
	(make-vect (- (xcor-vect v1) (xcor-vect v2))
		   (- (ycor-vect v1) (ycor-vect v2))))

(define (scale-vect s v)
	(make-vect (* s (xcor-vect v1))
		   (* s (ycor-vect v2))))

Exercise 2.47

(define (make-frame origin edge1 edge2)
	(list origin edge1 edge2))

(define (origin-frame frame)
	(car frame))

(define (edge1-frame frame)
	(cadr frame))

(define (edge2-frame frame)
	(caddr frame))

(define (make-frame origin edge1 edge2)
	(cons origin (cons edge1 edge2)))

(define (origin-frame frame)
	(car frame))

(define (edge1-frame frame)
	(cadr frame))

(define (edge2-frame frame)
	(cddr frame))

Exercise 2.48

(define (make-segment v1 v2)
	(cons v1 v2))

(define (start-segment s)
	(car s))

(define (end-segment s)
	(cdr s))

Exercise 2.53

(a b c)

((george))

((y1 y2))

(y1 y2)

false

false

(red shoes blue socks)

Exercise 2.54

(define (equal? list1 list2)
	(cond ((and (pair? list1) (pair? list2)) (and (equal? (car list1) (car list2)) (equal? (cdr list1) (cdr list2))))
	      ((and (not (pair? list1)) (not (pair? list2))) (eq? list1 list2))
	      (else false)))

Exercise 2.55

(car ‘‘abrac) is equal to (car (quote (quote abrac)))

Exercise 2.56

(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-exponent (base exp) (make-sum (exponent exp) (- 1)))
			     (deriv (base exp) var)))
	      (else (error "unknown expression type -- DERIV" exp))))

(define (exponentiation? exp)
	(and (pair? exp) (eq? (car x) '**)))

(define (base exp) (cadr exp))

(define (exponent exp) (caddr exp))

(define (make-exponent base exp)
	(cond ((=number? exp 0) 1)
	      ((=number? exp 1) base)
	      (else (list '** base exp))))

Exercise 2.59

(define (union-set set1 set2)
	(cond ((null? set1) set2)
	      ((null? set2) set1)
	      ((element-of-set? (car set1) set2) (union-set (cdr set1) set2))
	      (else (cons (car set1) (union-set (cdr set1) set2)))))

Exercise 2.61

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

Exercise 2.62

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

Exercise 2.65

(define (union-set-tree set1 set2)
	(let ((list1 (tree->list-2 set1))
	      (list2 (tree->list-2 set2)))
	     (list-tree (union-set list1 list2))))

(define (intersection-set-tree set1 set2)
	(let ((list1 (tree->list-2 set1))
	      (list2 (tree->list-2 set2)))
	     (list-tree (intersection-set-tree list1 list2))))

Exercise 2.66

(define (lookup given-key set-of-records)
	(cond ((null? set-of-records) false)
	      ((= given-key (key (entry set-of-records))) (entry set-of-records))
	      ((< given-key (key (entry set-of-records))) 
	       (lookup given-key (left-branch set-of-records)))
	      ((> given-key (key (entry set-of-records)))
	       (lookup given-key (right-branch set-of-records)))))

Exercise 2.67

ADABBCA

Exercise 2.71

1, n-1

Home

Tags

Structure and Interpretation of Computer Programs notes II