(defvar *dictionary* nil
"The dictionary that should be loaded before searching a route.")
(defvar *index* nil
"A table of correspondences between the dictionary entries.")
(defun one-step-p (x y)
"Returns T if the lists X and Y have only one element that is not EQUAL."
(= (loop for i in x for j in y count (not (equal i j))) 1))
(defun one-step-words (index)
"A list of indices for words that are one step away from the word at INDEX."
(loop with from = (nth index *dictionary*)
for i from 0 below (length *dictionary*)
when (one-step-p from (nth i *dictionary*))
collect i))
(defun generate-index ()
"Generates a list of one-step indices for every word."
(let ((n (length *dictionary*)))
(setf *index* (make-array n))
(dotimes (i n)
(setf (aref *index* i) (one-step-words i)))))
(defun split-line (line)
"Splits a line at every space to a list of strings."
(let ((space (position #\Space line)))
(if space
(append (list (subseq line 0 space))
(split-line (subseq line (1+ space))))
(list line))))
(defun load-dictionary (filename)
"Loads (and initializes) a dictionary file."
(with-open-file (file filename)
(setf *dictionary*
(loop for line = (read-line file nil)
while line collect (split-line line))))
(generate-index))
(defun make-word (lst)
"Concatenates the elements in LST."
(apply #'concatenate 'string lst))
(defun find-index (word)
"Returns the position of WORD in the dictionary."
(position word *dictionary* :key #'make-word :test #'equal))
(defun waterfall-step (distances)
"Generates the distance map one step further.
Returns NIL if there was any change, T if not."
(let ((no-change t))
(dotimes (i (length *index*))
(let ((current (aref distances i)))
(when current
(loop for neighbour in (aref *index* i) do
(when (or (null (aref distances neighbour))
(> (aref distances neighbour) (1+ current)))
(setf (aref distances neighbour) (1+ current)
no-change nil))))))
no-change))
(defun generate-distances (index)
"Generates the distance map from the word at INDEX."
(let* ((n (length *index*))
(distances (make-array n :initial-element nil)))
(setf (aref distances index) 0)
(do () ((waterfall-step distances) distances))))
(defun find-paths (distances index)
"Finds all routes from word at INDEX to the word with distance 0."
(if (= (aref distances index) 0)
(list (list index))
(mapcar #'(lambda (lst) (cons index lst))
(mapcan #'(lambda (neighbour)
(find-paths distances neighbour))
(remove-if-not #'(lambda (neighbour)
(= (aref distances neighbour)
(1- (aref distances index))))
(aref *index* index))))))
(defun search-route (from to)
"Searches the shortest route(s) between the words FROM and TO.
Throws an error if FROM or TO are not present in the dictionary and
returns NIL if there is no route between them."
(let ((from-index (find-index from))
(to-index (find-index to)))
(unless from-index (error "no such word: ~a" from))
(unless to-index (error "no such word: ~a" to))
(let ((routes (find-paths (generate-distances from-index) to-index)))
(mapcar #'(lambda (lst)
(mapcar #'(lambda (index)
(make-word (nth index *dictionary*)))
(reverse lst)))
routes))))