Category: Scheme

Exercise 2.56.  Show how to extend the basic differentiator to handle more kinds of expressions. For instance, implement the differentiation rule

by adding a new clause to the deriv program and defining appropriate procedures exponentiation?, base, exponent, and make-exponentiation. (You may use the symbol ** to denote exponentiation.) Build in the rules that anything raised to the power 0 is 1 and anything raised to the power 1 is the thing itself.

	(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 (variable? x) (symbol? x))
	(define (same-variable? v1 v2)
	(and (variable? v1) (variable? v2) (eq? v1 v2)))
	(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 (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)))
	(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 (base exp) (cadr exp))
	(define (exponent exp) (caddr exp))
	(define (make-exponentiation base exp)
	(cond
	((=number? base 1) 1)
	((=number? exp 1) base)
	((=number? exp 0) 1)
	(else
	(list '** base exp))))
	(define (exponentiation? exp)
	(and
	(pair? exp)
	(eq? (car exp) '**)))
	(deriv (make-exponentiation 'x 3) 'x)

view raw s256.scm hosted with by GitHub

Exercise 2.41.  Write a procedure to find all ordered triples of distinct positive integers i, j, and k less than or equal to a given integer n that sum to a given integer s.

	(define nil '())
	(define (append list1 list2)
	(if (null? list1)
	list2
	(cons (car list1) (append (cdr list1) list2))))
	(define (reverse list1)
	(if
	(null? list1)
	nil
	(if
	(null? (cdr list1))
	list1
	(append
	(reverse (cdr list1))
	(cons (car list1) nil)))))
	(reverse (list 1 2))
	(reverse (list 1 2 3 4 5))
	(reverse (list 1))
	(reverse ())
	(reverse '())
	(define (enumerate-interval low high)
	(if (> low high)
	nil
	(cons low (enumerate-interval (+ low 1) high))))
	(define (flatmap proc seq)
	(accumulate append nil (map proc seq)))
	(define (unique-pairs n)
	(flatmap
	(lambda (i)
	(map
	(lambda (j) (list i j))
	(enumerate-interval 1 (- i 1))))
	(enumerate-interval 1 n)))))
	(unique-pairs 5)
	(define (unique-pairs-r n)
	(flatmap
	(lambda (i)
	(map
	(lambda (j) (list j i))
	(enumerate-interval 1 (- i 1))))
	(reverse (enumerate-interval 1 n))))))
	(unique-pairs-r 5)
	(define (unique-pairs3 n)
	(flatmap
	(lambda (i)
	(map
	(lambda (j) (cons j i))
	(enumerate-interval 1 n)))
	(unique-pairs n)))))
	(unique-pairs3 5)
	(define (ordered-3-tuple n)
	(flatmap
	(lambda (i)
	(flatmap
	(lambda (j)
	(map
	(lambda (k) (list i j k))
	(enumerate-interval 1 (- j 1))))
	(enumerate-interval 1 (- i 1))))
	(enumerate-interval 1 n)))
	(ordered-3-tuple 1)
	(ordered-3-tuple 2)
	(ordered-3-tuple 3)
	(ordered-3-tuple 4)
	(ordered-3-tuple 5)
	(ordered-3-tuple 6)
	(ordered-3-tuple 7)
	(ordered-3-tuple 8)
	(ordered-3-tuple 9)

view raw s241.scm hosted with by GitHub

Exercise 2.40.  Define a procedure unique-pairs that, given an integer n, generates the sequence of pairs (i,j) with 1< j< i< n. Use unique-pairs to simplify the definition of prime-sum-pairs given above.

	(define nil '())
	(define (inc n) (+ n 1))
	(define (identity x) x)
	(define
	(sum-iter-helper
	filter?
	runningsum
	operation
	termfunction
	termvalue
	nextfunction
	upperbound)
	(if
	(> termvalue upperbound)
	runningsum
	(if
	(filter? (termfunction termvalue))
	(sum-iter-helper
	filter?
	(operation runningsum (termfunction termvalue))
	operation
	termfunction
	(nextfunction termvalue)
	nextfunction
	upperbound)
	(sum-iter-helper
	filter?
	runningsum
	operation
	termfunction
	(nextfunction termvalue)
	nextfunction
	upperbound))))
	(define (sum filter? term starter operation a next b)
	(sum-iter-helper
	filter?
	starter
	operation
	term
	a
	next
	b))
	(define (filtered-accumulate filter? combiner null-value term a next b)
	(sum filter? term null-value combiner a next b))
	(define (even? n)
	(= (remainder n 2) 0))
	(define (sum-integers a b)
	(filtered-accumulate even? + 0 identity a inc b))
	;; prime number test code
	(define (smallest-divisor n)
	(find-divisor n 2))
	(define (find-divisor n test-divisor)
	(cond ((> (square test-divisor) n) n)
	((divides? test-divisor n) test-divisor)
	(else (find-divisor n (+ test-divisor 1)))))
	(define (divides? a b)
	(= (remainder b a) 0))
	(define (prime? n)
	(= n (smallest-divisor n)))
	(define (enumerate-interval low high)
	(if (> low high)
	nil
	(cons low (enumerate-interval (+ low 1) high))))
	(define (flatmap proc seq)
	(accumulate append nil (map proc seq)))
	(define (prime-sum? pair)
	(prime? (+ (car pair) (cadr pair))))
	(define (make-pair-sum pair)
	(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
	(define (unique-pairs n)
	(flatmap
	(lambda (i)
	(map
	(lambda (j) (list i j))
	(enumerate-interval 1 (- i 1))))
	(enumerate-interval 1 n)))))
	(define (prime-sum-pairs n)
	(map make-pair-sum
	(filter prime-sum? (unique-pairs n))))
	(unique-pairs 5)
	(prime-sum-pairs 5)

view raw s240.scm hosted with by GitHub

Exercise 2.39.   Complete the following definitions of reverse (exercise 2.18) in terms of fold-right and fold-left from exercise 2.38:

(define (reverse sequence)
(fold-right (lambda (x y) <??>) nil sequence))
(define (reverse sequence)
(fold-left (lambda (x y) <??>) nil sequence))

	(define nil '())
	(define (append list1 list2)
	(if (null? list1)
	list2
	(cons (car list1) (append (cdr list1) list2))))
	(define (accumulate op initial sequence)
	(if (null? sequence)
	initial
	(op (car sequence)
	(accumulate op initial (cdr sequence)))))
	(define fold-right accumulate)
	(define (fold-left op initial sequence)
	(define (iter result rest)
	(if (null? rest)
	result
	(iter
	(op result (car rest))
	(cdr rest))))
	(iter initial sequence))
	(define (reverse-r sequence)
	(fold-right (lambda (x y) (append y (list x))) nil sequence))
	(define (reverse-l sequence)
	(fold-left (lambda (x y) (cons y x)) nil sequence))
	(reverse-r (list 1 2 3))
	(reverse-l (list 1 2 3))

view raw s239.scm hosted with by GitHub

Exercise 2.38.  The accumulate procedure is also known as fold-right, because it combines the first element of the sequence with the result of combining all the elements to the right. There is also a fold-left, which is similar to fold-right, except that it combines elements working in the opposite direction:

(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest))
(cdr rest))))
(iter initial sequence))

What are the values of

(fold-right / 1 (list 1 2 3))
(fold-left / 1 (list 1 2 3))
(fold-right list nil (list 1 2 3))
(fold-left list nil (list 1 2 3))

Give a property that op should satisfy to guarantee that fold-right and fold-left will produce the same values for any sequence.

	(define nil '())
	(define (accumulate op initial sequence)
	(if (null? sequence)
	initial
	(op (car sequence)
	(accumulate op initial (cdr sequence)))))
	(define fold-right accumulate)
	(define (fold-left op initial sequence)
	(define (iter result rest)
	(if (null? rest)
	result
	(iter
	(op result (car rest))
	(cdr rest))))
	(iter initial sequence))
	(fold-right / 1 (list 1 2 3))
	(fold-left / 1 (list 1 2 3))
	(fold-left / 1 (list 1 2 3 4))
	(fold-right list nil (list 1 2 3))
	(fold-left list nil (list 1 2 3))
	(fold-right cons nil (list 1 2 3))
	(fold-left cons nil (list 1 2 3))

view raw s238.scm hosted with by GitHub

Exercise 2.37.  Suppose we represent vectors v = (v_i) as sequences of numbers, and matrices m = (m_ij) as sequences of vectors (the rows of the matrix). For example, the matrix

is represented as the sequence ((1 2 3 4) (4 5 6 6) (6 7 8 9)). With this representation, we can use sequence operations to concisely express the basic matrix and vector operations. These operations (which are described in any book on matrix algebra) are the following:

We can define the dot product as¹⁷

(define (dot-product v w)
(accumulate + 0 (map * v w)))

Fill in the missing expressions in the following procedures for computing the other matrix operations. (The procedure accumulate-n is defined in exercise 2.36.)

(define (matrix-*-vector m v)
(map <??> m))
(define (transpose mat)
(accumulate-n <??> <??> mat))
(define (matrix-*-matrix m n)
(let ((cols (transpose n)))
(map <??> m)))

	(define nil '())
	(define (accumulate op initial sequence)
	(if (null? sequence)
	initial
	(op (car sequence)
	(accumulate op initial (cdr sequence)))))
	(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)))))
	(define (dot-product v w)
	(accumulate + 0 (map * v w)))
	(define (matrix-*-vector m v)
	(map (lambda (x) (dot-product x v)) m))
	(define (transpose m)
	(accumulate-n cons nil s))
	(define (matrix-*-matrix m1 m2)
	(map (lambda (x) (matrix-*-vector m1 x)) (transpose m2)))
	(define w
	(list
	(list 1 2 3)
	(list 4 5 6)
	(list 10 11 12)))
	(define s
	(list
	(list 1 2 3)
	(list 4 5 6)
	(list 7 8 9)
	(list 10 11 12)))
	(define w2
	(list
	(list 1 2 3 4)
	(list 4 5 6 7)
	(list 7 8 9 10)
	(list 10 11 12 13)))
	(define v1 (list 1 2 3))
	(define v2 (list 4 5 6))
	(accumulate-n + 0 s)
	(dot-product v1 v2)
	(matrix-*-vector w v1)
	(matrix-*-matrix s w2)

