Simplifying Arithmetic Expressions in LISP

This is a sample LISP program that you can use as as a source of ideas for your programming assignment.

Here is the basic idea of the code. Given a list that represents an arithmetic expression, simplify that arithmetic expression by doing some (not very complicated) substitutions. For example, if the expression is (a + b + 0 + c) we might simplify it to (a + b + c) by applying a rule that says to replace ($ + 0) with ($). In this rule, the left side is the pattern, the right side is the replacement, and we use $ to represent a variable. (We could represent a variable just about any way we like; I decided that I liked $. Of course, this means I can have only that one variable.) In matching the pattern against the expression, we find that $ + 0 matches b + 0 if $ matches b.

To perform the replacement, then, we need to do these steps

  1. Recognize that $ + 0 matches b + 0.
  2. Recognize that $ matches b.
  3. Change $ to b in the replacement.
  4. In the expression, substitute b (the new replacement) for b + 0 (the part matched by the pattern).

Here are some other possible rules:

Pattern Replacement Comment
(0 + $) ($) Note that replacement is a list.
(1 * $) ($)  
(0 * $) (0) $ is not used in replacement.
(1 + 1) (2) $ is not used at all.
($ * 2 * 2) (4 * $) A more complex replacement.

To keep the example code simple,

  1. We restrict each pattern and each replacement to be a simple list of atoms (that is, it cannot have sublists).
  2. We don't take order of operations into account, so (x + 0 * y) might be incorrectly "simplified" to (x + y)).
  3. We allow the expression to have sublists, but don't simplify the sublists. (This would be a good exercise.)
  4. We apply each pattern only once to an expression.

These limitations mean that the program really isn't very good at simplifying arithmetic expressions. I could make the program better by making it more complicated, but then it wouldn't be as good an example.

Here's an outline of the code (only the higher-level functions are listed here). Repeating a list from above, we need to do the following tasks:

Step Task Important Functions
1 Recognize that $ + 0 matches b + 0. occurs-at-front,
matches
2 Recognize that $ matches b. get-$-match
3 Change $ to b in the replacement. substitute-in-replacement
4 In the expression, substitute b (the new replacement) for b + 0 (the part matched by the pattern). substitute-at-front,
final-replace
(simplify expression)
Tries to simplify an expression, returning the result. This function just calls (rules) to get the rules, then calls simplify-2 with both the rules and the expression.
(simplify-2 rules expression)
Calls apply-rule with the first rule, then recurs with the rest of the rules.
(apply-rule rule expression)
Separates the rule into a pattern and a replacement, then calls substitute with the pattern, replacement, and expression.
(substitute pattern replacement expression)
Recursively searches the expression for an occurrence of the pattern. If it finds one, it calls substitute-at-front with the pattern, the replacement, and the tail part of the expression that begins with the pattern (after substitution, it puts the front part of the expression back on).
(substitute-at-front pattern replacement expression)
This function is called when we know the pattern matches the very beginning of the expression. It substitutes the correct value for $ in the replacement, then calls final-replace.
(get-$-match pattern expression)
This routine is called when we know that the pattern matches the very first part of the expression. It returns the part of the expression that corresponds to $ in the pattern.
(substitute-in-replacement $-value replacement)
Finds $ in the replacement and replaces it with the correct value from the expression.
(final-replace pattern replacement expression)
Removes from expression the part (at the front) that matches the pattern, and replaces it with the replacement.

Here's the code. When I compiled it, LispWorks warned me that I was replacing a predefined SUBSTITUTE, and gave me a chance to change my mind. It's dangerous to redefine a built-in function, because you never know what will break, but I took the risk and it seems to work OK.


; Try to apply each rule in turn to the expression.  SIMPLIFY picks
; up the rules and gives them, along with the expression, to SIMPLIFY-2.
; SIMPLIFY-2 picks off one rule and applies it by calling APPLY-RULE,
; then recurs with the remaining rules. APPLY-RULE breaks the rule up
; into pattern and replacement parts and gives these, along with the
; expression, to SUBSTITUTE.

(defun simplify (expression)
    (simplify-2 (rules) expression)  )

