(defun unify-letters (letter-map letter1 letter2)
  (char= letter2 (internhash letter-map letter1 letter2)))
 
(defun unify-words (word1 word2 letter-map)
  (when (= (length word1) (length word2))
    (let ((map (copy-hash-table letter-map)))
      (values (every (sp #'unify-letters map _ _) word1 word2) map))))
 
(defun unify (word1 word2 letter-map)
  (multiple-value-bind (succeded-p map) (unify-words word1 word2 letter-map)
    (when succeded-p
      (maphash (sp #'internhash letter-map _ _) map))))
 
(defun solve (dictionary input)
  (let ((map (hash)))
    (loop for w1 in input
       do (loop for w2 in dictionary
       do (unify w1 w2 map)))
    map))
 
(defun purify (input)
  (sort (remove-duplicates (copy-list input) :test #'string=) #'string>))
 
(defun decrypt (dictionary input)
  (let ((map (solve dictionary input)))
    (mapcar (lambda (word) (map 'string (sp #'gethash _ map) word)) input)))

You missed a reference to the alphabet variable in the recursive call to find-mapping.

Sorry! Thanks for noticing.
–Mikael

I don’t mind at all. Go ahead, and thanks for posting something interesting.

Looks good!

I did try the alist route (even had the same make-mapping as you did :)) when I was done with the hash-table version, but I was too tired to realize the fail-condition was as easy as comparing the cons pairs of the mapping. So I scrapped that and wrote a piece on what I had working.

Mind if I add the paste to your comment?

http://paste.lisp.org/display/74915

(defparameter *dictionary*
  '("and" "dick" "jane" "puff" "spot" "yertle"))
 
(defparameter *input*
  '("bjvg" "xsb" "hxsn" "xsb" "qymm" "xsb" "rqat" "xsb" "pnetfn"))
 
(defun solve ()
  (decrypt *input* (find-mapping *input* *dictionary* (make-mapping))))
 
(defun find-mapping (input dictionary mapping)
  (cond ((null mapping) nil)
        ((complete-mapping-p mapping input) mapping)
        (t (let ((term (find-unmapped-term input mapping)))
             (some (lambda (word)
                     (find-mapping (remove term input :test #'equal)
                                   (remove word dictionary :test #'equal)
                                   (extend-mapping term word mapping)))
                   dictionary)))))
 
(defun complete-mapping-p (mapping input)
  (every (lambda (term)
           (every (lambda (c) (lookup-crypt c mapping)) term))
         input))
 
(defun make-mapping () '((t . t)))
(defun lookup-crypt (c mapping) (assoc c mapping))
(defun lookup-plain (c mapping) (rassoc c mapping))
 
(defun extend-mapping (term word mapping)
  (when (= (length term) (length word))
    (loop for tc across term
          for wc across word
          for m1 = (lookup-crypt tc mapping)
          for m2 = (lookup-plain wc mapping)
          do (cond ((and m1 m2)
                    (unless (eql m1 m2)
                      (return-from extend-mapping nil)))
                   ((or m1 m2)
                    (return-from extend-mapping nil))
                   (t (push (cons tc wc) mapping))))
    mapping))
 
(defun find-unmapped-term (input mapping)
  (find-if (lambda (term)
             (not (complete-mapping-p mapping (list term))))
           input))
 
(defun decrypt (input mapping)
  (when mapping
    (mapcar (lambda (term) (decrypt-term term mapping)) input)))
 
(defun decrypt-term (term mapping)
  (map 'string (lambda (c) (cdr (lookup-crypt c mapping))) term))