Word ladder: Difference between revisions
Content deleted Content added
Fix unixdict link |
→{{header|Haskell}}: added the simple and efficient solution |
||
Line 269: | Line 269: | ||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
⚫ | |||
<lang haskell>import System.IO (readFile) |
<lang haskell>import System.IO (readFile) |
||
import |
import Control.Monad (foldM) |
||
import |
import Data.List (intercalate) |
||
import Data. |
import qualified Data.Set as S |
||
distance :: String -> String -> Int |
distance :: String -> String -> Int |
||
distance s1 s2 = length $ filter not $ zipWith (==) s1 s2 |
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 |
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 [] = putStrLn "No chain" |
||
Line 298: | Line 318: | ||
showChain $ wordLadder dict "child" "adult"</lang> |
showChain $ wordLadder dict "child" "adult"</lang> |
||
<pre>λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "boy" "man" |
|||
⚫ | |||
[["boy","bay","ban","man"],["boy","bon","ban","man"],["boy","bay","may","man"]] |
|||
λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "girl" "lady" |
|||
[["girl","gill","gall","gale","gaze","laze","lazy","lady"]] |
|||
λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "child" "adult" |
|||
[] |
|||
λ> main |
|||
boy -> bay -> ban -> man |
|||
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady |
|||
john -> cohn -> conn -> cone -> cane -> jane |
|||
alien -> alden -> alder -> alter -> aster -> ester -> eater -> bater -> bator -> baton -> baron -> boron -> moron -> moran -> moral -> morel -> monel -> money -> monty -> month -> mouth -> south -> sooth -> sloth -> slosh -> slash -> flash -> flask -> flank -> blank -> bland -> blend -> bleed -> breed -> bread -> tread -> triad -> trial -> trill -> drill -> droll -> drool |
|||
No chain</pre> |
|||
===Using A*-search=== |
|||
⚫ | |||
<lang haskell>import AStar (findPath, Graph(..)) |
|||
import qualified Data.Map as M |
|||
distance :: String -> String -> Int |
|||
distance s1 s2 = length $ filter not $ zipWith (==) s1 s2 |
|||
wordLadder :: [String] -> String -> String -> [String] |
|||
wordLadder dict start end = findPath g distance start end |
|||
where |
|||
⚫ | |||
g = Graph $ \w -> M.fromList [ (x, 1) |
|||
⚫ | |||
⚫ | |||
⚫ | |||
boy -> bay -> ban -> man |
boy -> bay -> ban -> man |
||
girl -> gird -> bird -> bard -> lard -> lark -> lack -> lacy -> lady |
girl -> gird -> bird -> bard -> lard -> lark -> lack -> lacy -> lady |