(defun simplify-2 (rules expression)
    (cond
    ((null rules)  expression)
    (T  (simplify-2 (cdr rules) (apply-rule (car rules) expression)))  )  )

(defun apply-rule (rule expression)
    (substitute (car rule) (cadr rule) expression)  )


; Try to match the pattern to the expression.  If it matches, replace
; the part matched with the replacement, and return the result.
; If the pattern doesn't apply, the result is the original expression.
; Example: (substitute '(1 + $) '($ + 1) '(A + 1 + B + C)) returns
;(A + B + 1 + C)

(defun substitute (pattern replacement expression)
    (cond
    ((null expression)  ())
    ((occurs-at-front pattern expression)
        (substitute-at-front pattern replacement expression) )
    (T (cons (car expression) 
             (substitute pattern replacement (cdr expression)) ))  )  )


; Test whether the pattern occurs at the very front of the expression.
; This function uses MATCHES to test individual components of the pattern.
; Example: (occurs-at-front '($ + 0) '(A + 0 + B)) returns T

(defun occurs-at-front (pattern expression)
    (cond
    ((null pattern)  T)
    ((null expression)  nil)
    ((matches (car pattern) (car expression))
        (occurs-at-front (cdr pattern) (cdr expression)) )
    (T  nil)  )  )


; Test whether the first component of the pattern matches the
; first component of the expression.  A match occurs if:
;    1. The pattern component is '$
;    2. They are identical atoms

(defun matches (pattern-part expression-part)
    (cond
    ((eq pattern-part '$)  T)
    (T  (eq pattern-part expression-part))  )  )


; This function should be called only when we know that the pattern
; matches the front of the expression.
; If the pattern contains a $, find and return the corresponding
; component (atom or list) of the expression.  If the pattern
; does not contain a $, return NIL.
; (Note: this means you can't replace $ with NIL, but for this
;  example, using arithmetic expressions, you shouldn't ever want to.)
; Example: (get-$-match '(0 + $) '(0 + A + B))  returns  A

(defun get-$-match (pattern expression)
    (cond
    ((null expression)  nil)
    ((eq (car pattern) '$)  (car expression))
    (T  (get-$-match (cdr pattern) (cdr expression)))  )  )


; In the replacement, substitute the value we found for the $ for
; the $ itself.  If $-value is NIL, that means the pattern did not
; contain a $, and the replacement shouldn't have one, either.
; Example: (substitute-in-replacement 'A '($ + 0)) returns (A + 0).

(defun substitute-in-replacement ($-value replacement)
    (cond
    ((null $-value)  replacement)
    ((null replacement)  ())
    ((eq (car replacement) '$)  (cons $-value (cdr replacement)))
    (T  (cons (car replacement)
              (substitute-in-replacement $-value (cdr replacement)) ))  )  )
    

; This function is called when we know the pattern matches the very
; first part of the expression.  If the pattern contains a $, that
; could match anything, and the thing it matches should be put in
; place of the $ the replacement.  If the pattern does not contain
; a $, then the replacement can be used as is.
; Example: (substitute-at-front '(0 * $) '(0) '(0 * A + B)) returns (0 + B).

(defun substitute-at-front (pattern replacement expression)
    (final-replace
        pattern
        (substitute-in-replacement (get-$-match pattern expression) replacement)
        expression )  )


; This function is called when (1) the pattern has been matched at the
; very front of the expression, and (2) the replacement has been suitably
; modified.  We step through and discard one component of the expression
; for every component of the pattern, then append the replacement to
; whatever is left of the expression.
; Example: (substitute-at-front '($ + 0) '($) '(A + 0 + B)) returns (A + B)

(defun final-replace (pattern replacement expression)
    (cond
    ((null pattern)  (append replacement expression))
    (T  (final-replace (cdr pattern) replacement (cdr expression)))  )  )


; Define the rules

(defun rules ()
    '( (($ + 0)  ($))
       ((0 + $)  ($))
       ((1 * $)  ($))
       ((0 * $)  (0))
       (($ * 0)  (0))
       ((1 + 1)  (2))
       (($ * 2 * 2)  (4 * $)) )  )