(defun other-table (a b &optional (tables '(table-a table-b table-c))) (car (remove b (remove a tables)))) (defun hanoi-program (&optional (n 3) (from 'table-a) (to 'table-b) (other (other-table from to))) (cond ((= n 1) (list (list 'move-disk (list 'disk n) from to))) (t (append (hanoi-program (1- n) from other) (list (list 'move-disk (list 'disk n) from to)) (hanoi-program (1- n) other to)))) ) (defun hanoi-execute (n &optional (init table-a)) (hanoi-init n init) (dolist (code (hanoi-program n 'table-a 'table-b)) (eval code)) )4個のディスクの場合には,次のような move-disk動作列を得られる.
15.eusgl$ (pprint (hanoi-program 4)) ((move-disk (disk 1) table-a table-c) (move-disk (disk 2) table-a table-b) (move-disk (disk 1) table-c table-b) (move-disk (disk 3) table-a table-c) (move-disk (disk 1) table-b table-a) (move-disk (disk 2) table-b table-c) (move-disk (disk 1) table-a table-c) (move-disk (disk 4) table-a table-b) (move-disk (disk 1) table-c table-b) (move-disk (disk 2) table-c table-a) (move-disk (disk 1) table-b table-a) (move-disk (disk 3) table-c table-b) (move-disk (disk 1) table-a table-c) (move-disk (disk 2) table-a table-b) (move-disk (disk 1) table-c table-b)) nil