Solve variable word length jotto

This commit is contained in:
Joscha 2018-09-21 07:46:59 +00:00
parent 31d83323c8
commit 56c4fce80a
2 changed files with 30 additions and 23 deletions

View file

@ -8,6 +8,7 @@ import System.Exit
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
import qualified Data.Set as S
import qualified Data.Text as T
import qualified System.Console.Haskeline as H
@ -99,11 +100,15 @@ cmdWhat = do
g <- lift get
let showWords = intercalate ", "
case possible g of
[ws] -> do
let guesswords = map (\(Guess w _) -> w) $ filter (\(Guess w n) -> n == length w) $ guesses g
possibleWords = ws \\ guesswords
[] -> H.outputStrLn "No words are possible."
[wordlist] -> do
case wordlist of
[] -> H.outputStrLn "No words are possible."
ws@(w:_) -> do
let guesswords = filter (\a -> S.fromList a == S.fromList w) $ map (\(Guess x _) -> x) $ guesses g
possiblewords = ws \\ guesswords
H.outputStrLn "The word is one of the following words:"
H.outputStrLn $ " " ++ showWords possibleWords
H.outputStrLn $ " " ++ showWords possiblewords
H.outputStrLn "These words were already guessed:"
H.outputStrLn $ " " ++ showWords guesswords
_ -> do
@ -140,11 +145,11 @@ loop = do
runLoop :: GuessState -> IO GuessState
runLoop = execStateT (H.runInputT H.defaultSettings loop)
loadAndRun :: Int -> [FilePath] -> IO ()
loadAndRun n files = do
loadAndRun :: Int -> Int -> [FilePath] -> IO ()
loadAndRun a b files = do
wordlists <- mapM readFile files
let wordlist = concatMap lines wordlists
cmap = buildClassMap (Just n) wordlist
cmap = buildClassMap a b wordlist
g = guessState cmap
let wordCount = numberjust $ show $ length wordlist
@ -183,8 +188,8 @@ wrongArgs :: IO ()
wrongArgs = do
name <- getProgName
putStrLn " USAGE:"
putStrLn $ name ++ " <word length> <dictionary files>"
die "Error: No word length or dictionary given."
putStrLn $ name ++ " <min word length> [<max word length>] <dictionary files>"
die "Error: Incorrect arguments"
main :: IO ()
main = do
@ -192,6 +197,8 @@ main = do
case args of
[] -> wrongArgs
[_] -> wrongArgs
(n:files) -> case readMaybe n of
Nothing -> wrongArgs
Just number -> loadAndRun number files
(a:b:files) ->
case (readMaybe a, readMaybe b) of
(Just na, Just nb) -> loadAndRun (min na nb) (max na nb) files
(Just na, Nothing) -> loadAndRun na na (b:files)
_ -> wrongArgs

View file

@ -40,23 +40,23 @@ alphabet = S.fromList ['a'..'z']
{- Loading words -}
toClass :: Maybe Int -> String -> Maybe Class
toClass Nothing word = Just $ S.fromList word
toClass (Just n) word =
toClass :: Int -> Int -> String -> Maybe Class
--toClass Nothing word = Just $ S.fromList word
toClass a b word =
let set = S.intersection (S.fromList word) alphabet
in if length word == n && S.size set == n
in if length word == S.size set && length word >= a && length word <= b
then Just set
else Nothing
preprocessWords :: [String] -> [String]
preprocessWords = map head . group . sort . map (map toLower)
buildClassMap :: Maybe Int -> [String] -> ClassMap
buildClassMap n = foldr addWord M.empty . preprocessWords
buildClassMap :: Int -> Int -> [String] -> ClassMap
buildClassMap a b = foldr addWord M.empty . preprocessWords
where
addWord :: String -> ClassMap -> ClassMap
addWord word cmap =
case toClass n word of
case toClass a b word of
Nothing -> cmap
Just set -> M.alter (appendWord word) set cmap
appendWord :: String -> Maybe [String] -> Maybe [String]