SICP Exercise 2.58: Infix Operators... Part (b)... The Hard Version

Suppose we want to modify the differentiation program so that it works with ordinary mathematical notation, in which + and * are infix rather than prefix operators. Since the differentiation program is defined in terms of abstract data, we can modify it to work with different representations of expressions solely by changing the predicates, selectors, and constructors that define the representation of the algebraic expressions on which the differentiator is to operate.

1. Show how to do this in order to differentiate algebraic expressions presented in infix form, such as (x + (3 * (x + (y + 2)))). To simplify the task, assume that + and * always take two arguments and that expressions are fully parenthesized.
2. The problem becomes substantially harder if we allow standard algebraic notation, such as (x + 3 * (x + y + 2)), which drops unnecessary parentheses and assumes that multiplication is done before addition. Can you design appropriate predicates, selectors, and constructors for this notation such that our derivative program still works?

In the previous post we dealt with part (a) of this exercise which allowed us to ignore the associativity of the operations and just handle infix expressions with two operands. In this post we not only need to deal with variable numbers of operands (which we dealt with for prefix notation in exercise 2.57)... The example above contains a mix of operators at the same level within the expression. This means we'll also need to deal with operator precedence.

Dealing With Precedence
At the moment our program only deals with three different kinds of operations: exponentiation, multiplication and addition. The normal order of precedence for these operations is the order in which they've just been listed. I.e. exponentiation binds more tightly than multiplication, which binds more tightly than addition. Of course we've also got parenthesized sub-expressions to consider - but, as we're representing our expressions as Scheme lists this doesn't actually cause us any additional precedence headaches. Provided we simply treat the sub-expression (which is a list) as an operand of the operator to which it is bound, and then process the sub-expression itself as if it were its own expression, all will be fine.

So how can we deal with standard algebraic notation and still have deriv work then? Well, one way is to treat the expression as if it were appropriately parenthesized according to the precedence rules, binding the operands for the highest precedence operators first. For example, we can treat the expression (a + b * c ** d * e + f ** g) as if it were parenthesized as (a + (b * (c ** d) * e) + (f ** g)). I.e. we should treat this expression as a sum with three operands - the symbol a, a sub-expression that's the product b * (c ** d) * e, and the exponentiation f ** g. We should then also be able to apply the reduction process we built in exercise 2.57 (or a variant of it) to this to simplify expressions as much as is possible (or at least as much as is possible using reduce!).

In order to do this we first need a way to identify what the lowest precedence operator in an expression is (ignoring sub-expressions). This effectively provides us with our groupings. For example, the lowest precedence operator in (a + b * c ** d * e + f ** g) is +. If we then divide the expression up into sub-expressions around the occurrences of + we get the expression (a + (b * c ** d * e) + (f ** g)). We can then repeat this for the sub-expressions we've created: the lowest precedence operation in (b * c ** d * e) is *, so that allows us to divide that sub-expression up into (b * (c ** d) * e), while the lowest precedence operation in (f ** g) is **, so there's no further division to do there.

Let's start by defining our operators in a list, ordered by precedence:

