blob: 9a602f86720e7683dd5f65649a9f7defddcb24a2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
import Control.Monad.ST
import Data.Foldable (foldrM)
import Data.HashTable.ST.Basic as H
import Data.List (nub)
import Data.Maybe (mapMaybe)
import Debug.Trace
type S s = H.HashTable s String [String]
-- Return Nothing if no match; unmatched remainder (can be []) if
-- match.
match :: String -> String -> Maybe String
match xs [] = Just xs
match (x:xs) (y:ys) | x == y = match xs ys
| otherwise = Nothing
match [] _ = Nothing
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 H.insert s xs r >> return r
Just x -> return x
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 s yss) zss
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM p = foldrM f False
where
f a b = (b ||) <$> p a
parseTowels :: String -> [String]
parseTowels = map init . words
parse :: String -> ([String],[String])
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 $ runST $ run yss xss
|
