So I finally found some time to work on this last night. This is a nice problem and my solution is actually the same as yours:
1. Read the words into a list
2. Parse the patterns into a list of pattern, where each pattern is a list of tokens,
and a token can either be empty, a character, or a "choice" between several characters
3. To match a word against a pattern, make sure their lengths match,
then for each letter in the word, see if it matches the corresponding token in that word.
4. To match a letter against a token, if the token is empty there's no match, if it's a character, then just compare them,
and if it's a choice then see if the character is one of the options for that choice.
5. For each pattern in the list of patterns, match each word in the list of words against it and count the number of matches.
Of course, I resorted to Haskell. I don't think my code is clean or even efficient, but I'm working on getting my skill level up to writing "idiomatic" Haskell.
import System.IO
import Control.Monad
data Token = Empty
| Char Char
| Choice String
deriving (Show)
type Pattern = [Token]
main :: IO ()
main = do
input <- openFile "A-large-practice.in" ReadMode
line <- hGetLine input
let (l, d, n) = inputConstraints line
ws <- replicateM d (hGetLine input)
pStrs <- replicateM n (hGetLine input)
let ps = patterns pStrs
solutions = zip [1..] $ solve ps ws
forM_ solutions $ \(index, count) ->
putStrLn $ "Case #" ++ show index ++ ": " ++ show count
hClose input
return ()
solve :: [Pattern] -> [String] -> [Int]
solve ps ws = map countMatches ps where
countMatches p = length $ filter (`matches` p) ws
matches :: String -> Pattern -> Bool
matches word pattern
| length word /= length pattern = False
| otherwise = foldr match True $ zip word pattern
where
match (c, token) value
| not value = False
| otherwise = case token of
Empty -> False
Char x -> c == x
Choice cs -> c `elem` cs
patterns :: [String] -> [Pattern]
patterns = foldr parsePattern [] where
parsePattern s zs = case pattern s of
Just p -> p:zs
Nothing -> zs
pattern :: String -> Maybe Pattern
pattern s = case parseToken s of
(Just Empty, _) -> Just []
(Just t, rest) -> case pattern rest of
Just ts -> Just (t:ts)
_ -> Nothing
_ -> Nothing
parseToken :: String -> (Maybe Token, String)
parseToken "" = (Just Empty, "")
parseToken s@(c:cs)
| c == '(' = parseChoice s
| otherwise = (Just $ Char c, cs)
parseChoice :: String -> (Maybe Token, String)
parseChoice ('(':cs) = tryChoice cs (Just $ Choice []) False where
tryChoice [] value isClosed
| isClosed = (value, [])
| otherwise = (Nothing, [])
tryChoice s@(x:xs) value _
| x == '(' = (Nothing, s)
| x == ')' = (value, xs)
| otherwise = case value of
Just (Choice ps) -> let newValue = (Just $ Choice (ps ++ [x]))
in tryChoice xs newValue False
_ -> (Nothing, s)
parseChoice s = (Nothing, s)
inputConstraints :: String -> (Int, Int, Int)
inputConstraints line = let xs = (map read $ words line) :: [Int]
in (head xs, xs !! 1, xs !! 2)
I'll try to improve my solution over time so I put it on my github at:
https://github.com/saeidw/alien-lang
