How to resolve the algorithm Word ladder step by step in the Haskell programming language
How to resolve the algorithm Word ladder step by step in the Haskell programming language
Table of Contents
Problem Statement
Yet another shortest path problem. Given two words of equal length the task is to transpose the first into the second. Only one letter may be changed at a time and the change must result in a word in unixdict, the minimum number of intermediate words should be used. Demonstrate the following: A boy can be made into a man: boy -> bay -> ban -> man With a little more difficulty a girl can be made into a lady: girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady A john can be made into a jane: john -> cohn -> conn -> cone -> cane -> jane A child can not be turned into an adult. Optional transpositions of your choice.
Let's start with the solution:
Step by Step solution about How to resolve the algorithm Word ladder step by step in the Haskell programming language
This code implements a function that takes a list of words, a starting word, and an ending word, and returns a list of lists of words that represent valid word ladders from the starting word to the ending word.
A word ladder is a sequence of words where each word is one character different from the previous word.
The code uses a graph search algorithm to find the shortest path from the starting word to the ending word. The graph is constructed by creating a node for each word in the dictionary and connecting each node to all the other nodes that are one character different.
The distance function calculates the number of characters that are different between two words.
The wordLadders function uses the foldM function to build the graph and then uses the shrinkFrom function to find the shortest path from the starting word to the ending word.
The showChain function prints the list of words in the word ladder.
The main function reads the dictionary from a file and then calls the wordLadder function to find the shortest word ladder for each of the given pairs of words.
The wordLadders2 function is a modified version of the wordLadders function that uses a more efficient algorithm to find the shortest word ladder.
The findPath function is used to find the shortest path from the starting word to the ending word in the graph.
The distance function is used to calculate the distance between two words.
The Graph data type represents a graph as a map from nodes to a list of edges.
The M.fromList function is used to create a map from a list of key-value pairs.
The findM function is used to find the first element in a list that satisfies a given predicate.
Source code in the haskell programming language
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"
wordLadders2 :: String -> String -> [String] -> [[String]]
wordLadders2 start end dict
| length start /= length end = []
| otherwise = pure wordSpace >>= expand start end >>= shrink end
where
wordSpace = S.fromList $ filter ((length start ==) . length) dict
expand s e d = tail . map S.elems <$> go [S.singleton s] [S.singleton e] d
where
go (hs:ts) (he:te) d
| S.null d || S.null fs || S.null fe = []
| not $ S.null f1 = [reverse (f1:te) ++ hs:ts]
| not $ S.null f2 = [reverse (he:te) ++ f2:ts]
| not $ S.null f3 = [reverse (he:te) ++ f3:hs:ts]
| otherwise = go (fs:hs:ts) (fe:he:te) (d S.\\ hs S.\\ he)
where
fs = front hs
fe = front he
f1 = fs `S.intersection` he
f2 = fe `S.intersection` hs
f3 = fs `S.intersection` fe
front = S.foldr (\w -> S.union (S.filter (oneStepAway w) d)) mempty
shrink = scanM (findM . 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
findM p = msum . map (\x -> if p x then pure x else mzero)
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 ]
You may also check:How to resolve the algorithm Golden ratio/Convergence step by step in the Shen programming language
You may also check:How to resolve the algorithm Taxicab numbers step by step in the Delphi programming language
You may also check:How to resolve the algorithm Sum and product of an array step by step in the K programming language
You may also check:How to resolve the algorithm Sorting algorithms/Insertion sort step by step in the Erlang programming language
You may also check:How to resolve the algorithm Monads/List monad step by step in the Java programming language