Add-A-Gram
Another toy problem from the ITA software page is the Add-A-Gram:
An “add-a-gram”
is a sequence of words formed by starting with a 3-letter word, adding
a letter and rearranging to form a 4-letter word, and so on. For example,
here are add-a-grams of the words “CREDENTIALS” and “ANACHRONISM”:
ail + s =
sail + n =
nails + e =
aliens + t =
salient + r =
entrails + c =
clarinets + e =
interlaces + d =
CREDENTIALS (length 11)
(…) given the dictionary found
here (1.66MB), what is the longest add-a-gram?
Running my code to get the longst add-a-gram is left as an exercise to the reader 😉 I also did some basic performance testing and compared the results
of my Lisp version to those of the versions on the site in
Perl
and Python. Looks like Lisp isn’t so slow after all. Timings and Lisp code follow:
;; CMUCL: $ time lisp -eval '(compile-file "add-a-gram.lisp")' -eval '(load "add-a-gram.x86f")' -eval '(run)' -eval '(quit)' ;; real 0m11.834s ;; Python: $ time ./addagram.py WORD.LST ;; real 0m43.589s ;; Perl: $ time perl addagram.pl WORD.LST ;; real 0m17.541s (defvar *wordlist* nil) (defun run () (let ((best-word "")) (setq *wordlist* (make-hash-table :test 'equal)) (read-file "WORD.LST") (maphash #'(lambda (sorted-word word) (if (> (length word) (length best-word)) (if (add-a-gram-p sorted-word) (setf best-word sorted-word)))) *wordlist*) (show-result best-word))) (defun read-file (arg-file-name) (let ((line nil)) (with-open-file (stream arg-file-name :direction :input) (loop while (setq line (read-line stream nil)) do (unless ( (length line) 3) (setf (gethash (sort-word line) *wordlist*) line)))))) (defun add-a-gram-p (sorted-word) (let ((foo nil)) (cond ((= (length sorted-word) 3) (gethash sorted-word *wordlist*)) ((null (gethash sorted-word *wordlist*)) nil) (t (setf foo (remove-one-char sorted-word)) (loop until (or (null foo) (add-a-gram-p (car foo))) do (setf foo (cdr foo))) (car foo))))) (defun remove-one-char (word) (let ((foo nil)) (loop for k from 1 to (length word) do (push (concatenate 'string (subseq word 0 (1- k)) (subseq word k (length word))) foo)) foo)) (defun sort-word (word) (concatenate 'string (sort (coerce word 'list) #'char<))) (defun show-result (sorted-word) (cond ((= (length sorted-word) 3) (format t "~A~%" (gethash sorted-word *wordlist*)) ) (t (format t "~A~%" (gethash sorted-word *wordlist*)) (show-result (add-a-gram-p sorted-word)))))