LISP Tutorial Lecture 3: Data Abstraction

Binary Trees

Suppose we want to create a new kind of recursive data type, our familiar binary trees. The first thing we have to do is to define the data type in terms of its constructors, selectors and recognizers. In the case of binary trees, we have the following:

Constructors: We have two kinds of binary trees, leaves and nodes. Accordingly, we need a constructor for each kind:
- (make-bin-tree-leaf E): A leaf is a composite object with one component, the element E.
- (make-bin-tree-node E B1 B2): A node consists of three components, an element E, a left subtree B1 and a right subtree B2. Each of B1 and B2 is a binary tree.
Notice that the definition of binary tree is inherently recursive (as in the case of nodes). Larger binary trees can be composed from smaller ones.
Selectors: We need to define a selector for each component of each kind of binary tree.
- (bin-tree-leaf-element L): Retrieve the element of a leaf L.
- (bin-tree-node-element N): Retrieve the element of a node N.
- (bin-tree-node-left N): Retrieve the left subtree of a node N.
- (bin-tree-node-right N): Retrieve the right subtree of a node N.
Recognizers: We define one recognizer for each kind of binary tree.
- (bin-tree-leaf-p B): Test if a given binary tree B is a leaf.
- (bin-tree-node-p B): Test if a given binary tree B is a node.

Notice that we have not written a line of code yet, and still we are able to write down the function signature of all the constructors, selectors and recognizers. The process is more or less mechanical:

Define a constructor for each variant of the recursive data type. The parameters for a constructor defines the components of a composite object.
For each parameter of each constructor, define a selector to retrieve the corresponding component.
For each constructor, define a corresponding recognizer.

The next question is how we are to represent a binary tree as a LISP object. Of course, a list is the first thing that comes to our mind:

We represent an leaf with element E by a singleton list containing E (i.e. (list E)).
A node with element E, left subtree B1 and right subtree B2 is represented as a list containing the three components (i.e. (list E B1 B2)).

Fixing the representation, we can thus implement the recursive data type functions:

;;
;; Binary Trees
;;

;;
;; Constructors for binary trees
;;

(defun make-bin-tree-leaf (E)
  "Create a leaf."
  (list E))

(defun make-bin-tree-node (E B1 B2)
  "Create a node with element K, left subtree B1 and right subtree B2."
  (list E B1 B2))

;;
;; Selectors for binary trees
;;

(defun bin-tree-leaf-element (L)
  "Retrieve the element of a leaf L."
  (first L))

(defun bin-tree-node-element (N)
  "Retrieve the element of a node N."
  (first N))

(defun bin-tree-node-left (N)
  "Retrieve the left subtree of a node N."
  (second N))

(defun bin-tree-node-right (N)
  "Retrieve the right subtree of a node N."
  (third N))

;;
;; Recognizers for binary trees
;;

(defun bin-tree-leaf-p (B)
  "Test if binary tree B is a leaf."
  (and (listp B) (= (list-length B) 1)))

(defun bin-tree-node-p (B)
  "Test if binary tree B is a node."
  (and (listp B) (= (list-length B) 3)))

The representation scheme works out like the following:

USER(5): (make-bin-tree-node '*
                             (make-bin-tree-node '+
                                                 (make-bin-tree-leaf 2)
                                                 (make-bin-tree-leaf 3))
                             (make-bin-tree-node '-
                                                 (make-bin-tree-leaf 7)
                                                 (make-bin-tree-leaf 8)))
(* (+ (2) (3)) (- (7) (8)))

The expression above is a binary tree node with element * and two subtrees. The left subtree is itself a binary tree node with + as its element and leaves as its subtress. The right subtree is also a binary tree node with - as its element and leaves as its subtrees. All the leaves are decorated by numeric components.

            *
           / \
          /   \
         /     \
        +       -
       / \     / \
      2   3   7   8

Searching Binary Trees

As discussed in previous tutorials, having recursive data structures defined in the way we did streamlines the process of formulating structural recursions. We review this concept in the following examples.

Suppose we treat binary trees as containers. An expression E is a member of a binary tree B if:

B is a leaf and its element is E.
B is a node and either its element is E or E is a member of one of its subtrees.

For example, the definition asserts that the members of (* (+ (2) (3)) (- (7) (8))) are *, +, 2, 3, -, 7 and 8. Such a definition can be directly implemented by our recursive data type functions:

(defun bin-tree-member-p (B E)
  "Test if E is an element in binary tree B."
  (if (bin-tree-leaf-p B)
      (equal E (bin-tree-leaf-element B))
    (or (equal E (bin-tree-node-element B))
        (bin-tree-member-p (bin-tree-node-left B) E)
	(bin-tree-member-p (bin-tree-node-right B) E))))

The function can be made more readable by using the let form:

(defun bin-tree-member-p (B E)
  "Test if E is an element in binary tree B."
  (if (bin-tree-leaf-p B)
      (equal E (bin-tree-leaf-element B))
    (let
	((elmt  (bin-tree-node-element B))
	 (left  (bin-tree-node-left    B))
	 (right (bin-tree-node-right   B)))
      (or (equal E elmt)
	  (bin-tree-member-p left E)
	  (bin-tree-member-p right E)))))

