<< Previous exercise (2.57) | Index | Next exercise (2.59) >>
I think sgm's (precedence op) procedure is wrong as it returns an error for non-operators, after searching the table, but instead it could return the max operator precedence:10000
Part A is pretty straight forward, we will just change the representation of the date:
(define (make-sum a1 a2) (cond ((=number? a1 0) a2) ((=number? a2 0) a1) (else (list a1 '+ a2)))) (define (sum? x) (and (pair? x) (eq? (cadr x) '+))) (define (addend s) (car s)) (define (augend s) (caddr s)) (define (make-product m1 m2) (cond ((=number? m1 1) m2) ((=number? m2 1) m1) ((or (=number? m1 0) (=number? m2 0)) 0) (else (list m1 '* m2)))) (define (product? x) (and (pair? x) (eq? (cadr x) '*))) (define (multiplier x) (car x)) (define (multiplicand x) (caddr x))
For part B, since we can't use cadr to get the augend or the multiplicand because they might be more than one item, so we have to use cddr, but the problem with cddr is that it always returns a list, so we're going to use a cleaning procedure.
(define (cleaner sequence) (if (null? (cdr sequence)) (car sequence) sequence)) (define (augend x) (cleaner (cddr x))) (define (multiplicand x) (cleaner (cddr x)))
Here, we only think about sum expression and product expression. so if there is a '+ in the list, we think it's a sum expression, otherwise is a product expression. addend, multiplier is the part before '+, '* respectly in the list, augend, multiplicand is the part after '+, '* in the list. we only have to change predicates, selectors and constructors to solve the problem.
(define (operation expr) (if (memq '+ expr) '+ '*)) (define (sum? expr) (eq? '+ (operation expr))) (define (addend expr) (define (iter expr result) (if (eq? (car expr) '+) result (iter (cdr expr) (append result (list (car expr)))))) (let ((result (iter expr '()))) (if (= (length result) 1) (car result) result))) (define (augend expr) (let ((result (cdr (memq '+ expr)))) (if (= (length result) 1) (car result) result))) (define (product? expr) (eq? '* (operation expr))) (define (multiplier expr) (define (iter expr result) (if (eq? (car expr) '*) result (iter (cdr expr) (append result (list (car expr)))))) (let ((result (iter expr '()))) (if (= (length result) 1) (car result) result))) (define (multiplicand expr) (let ((result (cdr (memq '* expr)))) (if (= (length result) 1) (car result) result)))
one more option is to canonize (preprocess) given representation first, eg into fully parenthesized prefix notation. and _then_ do straightforward deriv computation. one advantage is that you probably can detect and transform number of representations. but haven't gotten to trying it out. otherwise @meteorgan's solution looks the best, simplest, even lacking generality.
It seems @meteorgan 's answer has some topo error.
;; Parse error: Closing paren missing.
(define (addend expr) (define (iter expr result) (if (eq? (car expr) '+)
assume prefix expression ( '(+ x y) ) ?
I agree with "brave one", that the most appropriate option is to preprocess the representation first to provide precedence. This gives the advantage of separating concerns, keeping "deriv" simple and unchanged, and having a separate process for establishing precedence. This I think is in the spirit of how scheme works in general - the data requires a transformation that is easier to deal with. Anyway, here is my solution to parse the input before it is applied to "deriv":
(define (parse-precedence exp)
(define (simplest-term? exp)
(or (variable? exp) (number? exp)))
(define (build-multiplier-precedence exp)
(list (parse-precedence (multiplier exp))
'*
(parse-precedence (multiplicand exp))))
(define (iterate exp result)
(cond ((null? exp) result)
((simplest-term? exp) exp)
((and (> (length exp) 2) (product? exp))
(iterate (cdddr exp)
(cons (build-multiplier-precedence exp) result)))
(else
(iterate (cdr exp)
(cons (parse-precedence (car exp)) result)))))
(iterate exp '()))
The above assumes we are only dealing with multiplication, and that the input is well formed.
The approach is to recursively parse each element, looking ahead for a product and applying the precedence accordingly. This is an O(n) process, with the advantage of applying simplicity to the problem, and separating the application of precedence from the problem of finding the derivative.
I did this a while ago and had the same idea of converting the notation from infix to prefix first in one pass, but all of the solutions were stack-based (possibly inspired by the shunting yard algorithm) instead of recursion-based that feels more natural for SICP. Anyways here is my solution in Racket that converts from infix to prefix notation recursively:
(define (precedence op) (cond [(eq? op '+) 0] [(eq? op '*) 1] [(eq? op '**) 2])) (define (operator? x) (or (eq? x '+) (eq? x '*) (eq? x '**))) (define (min-operator expr) (accumulate (lambda (x y) (if (and (operator? x) (or (null? y) (< (precedence x) (precedence y)))) x y)) nil expr)) (define (memq-before item x) (cond [(null? x) nil] [(eq? item (car x)) nil] [else (cons (car x) (memq-before item (cdr x)))])) (define (before-op op expr) (unhusk (memq-before op expr))) (define (after-op op expr) (if (pair? (memq op expr)) (cdr (memq op expr)) nil)) (define (rewrite expr) (let ([op (min-operator expr)]) (define (helper remaining) (if (null? (after-op op remaining)) (list (before-op op remaining)) (cons (before-op op remaining) (helper (after-op op remaining))))) (cons op (helper expr)))) (define (single? expr) (null? (cdr expr))) (define (unhusk expr) (if (and (single? expr) (list? (car expr))) (unhusk (car expr)) expr)) (define (unwrap expr) (if (single? expr) (car expr) (cons (car expr) (flatmap identity (cdr expr))))) (define (rewritten? expr) (or (single? expr) (operator? (car expr)))) (define (complete? expr) (or (single? expr) (and (operator? (car expr)) (pair? (cadr expr)) (null? (filter (lambda (x) (not (single? x))) (cdr expr)))))) (define (to-prefix expr) (cond [(not (rewritten? expr)) (to-prefix (rewrite expr))] [(complete? expr) (unwrap expr)] [else (cons (car expr) (map to-prefix (cdr expr)))]))
(to-prefix '(1 * x + y ** z + z * y * x)) (to-prefix '(1 * (2 + 3))) (to-prefix '(2 ** (7 + (4 * 5)))) (to-prefix '(x + 3 * (x + y + 2)))
#+RESULTS: : (+ (* 1 x) (** y z) (* z y x)) : (* 1 (+ 2 3)) : (** 2 (+ 7 (* 4 5))) : (+ x (* 3 (+ x y 2)))
I really like how simple the recursive cases are in to-prefix; afterwards making deriv work is trivial
(define (deriv-infix exp var)
(deriv (to-prefix exp) var))
I've got a solution for arbitrary structures of '+ and '* and '**. The idea is, to use precedence in reverse, so that operators with lower precedence will cause the terms to be split first and only then the operations of higher precedence. In order to calculate the derivation results of the lower precedence operations, the results from the operations with higher precedence are needed. Through recursion those of higher precedence will be the first ones to be calculated.
;; some helper procedure - there might be a library equivalent (define (take-until a-list stop-elem) (define (iter result sublist) (cond [(empty? sublist) result] [(eq? (car sublist) stop-elem) result] [else (iter (append result (list (car sublist))) (cdr sublist))])) (iter '() a-list))
EXPLANATION
Important is the lowest precedence operation.
If the lowest precedence operation is found, it can be split up into its respective pairs of addend and augend, multiplier and multiplicant or base and exponent. The split will mean that the elements of the pairs are treated separately, which means that an operation of higher precedence will be treated separately, from operations of lower precedence, in a separate derivation call. Only when the derivates of subterms of higher precedence "bubble back up" in the recursive calls as return values, the subterms of lower precedence can be derived, because they rely on these results.
Example:
(3 + 10 * x) ? SUM 3 AND 10 * x | FIRST STEP
(10 * x) ? PRODUCT 10 AND X | SECOND STEP
The example shows that the precedence is used in reversed. This is reflected by the structure of the last-operation procedure.
(define (last-operation expression)
(cond
[(memq '+ expression) '+]
[(memq '* expression) '*]
[(memq '** expression) '**]
[else 'unknown]))
Then the predicates:
A term is a sum, if the operation of lowest precedence is a sum, because that means, that the last operation applied will be the sum.
(define (sum? expression) (and (list? expression) (eq? (last-operation expression) '+))) (define (product? expression) (and (list? expression) (eq? (last-operation expression) '*))) (define (exponentiation? expression) (and (list? expression) (eq? (last-operation expression) '**)))
And the selectors for addend, augend, multiplier and multiplicant, base and exponent (note: I've not applied this concept to base and exponent, but it would work the same way):
(define (addend s) (let [(raw-addend (take-until s '+))] [if (= (length raw-addend) 1) (car raw-addend) raw-addend])) (define (augend s) (let [(augend-part (cdr (memq '+ s)))] [if (= (length augend-part) 1) (car augend-part) augend-part])) (define (multiplier product) (let [(raw-multiplier (take-until product '*))] [if (= (length raw-multiplier) 1) (car raw-multiplier) raw-multiplier])) (define (multiplicant p) (let [(multiplicant-part (cdr (memq '* p)))] [if (= (length multiplicant-part) 1) (car multiplicant-part) multiplicant-part])) (define (base power) (car power)) (define (exponent power) (caddr power))
And the make procedures, where I also changed some stuff:
(define (make-sum a1 a2) (cond [(=number? a1 0) a2] [(=number? a2 0) a1] [(and (number? a1) (number? a2)) (+ a1 a2)] [(eq? a1 a2) (list 2 '* a1)] [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? exponent 1) base] [(=number? exponent 0) 1] [(=number? base 1) 1] [(=number? base 0) 0] [else (list base '** exponent)]))
Here is my solution that utilizes modified shunting-yard algorithm, takes care of precedence and associativity, works in linear time, and is agnostic to implementation. I am only showing the algorithm itself and a few helpers, its application to derivate computation is trivial.
(define (op? o) (or (eq? o '+) (eq? o '-) (eq? o '*) (eq? o '^))) (define (precedence o) (cond ((eq? o '+) 1) ((eq? o '-) 1) ((eq? o '*) 2) ((eq? o '^) 3) (else (error "unknown operator: PRECEDENCE" o)))) (define (associativity o) (cond ((eq? o '+) 'left) ((eq? o '-) 'left) ((eq? o '*) 'left) ((eq? o '^) 'right) (else (error "unknown operator: ASSOCIATIVITY" o)))) (define (shunting-yard exp) (define (apply-op output op) (let ((lhs (cadr output)) (rhs (car output))) (cons (cond ((eq? op '+) (make-sum lhs rhs)) ((eq? op '-) (make-difference lhs rhs)) ((eq? op '*) (make-product lhs rhs)) ((eq? op '^) (make-exponentiation lhs rhs)) (else error "unknown operator: APPLY-OP" op)) (cddr output)))) (define (iter output operators exp) (if (null? exp) (if (null? operators) ; pushing whatever is left in op stack into output (car output) (iter (apply-op output (car operators)) (cdr operators) exp)) (let ((token (car exp))) (cond ((list? token) ; pushing sublist into output (iter (cons (shunting-yard token) output) operators (cdr exp))) ((op? token) ; pushing new operation into output or op stack (if (and (not (null? operators)) (or (and (eq? (associativity token) 'left) (<= (precedence token) (precedence (car operators)))) (and (eq? (associativity token) 'right) (< (precedence token) (precedence (car operators)))))) (iter (apply-op output (car operators)) (cdr operators) exp) (iter output (cons token operators) (cdr exp)))) (else ; pushing new number or variable into output (iter (cons token output) operators (cdr exp))))))) (iter nil nil exp))
I am using ^ instead of ** for exponentiation because it looks (to me, at least) better. Plus it has subtraction, but it is not hard to add it to the system.
My idea is that we can first convert the expression itself and convert the infix to a prefix, so that we don't have to rewrite the original code at all. Here is the code I wrote about the conversion expression.
;; Determine if it is an operator (define (is-op? t) (or (eq? '+ t) (eq? '* t) (eq? '** t))) ;; Return operator priority (define (order t) (cond ((eq? '+ t) 1) ((eq? '* t) 2) ((eq? '** t) 3) (else (error "Unknown symbol!")))) ;; return the corresponding operation according to the operator (define (get-operator op) (cond ((eq? '+ op) make-sum) ((eq? '* op) make-product) ((eq? '** op) make-exponentiation) (else (error "Unknown symbol!")))) (define (infix-to-prefix expr) (define (do-iter expr result-stack op-stack) (define (calculate expr op a1 a2 remain op-stack) (do-iter expr (cons ((get-operator op) a1 a2) remain) op-stack)) (define (is-expression? x) (if (pair? x) (do-iter x '() '()) x)) (if (null? expr) (if (null? op-stack) (car result-stack) (calculate expr (car op-stack) (cadr result-stack) (car result-stack) (cddr result-stack) (cdr op-stack))) (let ((this (car expr)) (other (cdr expr))) (if (is-op? this) (if (null? op-stack) (do-iter other result-stack (cons this op-stack)) (let ((op-top (car op-stack)) (res-top (car result-stack))) (if (>= (order op-top) (order this)) (calculate expr op-top (cadr result-stack) res-top (cddr result-stack) (cdr op-stack)) (do-iter other result-stack (cons this op-stack))))) (do-iter other (cons (is-expression? this) result-stack) op-stack))))) (do-iter expr '() '())) (define (prefix-to-infix expr) (define (do-it expr outer-order) (if (pair? expr) (let ((op (car expr))) (let ((this-order (order op)) (a1 (cadr expr)) (a2 (caddr expr))) ((if (> outer-order this-order) list (lambda (x) x)) (append (do-it a1 this-order) (cons op (do-it a2 this-order)))))) (list expr))) (do-it expr (order '+)))
An algorithm that creates brackets according to the precedence value of operators. Explanation.
Given an expression with more than 2 operations like
(x op1 y op2 z)
there will be at least one element such that Op1 y Op2 compare the precedence value of both operations
If Op1 > Op2 Resultant Expression will be
((x op1 y) op2 z)
If Op1 < Op2 Resultant Expression will be
(x op1 (y op2 z))
If Op1 = Op2 Resultant Expression will be
((x op1 y) op2 z)
If there’s only one operation left in the expression we terminate. ((x op1 y) op2 z) which is the case here
As there’s only op2 applied between (x op1 y) and z.
That’s it.
Eg exp:
(x * y + z * ( m * n + q))
y is sandwiched between two * and + . Since * has higher precedence. Resultant expression will be
((x * y) + z * ( m * n + q))
Now the first element that is sandwiched between two operations is z. Since * has higher precedence. Resultant expression
((x * y) + ( z * ( m * n + q)))
But since it multiplicand is a pair we apply precedence sort to that
( m * n + q)
Which will give
((m * n) + q)
So, the resultant expression will be
((x * y) + (z * ((m * n) + q)))
Now we terminate because there’s only one operation left ie + between (x * y) and (z * ((m * n) + q)).
This algorithm doesn’t change any existing procedures. And to add a new op like ^ . we just have to specify it’s precedence value.
(define 1st-elem car) (define op cadr) (define 2nd-elem caddr) (define 2nd-op cadddr) (define (precedence-table exp) (cond ((eq? '+ exp) 0) ((eq? '* exp) 1))) (define (precedence-check cmp exp) (cmp (precedence-table (op exp)) (precedence-table (2nd-op exp)))) (define (exp-f exp f) (list (f (1st-elem exp)) (op exp) (f (2nd-elem exp)))) (define (precedence-sort exp) (cond ((not (pair? exp)) exp) ((= (length exp) 3) (exp-f exp precedence-sort)) ((precedence-check > exp) (precedence-sort (cons (exp-f exp precedence-sort) (cdddr exp)))) ((precedence-check < exp) (append (list (precedence-sort (1st-elem exp)) (op exp)) (list (precedence-sort (cddr exp))))) ((precedence-check = exp) (precedence-sort (cons (exp-f exp precedence-sort) (cdddr exp)))))) (define (derivV2 exp var) (deriv (precedence-sort exp) var))
Results
]=> (precedence-sort '(x * y + z * ( m * n + q))) ; Result ((x * y) + (z * ((m * n) + q))) ]=> (derivV2 '(x * (y * (x + 3))) 'x) ; Result ((y * (x + 3)) + (x * y))
My idea is that we can first convert the expression itself and convert the infix to a prefix, so that we don't have to rewrite the original code at all. Here is the code I wrote about the conversion expression.
;; Determine if it is an operator (define (is-op? t) (or (eq? '+ t) (eq? '* t) (eq? '** t))) ;; Return operator priority (define (order t) (cond ((eq? '+ t) 1) ((eq? '* t) 2) ((eq? '** t) 3) (else (error "Unknown symbol!")))) ;; return the corresponding operation according to the operator (define (get-operator op) (cond ((eq? '+ op) make-sum) ((eq? '* op) make-product) ((eq? '** op) make-exponentiation) (else (error "Unknown symbol!")))) (define (infix-to-prefix expr) (define (do-iter expr result-stack op-stack) (define (calculate expr op a1 a2 remain op-stack) (do-iter expr (cons ((get-operator op) a1 a2) remain) op-stack)) (define (is-expression? x) (if (pair? x) (do-iter x '() '()) x)) (if (null? expr) (if (null? op-stack) (car result-stack) (calculate expr (car op-stack) (cadr result-stack) (car result-stack) (cddr result-stack) (cdr op-stack))) (let ((this (car expr)) (other (cdr expr))) (if (is-op? this) (if (null? op-stack) (do-iter other result-stack (cons this op-stack)) (let ((op-top (car op-stack)) (res-top (car result-stack))) (if (>= (order op-top) (order this)) (calculate expr op-top (cadr result-stack) res-top (cddr result-stack) (cdr op-stack)) (do-iter other result-stack (cons this op-stack))))) (do-iter other (cons (is-expression? this) result-stack) op-stack))))) (do-iter expr '() '())) (define (prefix-to-infix expr) (define (do-it expr outer-order) (if (pair? expr) (let ((op (car expr))) (let ((this-order (order op)) (a1 (cadr expr)) (a2 (caddr expr))) ((if (> outer-order this-order) list (lambda (x) x)) (append (do-it a1 this-order) (cons op (do-it a2 this-order)))))) (list expr))) (do-it expr (order '+)))
Decided to write a pre-processing procedure instead, which recursively applies an "add-parens" procedure to a given expression. With this solution, adding support for exponentiation is trivial (see "process" procedure).
Nothing in the original implementations of deriv and its associated functions are changed. Solution partially inspired by regex. Suggestions on possible improvements are welcomed.
Edit: added "get-elem-idx-r" which gets index of last instance of element in sequence, just to accommodate edge cases in exponentiation expressions such as x ** 2 ** 3 ** 4. Shame because "get-elem-idx" is much cleaner.
;; Helper functions (define (get-elem-idx s elem) ;; gets idx of first instance of elem (if (eq? (car s) elem) 0 (+ 1 (get-elem-idx (cdr s) elem)))) (define (get-elem-idx-r s elem) ;; gets idx of last instance of elem (define (iter s idx counter) (cond ((eq? s '()) idx) ((eq? (car s) elem) (iter (cdr s) counter (+ 1 counter))) (else (iter (cdr s) idx (+ 1 counter))))) (iter s 0 0)) (define (idx->elem s idx) ;; gets element by index of a sequence (if (= idx 0) (car s) (idx->elem (cdr s) (- idx 1)))) (define (range start end) ;; same output as enumerate-interval (if (> start end) '() (cons start (range (+ start 1) end)))) (define (add-parens s op) ;; returns an expression with brackets enclosing the nearest terms of a given operand (let ((idx (get-elem-idx-r s op))) (let ((left (- idx 1)) (right (+ idx 1)) (idxs (range 0 (- (length s) 1)))) (let ((toloop (filter (lambda (x) (not (or (= x left) (= x right)))) idxs)) (higher-order-expr (map (lambda (x) (idx->elem s x)) (range left right)))) (map (lambda (x) (if (= x idx) higher-order-expr (idx->elem s x))) toloop))))) (define (process s) ;; adds parens by order of operations (cond ((memq '** s) (process (add-parens s '**))) ((memq '* s) (process (add-parens s '*))) (else (if (eq? '() (cdr s)) (car s) s)))) (process '(y + x * y + x ** 2 ** 3 + 2 * 2)) ;; (y + (x * y) + (x ** (2 ** 3)) + (2 * 2)) (define deriv2 (lambda (exp var) (deriv (process exp) var))) (deriv2 '(x * y + 1 + x ** 2 * 3 + 4) 'x) ;; (+ y (* (* 2 x) 3))
Part a. reusing our existing deriv implementation:
(define (infix->prefix exp) (if (not (pair? exp)) exp (let ((a (car exp)) (op (cadr exp)) (b (caddr exp))) (list op (infix->prefix a) (infix->prefix b))))) (define (prefix->infix exp) (if (not (pair? exp)) exp (let ((op (car exp)) (a (cadr exp)) (b (caddr exp))) (list (prefix->infix a) op (prefix->infix b))))) (define (deriv-infix exp var) (prefix->infix (deriv (infix->prefix exp) var)))
Part b. side-stepping the problem by converting free infix to strict infix to prefix and back:
;; helpers (define (two l) (list (car l) (cadr l))) (define (three l) (list (car l) (cadr l) (caddr l))) ;; parenthesize w.r.t. ops in the order they are passed to the procedure (define (parenthesize exp op . ops) (define (iter head tail) (cond ((< (length tail) 4) (append head tail)) ((eq? (cadr tail) op) (iter head (cons (three tail) (cdddr tail)))) (else (iter (append head (two tail)) (cddr tail))))) (let ((first (if (not (pair? exp)) exp (map (lambda (e) (parenthesize e op)) (iter '() exp))))) (if (null? ops) first (apply parenthesize (append (list first (car ops)) (cdr ops)))))) (define (free-infix->prefix exp) (infix->prefix (parenthesize exp '* '+))) (define (free-infix-deriv exp var) (prefix->infix (deriv (free-infix->prefix exp) var)))
I first defined a infix->prefix function for part a, which can turn the infix notation into a prefix notation. Then a add-brackets function for part b, which can add missing brackets for the standard notation. And that works for me. (Note: I use racket, so some keywords may not be the same with scheme)
(define (infix->prefix exp) (cond [(number? exp) exp] [(variable? exp) exp] [else (list (cadr exp) (infix->prefix (car exp)) (infix->prefix (caddr exp)))])) (define (add-brackets exp) (cond ((number? exp) exp) ((variable? exp) exp) ((= (length exp) 1) (car exp)) ((eq? (cadr exp) '*) (add-brackets (cons (list (add-brackets (car exp)) '* (add-brackets (caddr exp))) (cdddr exp)))) ((eq? (cadr exp) '+) (list (add-brackets (car exp)) '+ (add-brackets (cddr exp)))) (else (error "invalid function" exp)))) (define (prefix->infix exp) (cond [(number? exp) exp] [(variable? exp) exp] [else (list (prefix->infix (cadr exp)) (car exp) (prefix->infix (caddr exp)))])) (add-brackets '(2 * 4 + 1)) (add-brackets '(2 + 4 * 1)) (add-brackets '(2 + 2 + 2)) (add-brackets '(x + 3 * (x + y + 2))) (infix->prefix (add-brackets '(x + 3 * (x + y + 2)))) (define (deriv-infix exp var) (deriv (infix->prefix exp) var)) (define (deriv-std exp var) (deriv-infix (add-brackets exp) var)) (define (deriv-std->std exp var) (prefix->infix (deriv-std exp var))) (deriv-std '(x + 3 * (x + y + 2)) 'x) (deriv-std '(x + 3 * x * y + y + 2) 'x) (deriv-std->std '(x + 3 * x * y + y + 2) 'x) (deriv-std->std '(x + 3 * x * y * x + y + 2) 'x)
Everything clicked for me when I approached this as a tree problem. Like brave one I canonized the given representation, recursively swapping the car of the input with the cadr.
I didn't modify any selectors or constructors because changing lower level details to accommodate a change in the input format smelled funny to me.
(define (deriv-infix exp var)
(define (car-cadr-swap x)
(cond ((not (pair? x)) x)
((null? (cdr x)) (car-cadr-swap (car x)))
(else (list (cadr x)
(car-cadr-swap (car x))
(car-cadr-swap (cddr x))))))
(deriv (car-cadr-swap exp) var))
We’re only going to bother with part (b) here, because the solution for that is also a solution for part (a).
The main problem is essentially to recognize whether a given expression is a sum or product. Now, keep in mind that, despite our moving to a representation that is more orthodox to traditional notation, we are still playing a pun: the parentheses which in one sense are used as mathematical groupings are at the same time sub-lists in list-structure. We can assume that these sub-lists will be valid expressions, so they will also be self-contained expressions. The upshot of this is that we need to concern ourselves with only the topmost “layer” of an expression: '(x * y * (x + 3)) and '((x * y) + (x * y + z)) to give two examples, will look like '(x * y * ░░░) and '(░░░ + ░░░) as far as we’re concerned.
Now to tell what sort of expression we have, we need to find out what operator will be the last one applied to the terms should we attempt to evaluate the expression. This has to be the operator with the lowest precedence among all the visible ones. So the predicates sum? and product? will seach out the lowest-precedence operator and comprare it to '+ and '* respectively:
Where smallest-op searches an expression for the lowest-precedence operator, which can be done as an accumulation:
(define (smallest-op expr) (accumulate (lambda (a b) (if (operator? b) (min-precedence a b) a)) 'maxop expr))There’s a lot of wishful thinking going on here! Anyways, we need a predicate operator? which says if a symbol is a recognizable operator, min-precedence which is like min but over operator precedence instead of numbers, and a thing called 'maxop which is basically a dummy value that is always considered “greater than” any other operator.
So there is this thing we call the *precedence-table* which is a list of pairs mapping operator symbols to values denoting their absolute precedence; the higher the number, the higher the precedence. operator? is a search of this car’s of the pairs, looking for a match. min-precedence orders two operators by the operator<? predicate, which tests if the precedence of the first operator is less than the second. precedence is a utility procedure to get the precedence value for an operator.¹
So we can now recognize sums and products and the dispatching part of deriv now works. Let’s now look at extracting their parts and making new ones. Given that expr is a list representing, say, a sum, then we can find the plus sign using memq. The augend of expr is the list of elements preceding the plus sign, and the addend the succeeding. Well, the augend is easy enough, it’s the cdr of the result of memq:
(define (augend expr) (let ((a (cdr (memq '+ expr)))) (if (singleton? a) (car a) a)))N.B. The reason we test for a singleton (list of one element) and pull out the item is that otherwise deriv would be asked eventually to differentiate something like (1) or ('x), which it doesn’t know how to do.
But to get the addend, we basically have to rewrite memq, but to accumulate the things prior to symbol.
And now to make a sum, taking care of the standard numerical reductions:
(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))))And to finish things off, we’ll define the procedures for products, which are basically similar to the above.
Well, let’s take our new toy out for a test spin.
¹ I’m exposing the structure of the table by writing caar and such, but I’m sick enough of writing procedures not to bother with the proper abstraction layers (P.S. the wiki’s Scheme highlighter doesn’t understand cdar).