Anonymous user
Word ladder: Difference between revisions
→{{header|Haskell}}: added the simple and efficient solution
(Fix unixdict link) |
(→{{header|Haskell}}: added the simple and efficient solution) |
||
Line 269:
=={{header|Haskell}}==
Uses solution of the task [[A*_search_algorithm#Haskell]].▼
<lang haskell>import System.IO (readFile)
import
import
import qualified Data.
distance :: String -> String -> Int
distance s1 s2 = length $ filter not $ zipWith (==) s1 s2
| length start /= length end = []
| otherwise = [wordSpace] >>= expandFrom start >>= shrinkFrom end
where
short_dict = filter ((length start ==) . length) dict▼
| x <- short_dict▼
expandFrom s = go [[s]]
, distance w x == 1 ]▼
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"
Line 298 ⟶ 318:
showChain $ wordLadder dict "child" "adult"</lang>
<pre>λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "boy" "man"
<pre>*Main> main▼
[["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
▲ short_dict = filter ((length start ==) . length) dict
g = Graph $ \w -> M.fromList [ (x, 1)
▲ | x <- short_dict
▲ , distance w x == 1 ]</lang>
boy -> bay -> ban -> man
girl -> gird -> bird -> bard -> lard -> lark -> lack -> lacy -> lady
| |||