diff --git a/app/Main.hs b/app/Main.hs index 4c6b30f..c4eb8a2 100644 --- a/app/Main.hs +++ b/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 ++ " ") 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" diff --git a/src/Ladder.hs b/src/Ladder.hs index 80d4fed..0a0cb93 100644 --- a/src/Ladder.hs +++ b/src/Ladder.hs @@ -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 diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 index d36ff27..0000000 --- a/src/Lib.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Lib - ( someFunc - ) where - -someFunc :: IO () -someFunc = putStrLn "someFunc"