Tracing the execution of bin-tree-member-p, we get:

USER(14): (trace bin-tree-member-p)
(BIN-TREE-MEMBER-P)
USER(15): (bin-tree-member-p '(+ (* (2) (3)) (- (7) (8))) 7) 
 0: (BIN-TREE-MEMBER-P (+ (* (2) (3)) (- (7) (8))) 7)
   1: (BIN-TREE-MEMBER-P (* (2) (3)) 7)
     2: (BIN-TREE-MEMBER-P (2) 7)
     2: returned NIL
     2: (BIN-TREE-MEMBER-P (3) 7)
     2: returned NIL
   1: returned NIL
   1: (BIN-TREE-MEMBER-P (- (7) (8)) 7)
     2: (BIN-TREE-MEMBER-P (7) 7)
     2: returned T
   1: returned T
 0: returned T
T

Exercise: Let size(B) be the number of members in a binary tree B. Give a recursive definition of size(B), and then implement a LISP function (bin-tree-size B) that returns size(B).

Traversing Binary Trees

Let us write a function that will reverse a tree in the sense that the left and right subtrees of every node are swapped:

(defun binary-tree-reverse (B)
  "Reverse binary tree B."
  (if (bin-tree-leaf-p B)
      B
    (let
	((elmt  (bin-tree-node-element B))
	 (left  (bin-tree-node-left    B))
	 (right (bin-tree-node-right   B)))
      (make-bin-tree-node elmt
		          (binary-tree-reverse right)
		          (binary-tree-reverse left)))))

The correctness of the above implementation can be articulated as follows. Given a binary tree B and an object E, either the binary tree is a leaf or it is a node:

Case 1: B is a leaf.
Then the reversal of B is simply B itself.
Case 2: B is a node.
Then B has three components, namely, an element elmt, a left subtree left and a right subtree right. The reversal of B is a node with element elmt, left subtree the reversal of right, and right subtree the reversal of left.

The following shows us how the recursion unfolds:

USER(21): (trace bin-tree-reverse)
(BIN-TREE-REVERSE)
USER(22): (bin-tree-reverse '(* (+ (2) (3)) (- (7) (8))))
 0: (BIN-TREE-REVERSE (* (+ (2) (3)) (- (7) (8))))
   1: (BIN-TREE-REVERSE (- (7) (8)))
     2: (BIN-TREE-REVERSE (8))
     2: returned (8)
     2: (BIN-TREE-REVERSE (7))
     2: returned (7)
   1: returned (- (8) (7))
   1: (BIN-TREE-REVERSE (+ (2) (3)))
     2: (BIN-TREE-REVERSE (3))
     2: returned (3)
     2: (BIN-TREE-REVERSE (2))
     2: returned (2)
   1: returned (+ (3) (2))
 0: returned (* (- (8) (7)) (+ (3) (2)))
(* (- (8) (7)) (+ (3) (2)))

The resulting expression represents the following tree:

            *
           / \
          /   \
         /     \
        -       +
       / \     / \
      8   7   3   2

Let us implement a function that will extract the members of a given binary tree, and put them into a list in preorder.

(defun bin-tree-preorder (B)
  "Create a list containing keys of B in preorder."
  (if (bin-tree-leaf-p B)
      (list (bin-tree-leaf-element B))
    (let
	((elmt  (bin-tree-node-element B))
	 (left  (bin-tree-node-left    B))
	 (right (bin-tree-node-right   B)))
      (cons elmt
	    (append (bin-tree-preorder left)
		    (bin-tree-preorder right))))))

Tracing the execution of the function, we obtain the following:

USER(13): (trace bin-tree-preorder)
(BIN-TREE-PREORDER)
USER(14): (bin-tree-preorder '(* (+ (2) (3)) (- (7) (8))))
 0: (BIN-TREE-PREORDER (* (+ (2) (3)) (- (7) (8))))
   1: (BIN-TREE-PREORDER (+ (2) (3)))
     2: (BIN-TREE-PREORDER (2))
     2: returned (2)
     2: (BIN-TREE-PREORDER (3))
     2: returned (3)
   1: returned (+ 2 3)
   1: (BIN-TREE-PREORDER (- (7) (8)))
     2: (BIN-TREE-PREORDER (7))
     2: returned (7)
     2: (BIN-TREE-PREORDER (8))
     2: returned (8)
   1: returned (- 7 8)
 0: returned (* + 2 3 - 7 8)
(* + 2 3 - 7 8)

As we have discussed before, the append call in the code above is a source of inefficiency that can be obtimized away:

(defun fast-bin-tree-preorder (B)
  "A tail-recursive version of bin-tree-preorder."
  (preorder-aux B nil))

(defun preorder-aux (B A)
  "Append A to the end of the list containing elements of B in preorder."
  (if (bin-tree-leaf-p B)
      (cons (bin-tree-leaf-element B) A)
    (let
	((elmt  (bin-tree-node-element B))
	 (left  (bin-tree-node-left    B))
	 (right (bin-tree-node-right   B)))
      (cons elmt
	    (preorder-aux left
			  (preorder-aux right A))))))

An execution trace of the implementation is the following:

USER(15): (trace fast-bin-tree-preorder preorder-aux)          
(PREORDER-AUX FAST-BIN-TREE-PREORDER)
USER(16): (fast-bin-tree-preorder '(* (+ (2) (3)) (- (7) (8))))
 0: (FAST-BIN-TREE-PREORDER (* (+ (2) (3)) (- (7) (8))))
   1: (PREORDER-AUX (* (+ (2) (3)) (- (7) (8))) NIL)
     2: (PREORDER-AUX (- (7) (8)) NIL)
       3: (PREORDER-AUX (8) NIL)
       3: returned (8)
       3: (PREORDER-AUX (7) (8))
       3: returned (7 8)
     2: returned (- 7 8)
     2: (PREORDER-AUX (+ (2) (3)) (- 7 8))
       3: (PREORDER-AUX (3) (- 7 8))
       3: returned (3 - 7 8)
       3: (PREORDER-AUX (2) (3 - 7 8))
       3: returned (2 3 - 7 8)
     2: returned (+ 2 3 - 7 8)
   1: returned (* + 2 3 - 7 8)
 0: returned (* + 2 3 - 7 8)
(* + 2 3 - 7 8)

Exercise: Implement a function that will create a list containing members of a given binary tree in postorder. Implement also a tail-recursive version of the same function.

Exercise: Repeat the last exercise with inorder.

Abstract Data Types

Abstract data types are blackboxes. They are defined in terms of their external interfaces, and not their implementation. For example, a set abstraction offers the following operations:

(make-empty-set) creates an empty set.
(set-insert S E) returns a set containing all members of set S plus an additional member E.
(set-remove S E) returns a set containing all members of set S except for E.
(set-member-p S E) returns true if E is a member of set S.
(set-empty-p S) returns true if set S is empty.

To implement an abstract data type, we need to decide on a representation. Let us represent a set by a list with no repeated members.

(defun make-empty-set ()
  "Creates an empty set."
  nil)

(defun set-insert (S E)
  "Return a set containing all the members of set S plus the element E."
  (adjoin E S :test #'equal))

(defun set-remove (S E)
  "Return a set containing all the members of set S except for element E."
  (remove E S :test #'equal))

(defun set-member-p (S E)
  "Return non-NIL if set S contains element E."
  (member E S :test #'equal))

(defun set-empty-p (S)
  "Return true if set S is empty."
  (null S))

Exercise: Look up the definition of adjoin, remove and member from CLTL2. In particular, find out how the :test keyword is used to specify the equality test function to be used by the three functions. What will happen if we omit the :test keyword and the subsequent #'equal when invoking the three functions?

Notice that we have implemented an abstract data type (sets) using a more fundamental recursive data structure (lists) with additional computational constraints (no repetition) imposed by the interface functions.

Binary Search Trees

Another way of implementing the same set abstraction is to use the more efficient binary search tree (BST). Binary search trees are basically binary trees with the following additional computational constraints:

All the members in the left subtree of a tree node is no greater than the element of the node.
All the members in the right subtree of a tree node is greater than the element of the node.
All the leaf members are distinct.

Again, we are implementing an abstract data type (sets) by a more fundamental recursive data structure (binary trees) with additional computational constraints. In particular, we use the leaves of a binary tree to store the member of a set, and the tree nodes for providing indexing information that improves search performance. for example, a BST representing the set {1 2 3 4} would look like:

            2
           / \
          /   \
         /     \
        1       3
       / \     / \
      1   2   3   4

An empty BST is represented by NIL, while a nonempty BST is represented by a binary tree. We begin with the constructor and recognizer for empty BST.

(defun make-empty-BST ()
  "Create an empty BST."
  nil)

(defun BST-empty-p (B)
  "Check if BST B is empty."
  (null B))

Given the additional computational constraints, membership test can be implemented as follows:

(defun BST-member-p (B E)
  "Check if E is a member of BST B."
  (if (BST-empty-p B)
      nil
    (BST-nonempty-member-p B E)))

(defun BST-nonempty-member-p (B E)
  "Check if E is a member of nonempty BST B."
  (if (bin-tree-leaf-p B)
      (= E (bin-tree-leaf-element B))
    (if (<= E (bin-tree-node-element B))
	(BST-nonempty-member-p (bin-tree-node-left B) E)
      (BST-nonempty-member-p (bin-tree-node-right B) E))))

Notice that we handle the degenerate case of searching an empty BST separately, and apply the well-known recursive search algorithm only on nonempty BST.

USER(16): (trace BST-member-p BST-nonempty-member-p)
(BST-NONEMPTY-MEMBER-P BST-MEMBER-P)
USER(17): (BST-member-p '(2 (1 (1) (2)) (3 (3) (4))) 3)
 0: (BST-MEMBER-P (2 (1 (1) (2)) (3 (3) (4))) 3)
   1: (BST-NONEMPTY-MEMBER-P (2 (1 (1) (2)) (3 (3) (4))) 3)
     2: (BST-NONEMPTY-MEMBER-P (3 (3) (4)) 3)
       3: (BST-NONEMPTY-MEMBER-P (3) 3)
       3: returned T
     2: returned T
   1: returned T
 0: returned T
T

Insertion is handled by the following family of functions:

(defun BST-insert (B E)
  "Insert E into BST B."
  (if (BST-empty-p B)
      (make-bin-tree-leaf E)
    (BST-nonempty-insert B E)))

(defun BST-nonempty-insert (B E)
  "Insert E into nonempty BST B."
  (if (bin-tree-leaf-p B)
      (BST-leaf-insert B E)
    (let ((elmt  (bin-tree-node-element B))
	  (left  (bin-tree-node-left    B))
	  (right (bin-tree-node-right   B)))
      (if (<= E (bin-tree-node-element B))
	  (make-bin-tree-node elmt
			      (BST-nonempty-insert (bin-tree-node-left B) E)
			      right)
	(make-bin-tree-node elmt
			    left
			    (BST-nonempty-insert (bin-tree-node-right B) E))))))

(defun BST-leaf-insert (L E)
  "Insert element E to a BST with only one leaf."
  (let ((elmt (bin-tree-leaf-element L)))
    (if (= E elmt)
	L
      (if (< E elmt)
	  (make-bin-tree-node E
			      (make-bin-tree-leaf E)
			      (make-bin-tree-leaf elmt))
	(make-bin-tree-node elmt
			    (make-bin-tree-leaf elmt)
			    (make-bin-tree-leaf E))))))

As before, recursive insertion to nonempty BST is handled outside of the general entry point of BST insertion. Traversing down the index nodes, the recursive algorithm eventually arrives at a leaf. In case the element is not already in the tree, the leaf is turned into a node with leaf subtrees holding the inserted element and the element of the original leaf. For example, if we insert 2.5 into the tree represented by (2 (1 (1) (2)) (3 (3) (4))), the effect is the following:

            2                      2
           / \                    / \
          /   \                  /   \
         /     \       ==>      /     \
        1       3              1       3
       / \     / \            / \     / \
      1   2   3   4          1   2  2.5  4
                                    / \
                                  2.5  3

A trace of the insertion operation is given below:

USER(22): (trace BST-insert BST-nonempty-insert BST-leaf-insert)
(BST-LEAF-INSERT BST-NONEMPTY-INSERT BST-INSERT)
USER(23): (BST-insert '(2 (1 (1) (2)) (3 (3) (4))) 2.5)
 0: (BST-INSERT (2 (1 (1) (2)) (3 (3) (4))) 2.5)
   1: (BST-NONEMPTY-INSERT (2 (1 (1) (2)) (3 (3) (4))) 2.5)
     2: (BST-NONEMPTY-INSERT (3 (3) (4)) 2.5)
       3: (BST-NONEMPTY-INSERT (3) 2.5)
         4: (BST-LEAF-INSERT (3) 2.5)
         4: returned (2.5 (2.5) (3))
       3: returned (2.5 (2.5) (3))
     2: returned (3 (2.5 (2.5) (3)) (4))
   1: returned (2 (1 (1) (2)) (3 (2.5 (2.5) (3)) (4)))
 0: returned (2 (1 (1) (2)) (3 (2.5 (2.5) (3)) (4)))
(2 (1 (1) (2)) (3 (2.5 (2.5) (3)) (4)))

Removal of elements is handled by the following family of functions:

(defun BST-remove (B E)
  "Remove E from BST B."
  (if (BST-empty-p B)
      B
    (if (bin-tree-leaf-p B)
	(BST-leaf-remove B E)
      (BST-node-remove B E))))

(defun BST-leaf-remove (L E)
  "Remove E from BST leaf L."
  (if (= E (bin-tree-leaf-element L))
      (make-empty-BST)
    L))

(defun BST-node-remove (N E)
  "Remove E from BST node N."
  (let
      ((elmt  (bin-tree-node-element N))
       (left  (bin-tree-node-left    N))
       (right (bin-tree-node-right   N)))
    (if (<= E elmt)
	(if (bin-tree-leaf-p left)
	    (if (= E (bin-tree-leaf-element left))
		right
	      N)
	  (make-bin-tree-node elmt (BST-node-remove left E) right))
      (if (bin-tree-leaf-p right)
	  (if (= E (bin-tree-leaf-element right))
	      left
	    N)
	(make-bin-tree-node elmt left (BST-node-remove right E))))))

This time, removal from empty BST's and BST's with a single leaf are both degenerate cases. The recursive removal algorithm deals with BST nodes. Traversing down the index nodes, the recursive algorithm searches for the parent node of the leaf to be removed. In case it is found, the sibling of the leaf to be removed replaces its parent node. For example, the effect of removing 2 from the BST represented by (2 (1 (1) (2)) (3 (3) (4))) is depicted as follows:

            2                      2
           / \                    / \
          /   \                  /   \
         /     \       ==>      /     \
        1       3              1       4
       / \     / \            / \     
      1   2   3   4          1   2

A trace of the deletion operation is given below:

USER(4): (trace BST-remove BST-node-remove)
(BST-NODE-REMOVE BST-REMOVE)
USER(5): (BST-remove '(2 (1 (1) (2)) (3 (3) (4))) 3)
 0: (BST-REMOVE (2 (1 (1) (2)) (3 (3) (4))) 3)
   1: (BST-NODE-REMOVE (2 (1 (1) (2)) (3 (3) (4))) 3)
     2: (BST-NODE-REMOVE (3 (3) (4)) 3)
     2: returned (4)
   1: returned (2 (1 (1) (2)) (4))
 0: returned (2 (1 (1) (2)) (4))
(2 (1 (1) (2)) (4))

Exercise: A set can be implemented as a sorted list, which is a list storing distinct members in ascending order. Implement the sorted list abstraction.

Polynomials

We demonstrate how one can perform symbolic computation using LISP. To begin with, we define a new recursive data type for polynomials, which is defined recursively as follows:

If num is a number, then (make-constant num) is a polynomial;
If sym is a symbol, then (make-variable sym) is a polynomial;
If poly1 and poly2 are polynomials, then the following are also polynomials:
- (make-sum poly1 poly2)
- (make-product poly1 poly2)
If poly is a polynomial and num is a number, then (make-power poly num) is a polynomial.

One can represent polynomials in the most standard way:

;;
;; Constructors for polynomials
;;

(defun make-constant (num)
  num)

(defun make-variable (sym)
  sym)

(defun make-sum (poly1 poly2)
  (list '+ poly1 poly2))

(defun make-product (poly1 poly2)
  (list '* poly1 poly2))

(defun make-power (poly num)
  (list '** poly num))

For example, (make-power (make-sum (make-variable 'x) (make-constant 1)) 2) is represented by the LISP form (** (+ x 1) 2), which denotes the polynomail (x + 1)² in our usual notation.

We then define a recognizer for each constructor:

;;
;; Recognizers for polynomials
;;

(defun constant-p (poly)
  (numberp poly))

(defun variable-p (poly)
  (symbolp poly))

(defun sum-p (poly)
  (and (listp poly) (eq (first poly) '+)))

(defun product-p (poly)
  (and (listp poly) (eq (first poly) '*)))

(defun power-p (poly)
  (and (listp poly) (eq (first poly) '**)))

We then need to define selectors for the composite polynomials. We define a selector for each component of each composite constructor.

;;
;; Selectors for polynomials
;;

(defun constant-numeric (const)
  const)

(defun variable-symbol (var)
  var)

(defun sum-arg1 (sum)
  (second sum))

(defun sum-arg2 (sum)
  (third sum))

(defun product-arg1 (prod)
  (second prod))

(defun product-arg2 (prod)
  (third prod))

(defun power-base (pow)
  (second pow))

(defun power-exponent (pow)
  (third pow))

One may ask why we define so many trivial looking functions for carrying out the same task (sum-arg1 and product-arg1 have exactly the same implementation). The reason is that we may end up changing the representation in the future, and there is no guarantee that sums and products will be represented similarly in the future. Also, programs written like this tends to be self-commenting.

Now that we have a completely defined polynomial data type, let us do something interesting with it. Let us define a function that carries out symbolic differentiation. In particular, we want a function (d poly x) which returns the derivative of polynomial poly with respect to variable x. Let us review our first-year differential calculus:

The derivative (dC / dx) of a constant C is zero.
The derivative (dy/dx) of a variable y is 1 if the x = y. Otherwise, we leave the derivative unevaluated. We represent unevaluated derivatives using the following functions
```
;;
;; Unevaluated derivative
;;

(defun make-derivative (poly x)
    (list 'd poly x))

(defun derivative-p (poly x)
  (and (listp poly) (eq (first poly) 'd)))
```
The derivative (d(F+G)/dx) of a sum (F+G) is (dF/dx) + (dG/dx).
The derivative (d(F*G)/dx) of a product (F*G) is F*(dG/dx) + G*(dF/dx).
The derivative (d(F^N)/dx) of a power F^N is N * F^N-1 * (dF/dx).

The above calculus can be encoded in LISP as follows:
;; ;; Differentiation function ;; (defun d (poly x) (cond ((constant-p poly) 0) ((variable-p poly) (if (equal poly x) 1 (make-derivative poly x))) ((sum-p poly) (make-sum (d (sum-arg1 poly) x) (d (sum-arg2 poly) x))) ((product-p poly) (make-sum (make-product (product-arg1 poly) (d (product-arg2 poly) x)) (make-product (product-arg2 poly) (d (product-arg1 poly) x)))) ((power-p poly) (make-product (make-product (power-exponent poly) (make-power (power-base poly) (1- (power-exponent poly)))) (d (power-base poly) x)))))

Test driving the differentiation function we get:
USER(11): (d '(+ x y) 'x) (+ 1 (D Y X)) USER(12): (d '(* (+ x 1) (+ x 1)) 'x) (+ (* (+ X 1) (+ 1 0)) (* (+ X 1) (+ 1 0))) USER(13): (d '(** (+ x 1) 2) 'x) (* (* 2 (** (+ X 1) 1)) (+ 1 0))

The result is correct but very clumsy. We would like to simplify the result a bit using the following rewriting rules:

E + 0 = E
0 + E = E
E * 0 = 0
0 * E = 0
E * 1 = E
1 * E = E
E⁰ = 1
E¹ = E

This can be done by defining a simplification framework, in which we can implement such rules:
;; ;; Simplification function ;; (defun simplify (poly) "Simplify polynomial POLY." (cond ((constant-p poly) poly) ((variable-p poly) poly) ((sum-p poly) (let ((arg1 (simplify (sum-arg1 poly))) (arg2 (simplify (sum-arg2 poly)))) (make-simplified-sum arg1 arg2))) ((product-p poly) (let ((arg1 (simplify (product-arg1 poly))) (arg2 (simplify (product-arg2 poly)))) (make-simplified-product arg1 arg2))) ((power-p poly) (let ((base (simplify (power-base poly))) (exponent (simplify (power-exponent poly)))) (make-simplified-power base exponent))) ((derivative-p poly) poly)))
The simplify function decomposes a composite polynomial into its components, apply simplification recursively to the components, and then invoke the type-specific simplification rules (i.e. make-simplified-sum, make-simplified-product, make-simplified-power) based on the type of the polynomial being processed.
The simplification rules are encoded in LISP as follows:
(defun make-simplified-sum (arg1 arg2) "Given simplified polynomials ARG1 and ARG2, construct a simplified sum of ARG1 and ARG2." (cond ((and (constant-p arg1) (zerop arg1)) arg2) ((and (constant-p arg2) (zerop arg2)) arg1) (t (make-sum arg1 arg2)))) (defun make-simplified-product (arg1 arg2) "Given simplified polynomials ARG1 and ARG2, construct a simplified product of ARG1 and ARG2." (cond ((and (constant-p arg1) (zerop arg1)) (make-constant 0)) ((and (constant-p arg2) (zerop arg2)) (make-constant 0)) ((and (constant-p arg1) (= arg1 1)) arg2) ((and (constant-p arg2) (= arg2 1)) arg1) (t (make-product arg1 arg2)))) (defun make-simplified-power (base exponent) "Given simplified polynomials BASE and EXPONENT, construct a simplified power with base BASE and exponent EXPONENT." (cond ((and (constant-p exponent) (= exponent 1)) base) ((and (constant-p exponent) (zerop exponent)) (make-constant 1)) (t (make-power base exponent))))

Let us see how all these pay off:
USER(14): (simplify (d '(* (+ x 1) (+ x 1)) 'x)) (+ (+ X 1) (+ X 1)) USER(15): (simplify (d '(** (+ x 1) 2) 'x)) (* 2 (+ X 1))
Comparing to the original results we saw before, this is a lot more reasonable.
Exercise: Extend the symbolic polynomial framework in the following ways:

Define a new type of polynomial --- difference. If poly1 and poly2 are polynomials, then (make-difference poly1 poly2) is also a polynomial. Implement the constructor, recognizer and selectors for this type of polynomial.
The derivative (d(F-G)/dx) of a difference (F-G) is (dF/dx) - (dG/dx). Extend the differentiation function to incorporate this.
Implement the following simplification rule:

E - 0 = E

Exercise: Extend the symbolic polynomial framework in the following ways:

Define a new type of polynomial --- negation. If poly1 is a polynomial, then (make-negation poly) is also a polynomial. Implement the constructor, recognizer and selectors for this type of polynomial.
The derivative (d(-F)/dx) of a negation -F is -(dF/dx). Extend the differentiation function to incorporate this.
Implement the following simplification rules:

-0 = 0
-(-E) = E

Exercise: The simplification rules we have seen so far share a common feature: the right hand sides do not involve any new polynomial constructor. For example, -(-E) is simply E. However, some of the most useful simplification rules are those involving constructors on the right hand sides:

0 - E = -E
E₁ + (-E₂) = E₁ - E₂
(-E₁) + E₂ = E₂ - E₁
E₁ - (-E₂) = E₁ + E₂
E * (-1) = -E
(-1) * E = -E
Within the type-specific simplification functions, if we naively apply the regular constructors to build the expressions on the right hand sides, then we run into the risk of constructing polynomials that are not fully simplified. For example, -x and -1 are both fully simplified, but if we now construct their product (-1) * (-x), the last simplification rule above says that we can rewrite the product into -(-x), which needs further simplification. One naive solution is to blindly apply full simplification to the newly constructed polynomials, but this is obviously an overkill. What then is an efficient and yet correct implementation of the above simplification rules?

Exercise: If all the components of a composite polynomial are constants, then we can actually perform further simplification. For example, (+ 1 1) should be simplified to 2. Extend the simplification framework to incorporate this.

Tower of Hanoi

The Tower of Hanoi problem is a classical toy problem in Artificial Intelligence: There are N disks D₁, D₂, ..., D_n, of graduated sizes and three pegs 1, 2, and 3. Initially all the disks are stacked on peg 1, with D₁, the smallest, on top and D_n, the largest, at the bottom. The problem is to transfer the stack to peg 3 given that only one disk can be moved at a time and that no disk may be placed on top of a smaller one. [Pearl 1984]
We call peg 1 the "from" peg, peg 3 the "to" peg. Peg 2 is a actually a buffer to facilitate movement of disks, and we call it an "auxiliary" peg. We can move N disks from the "from" peg to the "to" peg using the following recursive scheme.

Ignoring the largest disk at the "from" peg, treat the remaining disks as a Tower of Hanoi problem with N-1 disks. Recursively move the top N-1 disks from the "from" peg to the "auxiliary" peg, using the "to" peg as a buffer.
Now that the N-1 smaller disks are in the "auxiliary" peg, we move the largest disk to the "to" peg.
Ignoring the largest disk again, treat the remaining disks as a Tower of Hanoi problem with N-1 disks. Recursively move the N-1 disks from the "auxiliary" peg to the "to" peg, using the "from" peg as a buffer.

To code this solution in LISP, we need to define some data structure. First, we represent a disk by a number, so that D_i is represented by i. Second, we represent a stack of disks by a tower, which is nothing but a list of numbers, with the first element representing the top disk. We define the usual constructors and selectors for the tower data type.
;; ;; A tower is a list of numbers ;; (defun make-empty-tower () "Create tower with no disk." nil) (defun tower-push (tower disk) "Create tower by stacking DISK on top of TOWER." (cons disk tower)) (defun tower-top (tower) "Get the top disk of TOWER." (first tower)) (defun tower-pop (tower) "Remove the top disk of TOWER." (rest tower))

Third, we define the hanoi data type to represent a Tower of Hanoi configuration. In particular, a hanoi configuration is a list of three towers. The elementary constructors and selectors are given below:
;; ;; Hanoi configuration ;; (defun make-hanoi (from-tower aux-tower to-tower) "Create a Hanoi configuration from three towers." (list from-tower aux-tower to-tower)) (defun hanoi-tower (hanoi i) "Select the I'th tower of a Hanoi construction." (nth (1- i) hanoi))

Working with towers within a Hanoi configuration is tedious. We therefore define some shortcut to capture recurring operations:
;; ;; Utilities ;; (defun hanoi-tower-update (hanoi i tower) "Replace the I'th tower in the HANOI configuration by tower TOWER." (cond ((= i 1) (make-hanoi tower (second hanoi) (third hanoi))) ((= i 2) (make-hanoi (first hanoi) tower (third hanoi))) ((= i 3) (make-hanoi (first hanoi) (second hanoi) tower)))) (defun hanoi-tower-top (hanoi i) "Return the top disk of the I'th tower in the HANOI configuration." (tower-top (hanoi-tower hanoi i))) (defun hanoi-tower-pop (hanoi i) "Pop the top disk of the I'th tower in the HANOI configuration." (hanoi-tower-update hanoi i (tower-pop (hanoi-tower hanoi i)))) (defun hanoi-tower-push (hanoi i disk) "Push DISK into the I'th tower of the HANOI configuration." (hanoi-tower-update hanoi i (tower-push (hanoi-tower hanoi i) disk)))

The fundamental operator we can perform on a Hanoi configuration is to move a top disk from one peg to another:
;; ;; Operator: move top disk from one tower to another ;; (defun move-disk (from to hanoi) "Move the top disk from peg FROM to peg TO in configuration HANOI." (let ((disk (hanoi-tower-top hanoi from)) (intermediate-hanoi (hanoi-tower-pop hanoi from))) (hanoi-tower-push intermediate-hanoi to disk)))

We are now ready to capture the logic of our recursive solution into the following code:
;; ;; Subgoal: moving a tower from one peg to another ;; (defun move-tower (N from aux to hanoi) "In the HANOI configuration, move the top N disks from peg FROM to peg TO using peg AUX as an auxiliary peg." (if (= N 1) (move-disk from to hanoi) (move-tower (- N 1) aux from to (move-disk from to (move-tower (- N 1) from to aux hanoi)))))

We use the driver function solve-hanoi to start up the recursion:
;; ;; Driver function ;; (defun solve-hanoi (N) "Solve the Tower of Hanoi problem." (move-tower N 1 2 3 (make-hanoi (make-complete-tower N) nil nil))) (defun make-complete-tower (N) "Create a tower of N disks." (make-complete-tower-aux N (make-empty-tower))) (defun make-complete-tower-aux (N A) "Push a complete tower of N disks on top of tower A." (if (zerop N) A (make-complete-tower-aux (1- N) (tower-push A N))))

To solve a Tower of Hanoi problem with 3 disks, we call (solve-hanoi 3):
USER(50): (solve-hanoi 3) (NIL NIL (1 2 3))
All we get back is the final configuration, which is not as interesting as knowing the sequence of moves taken by the algorithm. So we trace usage of the move-disk operator:
USER(51): (trace move-disk) (MOVE-DISK) USER(52): (solve-hanoi 3) 0: (MOVE-DISK 1 3 ((1 2 3) NIL NIL)) 0: returned ((2 3) NIL (1)) 0: (MOVE-DISK 1 2 ((2 3) NIL (1))) 0: returned ((3) (2) (1)) 0: (MOVE-DISK 3 2 ((3) (2) (1))) 0: returned ((3) (1 2) NIL) 0: (MOVE-DISK 1 3 ((3) (1 2) NIL)) 0: returned (NIL (1 2) (3)) 0: (MOVE-DISK 2 1 (NIL (1 2) (3))) 0: returned ((1) (2) (3)) 0: (MOVE-DISK 2 3 ((1) (2) (3))) 0: returned ((1) NIL (2 3)) 0: (MOVE-DISK 1 3 ((1) NIL (2 3))) 0: returned (NIL NIL (1 2 3)) (NIL NIL (1 2 3))
From the trace we can actually read off the sequence of operator applications necessary for one to achieve the solution configuration. This is good, but not good enough. We want to know why each move is being taken. So we trace also the high-level subgoals:
USER(53): (trace move-tower) (MOVE-TOWER) USER(54): (solve-hanoi 3) 0: (MOVE-TOWER 3 1 2 3 ((1 2 3) NIL NIL)) 1: (MOVE-TOWER 2 1 3 2 ((1 2 3) NIL NIL)) 2: (MOVE-TOWER 1 1 2 3 ((1 2 3) NIL NIL)) 3: (MOVE-DISK 1 3 ((1 2 3) NIL NIL)) 3: returned ((2 3) NIL (1)) 2: returned ((2 3) NIL (1)) 2: (MOVE-DISK 1 2 ((2 3) NIL (1))) 2: returned ((3) (2) (1)) 2: (MOVE-TOWER 1 3 1 2 ((3) (2) (1))) 3: (MOVE-DISK 3 2 ((3) (2) (1))) 3: returned ((3) (1 2) NIL) 2: returned ((3) (1 2) NIL) 1: returned ((3) (1 2) NIL) 1: (MOVE-DISK 1 3 ((3) (1 2) NIL)) 1: returned (NIL (1 2) (3)) 1: (MOVE-TOWER 2 2 1 3 (NIL (1 2) (3))) 2: (MOVE-TOWER 1 2 3 1 (NIL (1 2) (3))) 3: (MOVE-DISK 2 1 (NIL (1 2) (3))) 3: returned ((1) (2) (3)) 2: returned ((1) (2) (3)) 2: (MOVE-DISK 2 3 ((1) (2) (3))) 2: returned ((1) NIL (2 3)) 2: (MOVE-TOWER 1 1 2 3 ((1) NIL (2 3))) 3: (MOVE-DISK 1 3 ((1) NIL (2 3))) 3: returned (NIL NIL (1 2 3)) 2: returned (NIL NIL (1 2 3)) 1: returned (NIL NIL (1 2 3)) 0: returned (NIL NIL (1 2 3)) (NIL NIL (1 2 3))
The trace gives us information as to what subgoals each operator application is trying to establish. For example, the top level subgoals are the following:
0: (MOVE-TOWER 3 1 2 3 ((1 2 3) NIL NIL)) 1: (MOVE-TOWER 2 1 3 2 ((1 2 3) NIL NIL)) ... 1: returned ((3) (1 2) NIL) 1: (MOVE-DISK 1 3 ((3) (1 2) NIL)) 1: returned (NIL (1 2) (3)) 1: (MOVE-TOWER 2 2 1 3 (NIL (1 2) (3))) ... 1: returned (NIL NIL (1 2 3)) 0: returned (NIL NIL (1 2 3))
They translate directly to the following: In order to move a tower of 3 disks from peg 1 to peg 3 using peg 2 as a buffer (i.e. (MOVE-TOWER 3 1 2 3 ((1 2 3) NIL NIL))) we do the following:

"1: (MOVE-TOWER 2 1 3 2 ((1 2 3) NIL NIL))"
Move a tower of 2 disks from peg 1 to peg 2 using peg 3 as a buffer. The result of the move is the following:
"1: returned ((3) (1 2) NIL)"
"1: (MOVE-DISK 1 3 ((3) (1 2) NIL))"
Move a top disk from peg 1 to peg 3. The result of this move is:
"1: returned (NIL (1 2) (3))"

"1: (MOVE-TOWER 2 2 1 3 (NIL (1 2) (3)))"
Move a tower of 2 disks from peg 2 to peg 3 using peg 1 as a buffer, yielding the following configuration:
"1: returned (NIL NIL (1 2 3))"