;;;
;;; find path from start to finish which goes through
;;; each node only once
;;;
(defparameter start '(a f l k s))
(defparameter a '(f b h d))
(defparameter b '(a l m g))
(defparameter c '(d o i g))
(defparameter d '(a h c o j))
(defparameter e '(k p s))
(defparameter f '(a l))
(defparameter g '(b c h m n))
(defparameter h '(a d g))
(defparameter i '(c r n finish))
(defparameter j '(d o))
(defparameter k '(e))
(defparameter l '(f b p))
(defparameter m '(b g n p))
(defparameter n '(g i m u finish))
(defparameter o '(j d c r finish))
(defparameter p '(l m e v))
(defparameter q '(v p m n u))
(defparameter r '(i o))
(defparameter s '(e v finish))
(defparameter v '(s p u))
(defparameter u '(q v n finish))
(defparameter finish '())
;;;
;;; states is a list of partial paths.
;;; the initial state would be ((start)).
;;; states after visiting start will be
;;; ((a start) (f start) (l start) (k start) (s start))
;;; and so on.
;;;
(defun walk-path (to states)
(if (null states) ; the search is exhausted
nil ; return no solution
(let* ((path (first states)) ; otherwise, get the next partial path
(node (first path))) ; and the last node on the path (path is in reverse order)
(if (and (equal node to) ; if this is the terminal node
(equal (length path) 23)) ; and all nodes have been visited
(reverse path) ; return the solution
; otherwise, create a list of unvisited nodes
; from node, add them to the path, and
; the state space to be searched
(let ((next-nodes (set-difference (symbol-value node) path)))
(walk-path to
(append (rest states)
(mapcar (lambda (node) (cons node path)) next-nodes))))))))
;;;
;;; solution is:
;;; (path 'start 'finish)
;;;
(defun path (from to)
(walk-path to (list (list from))))