view raw s237.scm hosted with by GitHub

Exercise 2.36.  The procedure accumulate-n is similar to accumulate except that it takes as its third argument a sequence of sequences, which are all assumed to have the same number of elements. It applies the designated accumulation procedure to combine all the first elements of the sequences, all the second elements of the sequences, and so on, and returns a sequence of the results. For instance, if s is a sequence containing four sequences, ((1 2 3) (4 5 6) (7 8 9) (10 11 12)), then the value of (accumulate-n + 0 s) should be the sequence (22 26 30). Fill in the missing expressions in the following definition of accumulate-n:

(define (accumulate-n op init seqs)
(if (null? (car seqs))
nil
(cons (accumulate op init <??>)
(accumulate-n op init <??>))))

	(define (accumulate op initial sequence)
	(if (null? sequence)
	initial
	(op (car sequence)
	(accumulate op initial (cdr sequence)))))
	(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)))))
	(define s
	(list
	(list 1 2 3)
	(list 4 5 6)
	(list 7 8 9)
	(list 10 11 12)))
	(map (lambda (x) (car x)) s)
	(map (lambda (x) (car x)) (map (lambda (x) (cdr x)) s))
	(accumulate-n + 0 s)

view raw s236.scm hosted with by GitHub

Exercise 2.35.  Redefine count-leaves from section 2.2.2 as an accumulation:

