mirror of
https://codeberg.org/JasterV/word-ladder.hs.git
synced 2026-04-26 18:10:06 +00:00
implement main function for the program
This commit is contained in:
parent
c959e7a9e1
commit
2de7a46b7c
3 changed files with 38 additions and 22 deletions
21
app/Main.hs
21
app/Main.hs
|
|
@ -1,6 +1,23 @@
|
|||
module Main (main) where
|
||||
|
||||
import Lib
|
||||
import Ladder (ladderSolve, readDictionary)
|
||||
import System.Environment
|
||||
|
||||
printHelpText :: String -> IO ()
|
||||
printHelpText msg = do
|
||||
putStrLn (msg ++ "\n")
|
||||
progName <- getProgName
|
||||
putStrLn ("Usage: " ++ progName ++ " <filename> <start> <end>")
|
||||
|
||||
main :: IO ()
|
||||
main = someFunc
|
||||
main = do
|
||||
args <- getArgs
|
||||
case args of
|
||||
[dictFile, start, end] -> do
|
||||
dict <- readDictionary dictFile
|
||||
case ladderSolve dict start end of
|
||||
Nothing -> putStrLn "No solution"
|
||||
Just solution -> do
|
||||
print solution
|
||||
putStrLn ("Length: " ++ show (length solution))
|
||||
_ -> printHelpText "Wrong arguments"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
module Ladder (readDictionary, mkLadderGraph) where
|
||||
module Ladder (readDictionary, ladderSolve) where
|
||||
|
||||
import Data.Char (isLower)
|
||||
import qualified Data.List as L
|
||||
|
|
@ -8,6 +8,11 @@ import Prelude hiding (lines, words)
|
|||
|
||||
type Dictionary = [String]
|
||||
|
||||
ladderSolve :: Dictionary -> String -> String -> Maybe [String]
|
||||
ladderSolve dict start end =
|
||||
let graph = mkLadderGraph dict
|
||||
in G.bfsSearch graph start end
|
||||
|
||||
readDictionary :: String -> IO Dictionary
|
||||
readDictionary filename = do
|
||||
text <- readFile filename
|
||||
|
|
@ -16,19 +21,19 @@ readDictionary filename = do
|
|||
return (L.nub lowercaseWords)
|
||||
|
||||
mkLadderGraph :: Dictionary -> G.DiGraph String
|
||||
mkLadderGraph dict = G.buildDiGraph [(word, computeCandidates permMap word) | word <- dict]
|
||||
mkLadderGraph dict = G.buildDiGraph [(word, computeCandidates word) | word <- dict]
|
||||
where
|
||||
permMap = PM.createPermutationMap dict
|
||||
|
||||
computeCandidates :: PM.PermutationMap -> String -> [String]
|
||||
computeCandidates permMap word =
|
||||
-- Delete the original word from the permutations list
|
||||
L.delete word permutations
|
||||
where
|
||||
removed = [L.delete c word | c <- word]
|
||||
added = [c : word | c <- ['a' .. 'z']]
|
||||
modified = [x : L.delete y word | x <- ['a' .. 'z'], y <- word, x /= y]
|
||||
-- Sort and deduplicate all the candidates
|
||||
candidates = L.nub $ map L.sort (added ++ removed ++ modified ++ [word])
|
||||
-- For each candidate, lookup all its permutations
|
||||
permutations = L.concatMap (\w -> PM.findWithDefault [] w permMap) candidates
|
||||
computeCandidates :: String -> [String]
|
||||
computeCandidates word =
|
||||
-- Delete the original word from the permutations list
|
||||
L.delete word permutations
|
||||
where
|
||||
removed = [L.delete c word | c <- word]
|
||||
added = [c : word | c <- ['a' .. 'z']]
|
||||
modified = [x : L.delete y word | x <- ['a' .. 'z'], y <- word, x /= y]
|
||||
-- Sort and deduplicate all the candidates
|
||||
candidates = L.nub $ map L.sort (added ++ removed ++ modified ++ [word])
|
||||
-- For each candidate, lookup all its permutations
|
||||
permutations = L.concatMap (\w -> PM.findWithDefault [] w permMap) candidates
|
||||
|
|
|
|||
|
|
@ -1,6 +0,0 @@
|
|||
module Lib
|
||||
( someFunc
|
||||
) where
|
||||
|
||||
someFunc :: IO ()
|
||||
someFunc = putStrLn "someFunc"
|
||||
Loading…
Reference in a new issue