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:
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:
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:
;; ;; 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
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:
(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
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:
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 are blackboxes. They are defined in terms of their external interfaces, and not their implementation. For example, a set abstraction offers the following operations:
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))
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.
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:
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 3A 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 2A 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))
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:
;; ;; 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)^{2} 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:
;; ;; Unevaluated derivative ;; (defun make-derivative (poly x) (list 'd poly x)) (defun derivative-p (poly x) (and (listp poly) (eq (first poly) 'd)))
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:
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.
The Tower of Hanoi problem is a classical toy problem in Artificial Intelligence: There are N disks D_{1}, D_{2}, ..., D_{n}, of graduated sizes and three pegs 1, 2, and 3. Initially all the disks are stacked on peg 1, with D_{1}, 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.
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: