2011-11-08

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.

No comments:

Post a Comment