SICP Exercise 2.57: Variable Length Sums and Products

Extend the differentiation program to handle sums and products of arbitrary numbers of (two or more) terms. Then the last example above could be expressed as

(deriv '(* x y (+ x 3)) 'x)

Try to do this by changing only the representation for sums and products, without changing the deriv procedure at all. For example, the addend of a sum would be the first term, and the augend would be the sum of the rest of the terms.

Identifiers and Selectors
Looking at the example extended representation given above we can see that, by keeping to prefix notation, this means that identifying sums and products remains as before, as does obtaining the first term of an expression. In other words, sum?, product?, addend and multiplier remain unchanged from before.

However, we'll need to make changes to augend and multiplicand to deal with the fact that the tail of the list may have one or more elements in it. If there are multiple elements in the tail then we want these procedures to return a new sum or product representation as appropriate, containing the tail of the current list as its operands. On the other hand, if there's only one element then we want these procedures to return that element directly. We should also check to see if the tail is empty - this would be an invalid representation!

Naïvely we might think to express this as follows:

(define (augend s)
  (let ((a (cddr s)))
    (if (pair? a)
        (if (null? (cdr a))
            (car a)
            (make-sum a))
        (error "malformed addition -- AUGEND" s))))

(define (multiplicand p)
  (let ((m (cddr p)))
    (if (pair? m)
        (if (null? (cdr m))
            (car m)
            (make-product m))
        (error "malformed multiplication -- MULTIPLICAND" m))))

However, note that the exercise states "Try to do this by changing only the representation for sums and products, without changing the deriv procedure at all". Look closely at the calls to make-sum and make-product in augend and multiplicand respectively. These pass a single argument that is a list of parameters. On the other hand if we look at deriv we can see that it calls make-product and make-sum with two (non-list) parameters. If we want to leave deriv unchanged we either need to have make-sum and make-product support two different types of arguments (a single list or two arguments), or we need make-sum and make-product to support variable argument lists and have augend and multiplicand call them with a variable number of arguments.

Thankfully, Scheme provides a procedure, apply, that takes two parameters, a procedure and a list, that calls the procedure with the elements of the list as its arguments. This is introduced in this footnote, slightly later in the book (section 2.4.3). By modifying augend and multiplicand to use apply to call make-sum and make-product we can ensure that the latter two procedures are always called from our procedures with multiple arguments.

Here's what the updated procedures look like:

(define (augend s)
  (let ((a (cddr s)))
    (if (pair? a)
        (if (null? (cdr a))
            (car a)
            (apply make-sum a))
        (error "malformed addition -- AUGEND" s))))

(define (multiplicand p)
  (let ((m (cddr p)))
    (if (pair? m)
        (if (null? (cdr m))
            (car m)
            (apply make-product m))
        (error "malformed multiplication -- MULTIPLICAND" m))))

Note that these two procedures are almost identical. We can pull out the commonality into a separate procedure as follows:

(define (get-expression-tail expression constructor errorMessage)
  (let ((t (cddr expression)))
    (if (pair? t)
        (if (null? (cdr t))
            (car t)
            (spply constructor t))
        (error errorMessage t))))

(define (augend s)
  (get-expression-tail s make-sum "malformed addition -- AUGEND"))

(define (multiplicand p)
  (get-expression-tail p make-product "malformed multiplication -- MULTIPLICAND" m))

Constructor Requirements
Now onto making sums and products. We've already indicated that we want these to support variable numbers of arguments, and we were introduced to the syntax for this in exercise 2.20. So our two procedures are going to take the form:

(define (make-sum . a) <body>)
(define (make-product . p) <body>)

As they're taking a variable list of arguments, with no arguments being a valid call, we need to know what to do then... If you ask Scheme to add or multiply with no arguments...

> (+)
0
> (*)
1

...it returns the identity element for the operation. This seems sensible so we'll adopt this for our constructors.

Also we should note that the existing implementations of make-sum and make-product apply reductions to try to express expressions in the simplest terms. We should try to do the same here. At the very least we should support rules equivalent to those the operations had previously:

• For both operations, if you have multiple arguments, one or more of which are the identity element for the operation, then these can be removed from the expression without affecting the outcome.
• For multiplication, if any of the arguments is zero then the result is zero.

Further, note that addition and multiplication are both commutative and associative, so we can reorder the application of the operands to suit us. This can help us reduce expressions extensively. For example:

  1 + (x + 2) + y + 3
= 1 + x + 2 + y + 3
= x + y + 1 + 2 + 3
= x + y + 6

  1 * (x * 2) * y * 3
= 1 * x * 2 * y * 3
= x * y * 1 * 2 * 3
= x * y * 6

In other words, we can:

• "promote" any embedded expressions of the same type as an outer expression, reducing the nesting of expressions
• accumulate the results of applying the operator to any numbers in the expression, replacing all of the numbers with the result
  

Finally, if we're feeling particularly keen we can also do some reductions with symbols. A symbol that appears multiple times in a sum can be replaced with a product, and a symbol that appears multiple times in a product can be replaced with an exponentiation (i.e. for a given operation we can replace a sub-expression that appears n times with the expression that represents applying the next hyperoperation in sequence to the sub-expression and n). For example:

  x + y + x + x
  x + x + x + y
= 3x + y

  x * y * x * x
  x * x * x * y
= x3 * y

In order to do these reductions our constructors will have to make a pass through the operands, recursing on sub-expressions of the same type, count how many times each sub-expression (or symbol) appears and accumulate the numbers appropriately. Then, once we've made the pass we can use the counts of the sub-expressions and the accumulation of the numbers to assemble the overall reduced expression.

Counting Sub-Expressions
So we need some way of keeping a count of how many times each expression occurs. We can do this simply by maintaining a list of lists where each sub-list has two elements: the first being the sub-expression and the second being the count of the number of times it has occurred. When we process a sub-expression in the expression we simply go through this list of lists, try to find the sub-expression and then either increment its count if it's present or adding a new sub-list for the sub-expression with a count of 1 if it isn't:

(define (count-accumulate expression counts)
  (cond ((null? counts) (list (list expression 1)))
        ((equal? expression (caar counts))
         (cons (list expression (+ (cadar counts) 1)) (cdr counts)))
        (else (cons (car counts) (count-accumulate expression (cdr counts))))))

Generating Reduced Expressions
Assuming we've already managed to make our pass through the expression, using count-accumulate to count up occurrences of sub-expressions, and accumulated all the numbers (via either addition or multiplication, depending upon whether this is make-sum or make-product respectively) then we need to generate the final reduced expression. I'm going to make some further assumptions here about what we have to hand:

• We've generated a list of lists, counts, that contains the counts of all the sub-expressions seen in the manner given above.
• We're going to build the reduced expression in a list called reduction. This initially starts with just the accumulation of all the numbers in the original expression.
• There's a procedure to hand called constructor that, given a list, produces the appropriate representation of the expression. E.g. for make-sum, given the list '(x y z 123), will produce the representation '(+ x y z 123).
• There's a procedure to hand called promoter that, given a list containing a sub-expression and the count of times it occurs, produces the expression representing the next hyperoperation in sequence from the one we're dealing with applied to the sub-expression and count.

Why make these assumptions... Well, I've already written a procedure call reduce that ties everything together that both make-sum and make-product use to generate their reduced expressions!

