Word ladder: Difference between revisions

import Control.Monad (foldM)

import Data.List (intercalate)

import qualified Data.Set as S

wordLadders :: [String] -> String -> String -> [[String]]

wordLadders dict start end

| length start /= length end = []

| otherwise = [wordSpace] >>= expandFrom start >>= shrinkFrom end

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

<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===

See [[A*_search_algorithm#Haskell]]

<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>

<pre>λ> main