This is a collection of blog entries written while learning Lisp. It is posted in the order written so you probably want to jump to the first post.

Saturday, November 3, 2007

50 States

Over on reddit I saw the problem "Take the names of two U.S. States, mix them all together, then rearrange the letters to form the names of two other U.S. States. What states are these?"

At first I was going to code the (already presented) solution for the general case "Given a set of strings find two pair whom contain the same letter", but instead played around with the problem to see if I could find a faster solution which ended me with the following solution:

If you first sort each state and then sort the states you will find that four states sit next to one another (the exploitable property of the states set).
aachilnnoorrt (northcarolina)
aachilnoorstu (southcarolina)
aadhknoortt (northdakota)
aadhkoosttu (southdakota)

Then walk the list calculating the difference between the current word and the next word and store it in a list (haven't done hash yet in lisp) until you find a second duplicate difference in this case is "norsu"

This code could be cleaner and I think that I could write clean-states with map, but feel that I have spent a little too much time on this one problem so here is the code. A big problem I had with this was that I have no idea how to actually profile Lisp code. In C++ I would use valgrind. I will have to continue reading Practical Common Lisp to get to the chapter on packages so I can use the profiling packages. It was fun writing a larger problem in Lisp even when the fact that this is my first larger lisp program really shows.

(defun clean-states (lst)
(if (not lst)
(cons (sort (copy-seq (car lst)) #'char<)
(clean-states (cdr lst)))))

(defun simplify (w &optional (s 0))
(if (> (+ 2 s) (length w))
(if (char= (char w s) (char w (+ 1 s)))
(simplify (concatenate 'string (subseq w 0 s) (subseq w (+ 2 s))) s)
(simplify w (+ 1 s)))))

(defun diff (a b)
(loop for x across a
for y across b
for i from 0
until (not (eq x y))
finally (return
(concatenate 'string (subseq a i) (subseq b i))

(defun check (x lst)
(if (null lst)
(let* ((y (first lst))
(dif (diff x y))
(sub (simplify dif)))
(let ((match (member sub *known* :test #'(lambda (x y) (string= x (car y))))))
(if (not match)
(push (cons sub (list x (first lst))) *known*)
;; (check x (cdr lst)) ;; enable this for the general solution
(cdr (append (car match) (list x (first lst)))))))))

(defun find-match (lst)
(if (null lst)
(let ((answer (check (car lst) (cdr lst))))
(if (not answer)
(find-match (cdr lst))

(defun printout (words clean states)
(dolist (word words)
(loop for s in clean
for w in states
until (string= word s)
finally (return
(format t "~A " w)))))

(defvar *known* ())
(defun run ()
(setf *known* ())
(let* ((states '(
"alabama" "alaska" "arizona" "arkansas" "california" "colorado" "connecticut" "delaware" "florida" "georgia" "hawaii" "idaho" "illinois" "indiana" "iowa" "kansas" "kentucky" "louisiana" "maine" "maryland" "massachusetts" "michigan" "minnesota" "mississippi" "missouri" "montana" "nebraska" "nevada" "newhampshire" "newjersey" "newmexico" "newyork" "northcarolina" "northdakota" "ohio" "oklahoma" "oregon" "pennsylvania" "rhodeisland" "southcarolina" "southdakota" "tennessee" "texas" "utah" "vermont" "virginia" "washington" "westvirginia" "wisconsin" "wyoming"
(clean (clean-states states))
(results (find-match (sort (copy-list clean) #'string<))))
(printout results clean states)))


No comments: