Given two words *from* and *to*, transform *from* into *to* by either adding, removing or altering one letter at a time, so that each step in the transformation is a valid English word.

wordgame.hs

import           Control.Applicative
import qualified Data.Set               as Set
import           AI.Search.Uninformed

step :: Set.Set String -> String -> [] String
step wordlist xs = Set.toList . Set.fromList . filter f $ remove1 xs ++ swap1 xs ++ add1 xs
 where
  f w = Set.member w wordlist
  len = length xs
  letters = ['a'..'z']

  remove1 xs = [take n xs ++ drop (n+1) xs | n <- [0..len-1]]
  add1    xs = [take n xs ++ [x] ++ drop n xs | x <- letters, n <- [0..len]]
  swap1   xs = [take n xs ++ [x] ++ drop (n+1) xs | x <- letters, n <- [0..len-1]]

makeWordProblem :: Set.Set String -> String -> String -> SearchProblem String ()
makeWordProblem wl from to = SearchProblem
  { probInitialState = from
  , probSuccessor    = \w -> map (\w -> ((),w)) (step wl w)
  , probGoalTest     = (== to)
  , probCost         = \s a s' -> 1
  }

solve :: String -> String -> IO String
solve from to = do
  wordlist <- Set.fromList . lines <$> readFile "3esl.txt"
  case breadthFirstGraphSearch (makeWordProblem wordlist from to) of
    Nothing   -> putStrLn "NO SOLUTION FOUND"
    Just node -> mapM_ (putStrLn . nodeState) (reverse $ path node)

{------------------------

>> :load wordgame.hs
>> solve "black" "white"
black
back
balk
bale
hale
whale
while
white
>> solve "milk" "pail"
milk
mill
mall
mail
pail
>>

-------------------------}