(define operators '(+ * **))

We can then get the precedence of an operator by getting its index in the list. First, let's define a general procedure for getting the index of an element in a list. This can simply iterate through the list, accumulating a count until it finds a matching element. I'll use zero-based indexes, and have my procedure return -1 if the element isn't present:

(define (get-index element alist)
  (define (find-element-index index remaining)
    (cond ((null? remaining) -1)
          ((eq? element (car remaining)) index)
          (else (find-element-index (+ index 1) (cdr remaining)))))
  (find-element-index 0 alist))

Here it is in action:

> (get-index '+ operators)
0
> (get-index '** operators)
2
> (get-index 'wibble operators)
-1

We can then wrap get-index in a procedure that gets the precedence of a given operator, or reports an error if it's not a valid operator:

(define (precedence op)
  (let ((index (get-index op operators)))
    (if (>= index 0)
        index
        (error "Unknown operation -- PRECEDENCE" op))))

So let's test that with the same symbols:

> (precedence '+)
0
> (precedence '**)
2
> (precedence 'wibble)
. . Unknown operation -- PRECEDENCE wibble

Of course it's worth noting that, were we dealing with a larger or different set of operations then this simplistic approach to operator precedence would not necessarily work. This is due to some operations, such as subtraction or division, sharing the same precedence as other operations: subtraction has the same precedence as addition while division has the same precedence as multiplication. We could solve this by redefining operators as a list of lists such as '((+ -) (* /) (**)), and then find the index of the list that the operator is a member of, rather than just finding the index of the matching element. However, to keep everything simple, both here and in the rest of the exercise, I'm going to stick to our limited set of three operations!

Determining an Expression's Operation Type
As noted above, we want to treat expressions as if they were appropriately parenthesized according to the precedence rules, and to do this we want to identify what the lowest precedence operator in an expression is. We've produced precedence, which will tell us what the precedence of an operator is. All we need to do now is iterate through the elements of an expression, find all the operators in it and figure out which has the lowest precedence.

First, let's build a helper procedure to figure out whether or not a value is an operator. We can do this simply by asking for its index in the list of operators and checking that it's non-negative:

(define (operator? op)
  (>= (get-index op operators) 0))

We can then use accumulate (introduced in the Sequence Operations sub-section in section 2.2.3) to process the expression. For each element of the expression this needs to check whether or not it's an operator and, if it is, check its precedence against that of the lowest precedence operator found so far. If it's got a lower precedence then we change the accumulated value to this new operator, otherwise we keep the current operator.

(define (get-operation expression)
  (accumulate
    (lambda (x y)
      (if (and (operator? x)
               (or (null? y) (< (precedence x) (precedence y))))
          x
          y))
    '()
    expression))

You'll note that I've used '() as the initial value. I'm not overly happy with this, and it probably betrays my C/C++/Java background somewhat... I could have made the assumption that every expression has a valid operator in it and used the highest precedence operator (i.e. **) as the initial value. If I'd done this then I could omit the null? check here. However, it feels more correct to me to start from a position of not making such an assumption and not knowing what the operator is. To do this we need a value which is easily testable and is guaranteed not to be an operator. I really want to use a null value here (like I say, C/C++/Java background), but as Scheme doesn't, as far as I'm aware, support these, I'm using the empty list instead...

Anyway, here it is in action:

> (get-operation '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'+
> (get-operation '(1 * 3))
'*
> (get-operation '(1 ** 3 * 2))
'*
> (get-operation '(1 + x * 3))
'+
> (get-operation '(1 ** y))
'**

We can then redefine sum?, product? and exponentiation in terms of get-operation, as all they need to do is check whether or not the operator returned by get-operation is the correct one for the type in question. As all three procedures perform the same test, differing only in the operation symbol, I extracted a helper procedure, is-operation? and had all three procedures delegate to this:

(define (is-operation? op expression)
  (and (pair? expression) (eq? (get-operation expression) op)))

(define (sum? x)
  (is-operation? '+ x))

(define (product? x)
  (is-operation? '* x))

(define (exponentiation? x)
  (is-operation? '** x))

Using the same expressions as before we can put this to the test:

> (sum? '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
#t
> (sum? '(1 * 3))
#f
> (sum? '(1 ** 3 * 2))
#f
> (sum? '(1 + x * 3))
#t
> (sum? '(1 ** y))
#f
> (product? '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
#f
> (product? '(1 * 3))
#t
> (product? '(1 ** 3 * 2))
#t
> (product? '(1 + x * 3))
#f
> (product? '(1 ** y))
#f
> (exponentiation? '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
#f
> (exponentiation? '(1 * 3))
#f
> (exponentiation? '(1 ** 3 * 2))
#f
> (exponentiation? '(1 + x * 3))
#f
> (exponentiation? '(1 ** y))
#t

Selectors
In exercise 2.57 we are told that we can cope with arbitrary numbers of terms by having the selector for the left-hand side of an operator return the first term and the selector for the right hand side of an operator returning the rest of the terms: "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."

To do this with infix expressions we need to identify the first occurrence of the operator in a given expression and return the sub-list either preceding or following this element as appropriate. We can then use these to iterate through an expression with a known lowest precedence operator and divide it up into sub-expressions. Of course we'll need to cope with the situation that will then occur when we get to the last sub-expression - there will be no occurrence of the lowest precedence operator left. In this case the sub-list preceding the "first occurrence" of the operator should be the last sub-expression, while the sub-list following the "first occurrence" of the operator should be the empty list. This is consistent with exercise 2.57 and allows us to easily test when we've processed the last sub-expression (i.e. we test whether or not the sub-list following the first occurrence of the operator is null).

Now Scheme provides a procedure, list-tail, that returns the tail of a list from a particular index onwards... and we've already built a procedure, get-index, that returns the index of an element in a list. We can plug these together to produce a procedure that will give us what we need:

(define (get-list-expression-after-op op expression)
  (let ((index (get-index op expression)))
    (if (< index 0)
        '()
        (list-tail expression (+ index 1)))))

Note that we need to put in an explicit check of the index as, under DrRacket at least, calling list-tail with a negative number returns the entire list, whereas we want it to return the empty list in such a case.

Also note that this procedure always returns a list. However, to keep our selectors for the right-hand sides of operators consistent with the preceding exercises, if there's only a single element in the list we need it to return the element itself, not the list. While we could modify the procedure appropriately, I'm actually going to produce a wrapper procedure that gives us what we need (as we'll need the original procedure when we come on to modifying reduce):

(define (get-expression-after-op op expression)
  (let ((tail (get-list-expression-after-op op expression)))
    (if (and (pair? tail) (null? (cdr tail)))
        (car tail)
        tail)))

Unfortunately, scheme doesn't appear to provide a complementary procedure to list-tail for getting the head of a list. However, it's not that difficult to build up a procedure that gets the first n items of a list. As before we'll have two procedures here: one to get the list preceding the first occurrence of an operation (or the whole list if it doesn't appear), and one to get that list and, if it only contains one element, return the element instead of the list:

(define (get-list-expression-before-op op expression)
  (define (build-expression l)
    (if (or (null? l) (eq? (car l) op))
        '()
        (cons (car l) (build-expression (cdr l)))))
  (build-expression expression))

(define (get-expression-before-op op expression)
  (let ((head (get-list-expression-before-op op expression)))
    (if (null? (cdr head))
        (car head)
        head)))

Let's put these to the test:

> (get-expression-before-op '+ '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(1 * 3 * 5 ** 7)
> (get-expression-after-op '+ '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(3 ** 4 + 4)
> (get-expression-before-op '* '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
1
> (get-expression-after-op '* '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(3 * 5 ** 7 + 3 ** 4 + 4)
> (get-expression-before-op '** '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(1 * 3 * 5)
> (get-expression-after-op '** '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(7 + 3 ** 4 + 4)
> (get-expression-before-op '+ '(1 * 3 * 5 ** 7 + 3))
'(1 * 3 * 5 ** 7)
> (get-expression-after-op '+ '(1 * 3 * 5 ** 7 + 3))
3
> (get-expression-before-op '- '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(1 * 3 * 5 ** 7 + 3 ** 4 + 4)
> (get-expression-after-op '- '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'()

It's worth noting the last case here - if the operator is not present in the expression then the whole expression is "before" it, and nothing is "after" it.

Okay, now we can easily build our selectors using these:

(define (addend s) (get-expression-before-op '+ s))
(define (augend s) (get-expression-after-op '+ s))

(define (multiplier s) (get-expression-before-op '* s))
(define (multiplicand s) (get-expression-after-op '* s))

(define (base s) (get-expression-before-op '** s))
(define (exponent s) (get-expression-after-op '** s))

And here they are in action:

> (sum? '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
#t
> (addend '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(1 * 3 * 5 ** 7)
> (augend '(1 * 3 * 5 ** 7 + 3 ** 4 + 4))
'(3 ** 4 + 4)
> (addend '(3 ** 4 + 4))
'(3 ** 4)
> (augend '(3 ** 4 + 4))
4
> (product? '(1 ** 3 * 2))
#t
> (multiplier '(1 ** 3 * 2))
'(1 ** 3)
> (multiplicand '(1 ** 3 * 2))
2
> (exponentiation? '(1 ** y))
#t
> (base '(1 ** y))
1
> (exponent '(1 ** y))
'y

Reduce, Reuse, Recycle
In exercise 2.57 we produced the procedure reduce that would reduce an expression to a simpler form. We should be able to reuse it here, with some adjustments, to perform the same reductions for infix expressions. We can reuse the main body of the procedure and count-accumulate directly, as these deal with expressions as atomic units - they don't deal with any of the internals of the representation. However, both generate and count-accumulate need a few changes. Let's start with generate.

We still want generate to check whether or not we have any expression counts and just return the accumulation of the numeric values if we don't. However, we're trying to generate a different expression now. I had a think about it and decided that a better way to approach the production of expressions was to:

1. No longer delegate the insertion of operators to passed in procedures - they're all using infix notation, so rather than repeat the same pattern of insertion in each constructor we can simply have the constructor pass in the appropriate symbols for the two operations we need to know about: the normal operation to insert between each sub-expression and the operation to use when promoting a sub-expression that occurs multiple times. I've assumed these are in scope as operation and promoted-op respectively.
2. Include the accumulation into the sub-expression counts. If we append it to the end of the list of counts as having occurred once then we can process all of the sub-expressions and the accumulation at once.
3. Map the counts across into a list of sub-expressions (where they occurred once) and promoted sub-expressions (where they occurred multiple times). I.e. we can use map to examine each {sub-expression, count} tuple and, if the count is 1, map it to the sub-expression, otherwise promote it.
4. Iterate through the mapped list and insert the operation's symbol between each mapped sub-expression. To do this we can use fold-left from exercise 2.38, start with an initial value of a list containing the first mapped sub-expression only and then, for each subsequent sub-expression, append the operator and the sub-expression to this list.

Here's my implementation:

(define (generate counts accumulation)
    (if (null? counts)
        accumulation
        (let ((full-reduction (if (= accumulation identity-element)
                                  counts
                                  (append counts (list (list accumulation 1))))))
          (let ((promoted-reduction (map (lambda (x) (if (= (cadr x) 1)
                                                         (car x)
                                                         (list (car x)
                                                               promoted-op
                                                               (cadr x))))
                                         full-reduction)))
            (if (null? (cdr promoted-reduction))
                (car promoted-reduction)
                (fold-left (lambda (x y) (append x (list operation y)))
                           (list (car promoted-reduction))
                           (cdr promoted-reduction)))))))

Now let's move on to process... First note that we've managed to simplify the null case. The updated generate now copes with the case when the accumulation equals the identity element, so we can simplify process's handling so that it just calls generate. Numbers can just be dealt with as before, as can the case when the head of the expression is not a sub-expression of the operation type we're reducing for. The only remaining case is when the head of the expression is a sub-expression of the operation type we're reducing for. In this case we can use is-operation? as the test - after all we've made the assumption that the operation we're processing for is in scope as operation, so there's no need to have an explicit procedure to test this passed in! The append that takes place is slightly different though. We're no longer dealing with prefix operators, so we can't just lop the top off the sub-expression and append that in front of the tail of the expression. Instead we need to split the sub-expression around the operator, and append both of these sub-expressions, in order, in front of the tail of the expression.

As usual, this can be expressed more cleaning in code than in English:

(define (process expression counts accumulation)
  (cond ((null? expression) (generate counts accumulation))
        ((number? (car expression))
         (process (cdr expression)
                  counts
                  (accumulator (car expression) accumulation)))
        ((is-operation? operation (car expression))
         (process (append (get-list-expression-before-op operation (car expression))
                          (get-list-expression-after-op operation (car expression))
                          (cdr expression))
                  counts
                  accumulation))
        (else (process (cdr expression)
                       (count-accumulate (car expression) counts)
                       accumulation))))

Putting all this together gives us a new version of reduce as follows:

(define (reduce operation promoted-op accumulator identity-element expression)
  (define (generate counts accumulation)
    (if (null? counts)
        accumulation
        (let ((full-reduction (if (= accumulation identity-element)
                                  counts
                                  (append counts (list (list accumulation 1))))))
          (let ((promoted-reduction (map (lambda (x) (if (= (cadr x) 1)
                                                         (car x)
                                                         (list (car x)
                                                               promoted-op
                                                               (cadr x))))
                                         full-reduction)))
            (if (null? (cdr promoted-reduction))
                (car promoted-reduction)
                (fold-left (lambda (x y) (append x (list operation y)))
                           (list (car promoted-reduction))
                           (cdr promoted-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) (generate counts accumulation))
          ((number? (car expression))
           (process (cdr expression)
                    counts
                    (accumulator (car expression) accumulation)))
          ((is-operation? operation (car expression))
           (process (append (get-list-expression-before-op operation (car expression))
                            (get-list-expression-after-op operation (car 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)))

It's then a simple matter to modify make-sum and make-product to use this:

(define (make-sum . a)
  (reduce '+ '* + 0 a))

(define (make-product . p)
  (let ((reduction (reduce '* '** * 1 p)))
    (if (and (pair? reduction)
             (number? (last reduction))
             (= (last reduction) 0))
        0
        reduction)))

And to complete the set we can modify make-exponentiation so that it too uses infix notation:

(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 make some expressions!

> (make-sum 'a 'b 'c 1 2 3 'c 'd 'e 4 5 6 'a 'd 'f)
'((a * 2) + b + (c * 2) + (d * 2) + e + f + 21)
> (make-product 'a 'b 'c 1 2 3 'c 'd 'e 4 5 6 'a 'd 'f)
'((a ** 2) * b * (c ** 2) * (d ** 2) * e * f * 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))
'((a + b) ** 2)

Derive Me Crazy!
And, without further ado (or any changes to deriv), here it is in action:

> (deriv (make-product 'x 'y (make-sum 'x 3)) 'x)
'((x * y) + (y * (x + 3)))
> (deriv (make-product (make-product 'x 'y) (make-sum 'x 3)) 'x)
'((x * y) + (y * (x + 3)))
> (deriv (make-exponentiation 'a (make-sum 'a 'b)) 'a)
'((a + b) * (a ** (a + b + -1)))

SICP Exercise 2.58: Infix Operators... Part (a), The Easy Teen-age New York Version

Suppose we want to modify the differentiation program so that it works with ordinary mathematical notation, in which + and * are infix rather than prefix operators. Since the differentiation program is defined in terms of abstract data, we can modify it to work with different representations of expressions solely by changing the predicates, selectors, and constructors that define the representation of the algebraic expressions on which the differentiator is to operate.

1. Show how to do this in order to differentiate algebraic expressions presented in infix form, such as (x + (3 * (x + (y + 2)))). To simplify the task, assume that + and * always take two arguments and that expressions are fully parenthesized.
2. The problem becomes substantially harder if we allow standard algebraic notation, such as (x + 3 * (x + y + 2)), which drops unnecessary parentheses and assumes that multiplication is done before addition. Can you design appropriate predicates, selectors, and constructors for this notation such that our derivative program still works?

Given that the last exercise took somewhat longer than I'd intended, and in an attempt to regain some momentum, I've decided I'll split this exercise into two posts, one for each part of this question. In this post we'll deal with part (a) only, which allows us to ignore the associativity of the operations and just handle infix expressions with two operands.

This will be the shorter of the two posts...

Let's look at the difference between the prefix notation introduced in the book (i.e. prior to the work we did in exercise 2.57) and what we need for the first part of the exercise. In the book we represent ax + b as (+ (* a x) b), while for this part we want to be able to support representing it as ((a * x) + b). In both cases we have a 3-tuple at each level within the expression consisting of an operator and two operands. The difference between the prefix and infix notations is simply that in the former the operator is the first element of the tuple, whilst in the latter it is the second element.

Given that the sole difference between the two notations is the location of the operator (and, by implication, the first operand) we should be able to take the basic implementation of the program we have from the book and exercise 2.56 and simply change the procedures that will be affected by this change in ordering. I.e. the tests, constructors and the selectors for the first operand.

So our tests become:

(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))

(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))

(define (exponentiation? x)
  (and (pair? x) (eq? (cadr x) '**)))

...and the constructors become:

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

...and the selectors for the first operand become:

(define (addend s) (car s))

(define (multiplier p) (car p))

(define (base x) (car x))

The remainder of our program is unchanged.

So let's construct some expressions:

> (make-sum 'x 3)
'(x + 3)
> (make-product 'x 'y)
'(x * y)
> (make-product (make-product 'x 'y) (make-sum 'x 3))
'((x * y) * (x + 3))
> (make-exponentiation 'a 'b)
'(a ** b)
> (make-exponentiation 'a (make-sum 'a 'b))
'(a ** (a + b))

All looks good, so let's try a few tests:

> (sum? (make-sum 'x 3))
#t
> (product? (make-sum 'x 3))
#f
> (product? (make-product 'x 'y))
#t
> (exponentiation? (make-product 'x 'y))
#f
> (exponentiation? (make-exponentiation 'a 'b))
#t
> (sum? (make-exponentiation 'a 'b))
#f

And let's check the selectors:

> (addend (make-sum 'x 3))
'x
> (augend (make-sum 'x 3))
3
> (multiplier (make-product 'x 'y))
'x
> (multiplicand (make-product 'x 'y))
'y
> (base (make-exponentiation 'a (make-sum 'a 'b)))
'a
> (exponent (make-exponentiation 'a (make-sum 'a 'b)))
'(a + b)

Finally, let's test that deriv still works:

> (deriv (make-sum 'x 3) 'x)
1
> (deriv (make-product 'x 'y) 'x)
'y
> (deriv (make-product (make-product 'x 'y) (make-sum 'x 3)) 'x)
'((x * y) + (y * (x + 3)))
> (deriv (make-exponentiation 'a (make-sum 'a 'b)) 'a)
'((a + b) * (a ** ((a + b) + -1)))

All appears in order, so now onto part (b)...

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.