(define (count-leaves t)
(accumulate <??> <??> (map <??> <??>)))

	(define nil '())
	(define (accumulate op initial sequence)
	(if (null? sequence)
	initial
	(op (car sequence)
	(accumulate op initial (cdr sequence)))))
	(define (enumerate-tree tree)
	(cond
	((null? tree)
	nil)
	((not (pair? tree))
	(list tree))
	(else
	(append
	(enumerate-tree (car tree))
	(enumerate-tree (cdr tree))))))
	(define (count-leaves t)
	(accumulate
	+
	0
	(map
	(lambda (x)
	(if
	(pair? x)
	(count-leaves x)
	1))
	t)))
	(define tree (list 1 (list 2 (list 3 4)) 5 6 7 8))
	(count-leaves tree) ;; => 7
	(count-leaves (list 1 (list 2 (list 3 4)) 5))

view raw s235.scm hosted with by GitHub

Exercise 2.34.  Evaluating a polynomial in x at a given value of x can be formulated as an accumulation. We evaluate the polynomial

using a well-known algorithm called Horner’s rule, which structures the computation as

In other words, we start with a_n, multiply by x, add a_n-1, multiply by x, and so on, until we reach a₀.¹⁶ Fill in the following template to produce a procedure that evaluates a polynomial using Horner’s rule. Assume that the coefficients of the polynomial are arranged in a sequence, from a₀ through a_n.

(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms) <??>)
0
coefficient-sequence))

For example, to compute 1 + 3x + 5x³ + x⁵ at x = 2 you would evaluate

(horner-eval 2 (list 1 3 0 5 0 1))

	(define (accumulate op initial sequence)
	(if (null? sequence)
	initial
	(op (car sequence)
	(accumulate op initial (cdr sequence)))))
	(define (horner-eval x coefficient-sequence)
	(accumulate
	(lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
	0
	coefficient-sequence))
	(horner-eval 2 (list 1))
	(horner-eval 2 (list 1 3 0 5 0 1))

view raw s234.scm hosted with by GitHub

Exercise 2.33.  Fill in the missing expressions to complete the following definitions of some basic list-manipulation operations as accumulations:

(define (map p sequence)
(accumulate (lambda (x y) <??>) nil sequence))
(define (append seq1 seq2)
(accumulate cons <??> <??>))
(define (length sequence)
(accumulate <??> 0 sequence))

	(define (accumulate op initial sequence)
	(if (null? sequence)
	initial
	(op (car sequence)
	(accumulate op initial (cdr sequence)))))
	(define nil '())
	(define (square x) (* x x))
	(define (map proc sequence)
	(accumulate
	(lambda (x y)
	(cons (proc x) y))
	nil
	sequence))
	(define (append seq1 seq2)
	(accumulate cons seq2 seq1))
	(define (length seq)
	(accumulate
	(lambda (elem sum) (+ 1 sum))
	0
	seq))
	(map square (list 1 2 3))
	(append (list 1 2) (list 3 4 6))
	(length (append (list 1 2) (list 3 4 6)))

view raw s233.scm hosted with by GitHub