47 lines
1.4 KiB
Haskell
47 lines
1.4 KiB
Haskell
import System.IO (readFile)
|
|
import Control.Monad (foldM)
|
|
import Data.List (intercalate)
|
|
import qualified Data.Set as S
|
|
|
|
distance :: String -> String -> Int
|
|
distance s1 s2 = length $ filter not $ zipWith (==) s1 s2
|
|
|
|
wordLadders :: [String] -> String -> String -> [[String]]
|
|
wordLadders dict start end
|
|
| length start /= length end = []
|
|
| otherwise = [wordSpace] >>= expandFrom start >>= shrinkFrom end
|
|
where
|
|
|
|
wordSpace = S.fromList $ filter ((length start ==) . length) dict
|
|
|
|
expandFrom s = go [[s]]
|
|
where
|
|
go (h:t) d
|
|
| S.null d || S.null f = []
|
|
| end `S.member` f = [h:t]
|
|
| otherwise = go (S.elems f:h:t) (d S.\\ f)
|
|
where
|
|
f = foldr (\w -> S.union (S.filter (oneStepAway w) d)) mempty h
|
|
|
|
shrinkFrom = scanM (filter . oneStepAway)
|
|
|
|
oneStepAway x = (1 ==) . distance x
|
|
|
|
scanM f x = fmap snd . foldM g (x,[x])
|
|
where g (b, r) a = (\x -> (x, x:r)) <$> f b a
|
|
|
|
wordLadder :: [String] -> String -> String -> [String]
|
|
wordLadder d s e = case wordLadders d s e of
|
|
[] -> []
|
|
h:_ -> h
|
|
|
|
showChain [] = putStrLn "No chain"
|
|
showChain ch = putStrLn $ intercalate " -> " ch
|
|
|
|
main = do
|
|
dict <- lines <$> readFile "unixdict.txt"
|
|
showChain $ wordLadder dict "boy" "man"
|
|
showChain $ wordLadder dict "girl" "lady"
|
|
showChain $ wordLadder dict "john" "jane"
|
|
showChain $ wordLadder dict "alien" "drool"
|
|
showChain $ wordLadder dict "child" "adult"
|