diff options
| -rw-r--r-- | 19-1.hs | 31 |
1 files changed, 18 insertions, 13 deletions
@@ -1,12 +1,12 @@ -import Control.Monad.Trans.State +import Control.Monad.ST import Data.Foldable (foldrM) -import Data.HashMap.Lazy as HM hiding (filter, mapMaybe, map, null) +import Data.HashTable.ST.Basic as H import Data.List (nub) import Data.Maybe (mapMaybe) import Debug.Trace -type S = HashMap String [String] +type S s = H.HashTable s String [String] -- Return Nothing if no match; unmatched remainder (can be []) if -- match. @@ -16,20 +16,20 @@ match (x:xs) (y:ys) | x == y = match xs ys | otherwise = Nothing match [] _ = Nothing -matchAny :: [String] -> String -> State S [String] -matchAny yss xs = do - s <- get - case HM.lookup xs s of +matchAny :: S s -> [String] -> String -> ST s [String] +matchAny s yss xs = do + t <- H.lookup s xs + case t of Nothing -> let r = mapMaybe (match xs) yss - in put (HM.insert xs r s) >> return r + in H.insert s xs r >> return r Just x -> return x -check :: [String] -> String -> State S Bool -check yss xs = do - zss <- nub <$> matchAny yss xs +check :: S s -> [String] -> String -> ST s Bool +check s yss xs = do + zss <- nub <$> matchAny s yss xs if [] `elem` zss then return True - else anyM (check yss) zss + else anyM (check s yss) zss anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool anyM p = foldrM f False @@ -44,8 +44,13 @@ parse s = let yss = filter (not . null) . drop 2 $ lines s xss = parseTowels . head $ lines s in (xss, yss) +run :: [String] -> [String] -> ST s Int +run xss yss = do + ht <- H.new :: ST s (S s) + length . filter id <$> traverse (check ht yss) xss + main :: IO () main = do input <- getContents let (xss, yss) = parse input - print . length . filter id $ evalState (mapM (check xss) yss) HM.empty + print $ runST $ run yss xss |