Anyway, given those assumptions, we just need to run through the counts list and, for each sub-expression, either add it directly to the reduction if it only occurs once or use promoter to reduce multiple occurrences of a sub-expression to a single sub-expression. Having run through all of the sub-expressions in counts we can then check the length of the reduction we've produced: if there's more than one element in the reduction then use constructor to produce the final expression, otherwise we can just return that single element directly (as the expression '(+ 4) is equivalent to 4). Here's the procedure:

(define (generate counts reduction)
  (cond ((null? counts) (if (= (length reduction) 1)
                               (car reduction)
                               (constructor reduction)))
        ((= (cadar counts) 1) (generate (cdr counts)
                                        (cons (caar counts) reduction)))
        (else (generate (cdr counts)
                        (cons (promoter (car counts)) reduction)))))

Putting the Reducer Together
Okay, so the final piece of the picture is to produce a procedure that performs reductions using these two helpers. Here's what it needs to do:

1. Start with an empty reduction and an accumulated total for the numeric values in the expression of the identity element for the operator.
2. Iterate through the intial expression.
3. For each element of the expression check the type of each element of the expression and:
   • If it's a number then accumulate the value into a running total using the appropriate accumulator operation (i.e. + for make-sum and * for make-product).
   • If it's a sub-expression and its operator is of the same type as the expression we're trying to reduce then, as we're dealing with associative operations, process the sub-expression as part of the reduction.
   • Otherwise increment the count of the number of times we've seen this sub-expression or symbol.
4. Finally generate the reduced expression:
   • If there were no non-numeric elements in the expression then the reduction is just the accumulated total of the expression.
   • If the accumulated total is equal to the identity element for the operation then use generate to produce the reduction using just the counts of occurrences of sub-expressions. I.e. drop the accumulated total.
   • Otherwise use generate to produce the reduction using both the counts of occurrences of sub-expressions and the accumulated total.

Here's my reducer:

(define (reduce is-op? constructor promoter accumulator identity-element expression)
  (define (generate counts reduction)
    (cond ((null? counts) (if (= (length reduction) 1)
                                 (car reduction)
                                 (constructor reduction)))
          ((= (cadar counts) 1) (generate (cdr counts)
                                          (cons (caar counts) reduction)))
          (else (generate (cdr counts)
                          (cons (promoter (car counts)) reduction)))))
  (define (count-accumulate expression counts)
    (cond ((null? counts) (list (list expression 1)))
          ((equal? expression (caar counts))
           (cons (list expression (+ (cadar counts) 1)) (cdr counts)))
          (else (cons (car counts) (count-accumulate expression (cdr counts))))))
  (define (process expression counts accumulation)
    (cond ((null? expression)
           (cond ((null? counts) accumulation)
                 ((= accumulation identity-element) (generate counts '()))
                 (else (generate counts (list accumulation)))))
          ((number? (car expression))
           (process (cdr expression)
                    counts
                    (accumulator (car expression) accumulation)))
          ((and (pair? (car expression)) (is-op? (car expression)))
           (process (append (cdar expression) (cdr expression))
                    counts
                    accumulation))
          (else (process (cdr expression)
                         (count-accumulate (car expression) counts)
                         accumulation))))
  (if (and (pair? expression) (not (null? (cdr expression))))
      (process expression '() identity-element)
      (error "invalid expression -- REDUCE" expression)))

Constructors
Now at long last we can produce our constructors. For sums this is straightforward. We simply need to produce a couple of λ-expressions for constructor and promoter. The former simply tags the given list with the '+ symbol, while the latter can simply apply make-product to the given list. Then we can plug these, along with the appropriate other values, into reduce:

(define (make-sum . a)
  (reduce sum?
          (lambda (x) (cons '+ x))
          (lambda (x) (apply make-product x))
          +
          0
          a))

make-product requires a little bit extra work, as we need to consider what happens when the accumulation (i.e. product) of the numbers in the expression is 0. When that is the case we want the overall reduction to simply be 0, rather than a product expression with a numeric component of 0. The procedure reduce will not achieve this itself. However, we can simply check the numeric component of the resulting reduction to see if it's 0 and, if so, return 0. Now reduce puts the numeric component of the reduced expression, if there is one, at the end of the reduction, so we need test the last element of the list returned by reduce.

Producing a procedure to obtain the last element of a list is straightforward... Here's one I made earlier:

(define (last l)
  (cond ((and (pair? l) (null? (cdr l))) (car l))
        ((pair? l) (last (cdr l)))
        (else (error "invalid or empty list -- LAST" l))))

We can use that in make-product as follows:

(define (make-product . p)
  (let ((reduction (reduce product?
                           (lambda (x) (cons '* x))
                           (lambda (x) (make-exponentiation (car x) (cadr x)))
                           *
                           1
                           p)))
    (if (and (pair? reduction)
             (number? (last reduction))
             (= (last reduction) 0))
        0
        reduction)))

With these in place, let's see them in action:

> (make-sum 'a 'b 'c 1 2 3 'c 'd 'e 4 5 6 'a 'd 'f)
'(+ f e (* d 2) (* c 2) b (* a 2) 21)
> (make-product 'a 'b 'c 1 2 3 'c 'd 'e 4 5 6 'a 'd 'f)
'(* f e (** d 2) (** c 2) b (** a 2) 720)
> (make-sum 1 2 3)
6
> (make-product 4 5 6)
120
> (make-sum 'a 'a 'a)
(* a 3)
> (make-product (make-sum 'a 'b) (make-sum 'a 'b))
(** (+ b a) 2)

Note that reduce isn't quite perfect... It doesn't always manage to reduce an expression to its simplest terms when it contains sub-expressions that have already been reduced. For example:

> (make-product (make-product (make-sum 'a 'b) (make-sum 'a 'b)) (make-sum 'a 'b))
(* (+ b a) (** (+ b a) 2))
> (make-sum (make-sum 'a 'a) 'a)
(+ a (* a 2))

While this could be reduced further (to (** (+ b a) 3) and (* a 3) respectively), I'm happy to leave it at this point. It's still giving valid results... and I've already spent quite a bit more time on this exercise than I'd intended!

And now for some derivatives...
Finally we can check that deriv works. To begin with, here are the examples from the book:

> (deriv '(+ x 3) 'x)
1
> (deriv '(* x y) 'x)
y
> (deriv '(* (* x y) (+ x 3)) 'x)
(+ (* (+ x 3) y) (* y x))

Here's the example from the exercise specification...

> (deriv '(* x y (+ x 3)) 'x)
(+ (* y (+ x 3)) (* y x))

Note that it gets the right answer, but has managed to swap the components of the first product around. This is fine as, since we noted before, multiplication is commutative.

SICP Exercise 2.56: Differentiating Exponentials

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

d(un) = nxn-1 du
 dx          dx

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.

Let's start with the procedures... And in fact let's do them in the reverse order in which they're listed above, and start with make-exponentiation. Like the implementations of make-sum and make-product we want to build in some rules that reduce the expression to its simplest form. For exponents we can define the following reductions:

• 1 raised to the power of anything is 1.
• Anything raised to the power of 0 is 1.
• Anything raised to the power of 1 is itself.
• If both the base and the exponent are numbers then make-exponentiation can calculate and return the exponent.

In any other case we simply build up the appropriate list representation and return that. This gives us the following implementation:

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

Let's check this works:

> (make-exponentiation 1 24)
1
> (make-exponentiation 2 4)
16
> (make-exponentiation 'a 3)
(** a 3)
> (make-exponentiation 5 'b)
(** 5 b)
> (make-exponentiation 'a 'b)
(** a b)
> (make-exponentiation 'a 1)
a
> (make-exponentiation 'a 0)
1
> (make-exponentiation 4 1)
4
> (make-exponentiation 4 0)
1

The selectors and predicates then just follow the same pattern as the equivalents for sums and products:

(define (base x) (cadr x))
(define (exponent x) (caddr x))
(define (exponentiation? x)
  (and (pair? x) (eq? (car x) '**)))

And again, a quick test:

> (base (make-exponentiation 'a 'b))
a
> (exponent (make-exponentiation 'a 'b))
b
> (exponentiation? (make-exponentiation 'a 'b))
#t
> (exponentiation? (make-product 'a 'b))
#f

All we need to do now is to extend deriv, adding a clause that uses exponentiation? to test whether or not the expression is an exponentiation and, if it is, applies the differentiation rule:

(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))))

Let's give this a spin:

> (deriv (make-exponentiation 'a 5) 'a)
(* 5 (** a 4))
> (deriv (make-exponentiation 'a 'b) 'a)
(* b (** a (+ b -1)))
> (deriv (make-exponentiation 'a (make-sum 'a 'b)) 'a)
(* (+ a b) (** a (+ (+ a b) -1)))

SICP Exercise 2.55: Quoted Quotes

Eva Lu Ator types to the interpreter the expression

(car ''abracadabra)

To her surprise, the interpreter prints back quote. Explain.

As noted in footnote 34, the single quotation mark is equivalent to the special form quote... and in fact the single quotation mark is simply an abbreviation for quote. So the interpreter will process Eva's expression as if it were:

(car (quote (quote abracadabra)))

The outer quote quotes the inner expression, and so produces the list:

'(quote abracadabra)

car then returns the first element from this - i.e. quote.

SICP Exercise 2.54: Equal Lists

Two lists are said to be equal? if they contain equal elements arranged in the same order. For example,

(equal? '(this is a list) '(this is a list))

is true, but

(equal? '(this is a list) '(this (is a) list))

is false. To be more precise, we can define equal? recursively in terms of the basic eq? equality of symbols by saying that a and b are equal? if they are both symbols and the symbols are eq?, or if they are both lists such that (car a) is equal? to (car b) and (cdr a) is equal? to (cdr b). Using this idea, implement equal? as a procedure.

The footnote in this exercise indicates that eq? may not be a reliable test of whether two numbers are equal. I.e. even if (= a b) evaluates to #t, you're not guaranteed that (eq? a b) will also evaluate to #t. Let's try to produce a solution that will not just cope with symbols correctly, but also numbers.

If we sneak a peak at the next sections in the book we're told about the predicates:

• number?, which identifies numbers ("The differentiation program with abstract data")
• symbol?, which identifies symbols ("Representing algebraic expressions")

If we extend the definition of equal? above so that it also includes the condition that if a and b are both numbers then a and b are equal? if the numbers are = then this should give us what we want.

We can then implement equal? as a cond expression, with a clause for each of the conditions we need to test for. Each clause's predicate needs to test that both a and b are of the same type and, if so, apply the appropriate logic to determine whether they're equal or not. We'll also need a final else clause that will catch all the cases where a and b are of different types - in these cases we know that a and b are not equal?, and so we can return #f.

Here's the procedure I produced:

(define (equal? a b)
  (cond ((and (pair? a) (pair? b))
           (and (equal? (car a) (car b)) (equal? (cdr a) (cdr b))))
        ((and (null? a) (null? b)) #t)
        ((and (number? a) (number? b)) (= a b))
        ((and (symbol? a) (symbol? b)) (eq? a b))
        (else #f)))

Let's give it a spin:

> (equal? '(this is a list) '(this is a list))
#t
> (equal? '(this is a list) '(this (is a) list))
#f
> (equal? (list 1 2 3 4) '(1 2 3 4))
#t
> (equal? (list 'a 'b 'c) '(a b c))
#t
> (equal? (list 1 2 'a 4) '(1 2 3 4))
#f