wordchain.hs

import Data.Set(Set, fromDistinctAscList, member)
import System.IO.Unsafe(unsafePerformIO)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import Control.Monad (when)
import Data.Tree

oneStep :: String -> [String]
oneStep = filter isValidWord . generateCandidates

generateCandidates :: String -> [String]
generateCandidates [] = []
generateCandidates (c:cs) = [ x : cs | x <- ['a'..'z'], x /= c ]
                         ++ [ c : xs | xs <- generateCandidates cs ]

loadDictionary :: FilePath -> Set String
loadDictionary = fromDistinctAscList . lines . unsafePerformIO . readFile

dict :: Set String
dict = loadDictionary "wordlist.txt"

isValidWord :: String -> Bool
isValidWord w = member w dict

stateTree :: (s -> [s]) -> s -> Tree s
stateTree childrenOf state =
  Node state [ stateTree childrenOf s | s <- childrenOf state ]

prune :: Int -> Tree a -> Tree a
prune d (Node x cs)
 | d <= 0    = Node x []
 | otherwise = Node x [ prune (d - 1) c | c <- cs ]

bft :: Tree a -> [a]
bft t = bft' [t]
bft' :: [Tree a] -> [a]
bft' trees = [ x | Node x _ <- trees ] ++ bft' (concatMap subForest trees)

breadthFirstSearch :: (s -> Bool) -> (s -> [s]) -> s -> [s]
breadthFirstSearch p getChildren = filter p . bft . stateTree getChildren

type Path = [String]

goalPath :: String -> Path -> Bool
goalPath target ws = target == head ws

childPaths :: Path -> [Path]
childPaths [] = [[]]
childPaths (w:ws) = [ s : w : ws | s <- oneStep w, s `notElem` ws ]

initPath :: String -> Path
initPath w = [w]

wordChainPath :: String -> String -> [Path]
wordChainPath a b = breadthFirstSearch (goalPath b) childPaths (initPath a)

main :: IO ()
main = do
  args <- getArgs
  when (length args /= 2) $ do
    putStrLn "Syntax: wordchain from to"
    exitFailure
  print . reverse . head $ wordChainPath (head args) (args !! 1)