|
|
@@ -11,38 +11,55 @@ main :: IO () |
|
|
|
main = do |
|
|
|
raw <- readFile "day7.txt" |
|
|
|
let bags = validate $ map (parse lineP []) $ lines raw |
|
|
|
ansA = pred $ length $ filter (\x -> (snd x) == True) |
|
|
|
$ loeb $ map loebifyA bags |
|
|
|
ansB = pred $ unMaybe $ lookup "shiny gold" |
|
|
|
$ loeb $ map loebifyB bags |
|
|
|
ansA = solveA bags |
|
|
|
ansB = solveB bags |
|
|
|
in do |
|
|
|
putStrLn $ "day7a: " ++ (show ansA) |
|
|
|
putStrLn $ "day7b: " ++ (show ansB) |
|
|
|
|
|
|
|
solveA :: [Bag] -> Int |
|
|
|
solveA bs = pred |
|
|
|
$ length |
|
|
|
$ filter (== True) |
|
|
|
$ map snd |
|
|
|
$ loeb |
|
|
|
$ map loebifyA bs |
|
|
|
|
|
|
|
solveB :: [Bag] -> Int |
|
|
|
solveB bs = pred |
|
|
|
$ unsafeLookup "shiny gold" |
|
|
|
$ loeb |
|
|
|
$ map loebifyB bs |
|
|
|
|
|
|
|
loeb :: Functor f => f (f a -> a) -> f a |
|
|
|
loeb x = go where go = fmap ($ go) x |
|
|
|
loeb x = go |
|
|
|
where |
|
|
|
go = fmap ($ go) x |
|
|
|
|
|
|
|
loebifyA :: Bag -> ([(Label, Bool)] -> (Label, Bool)) |
|
|
|
loebifyA :: Bag -> [(Label, Bool)] -> (Label, Bool) |
|
|
|
loebifyA (Bag "shiny gold" _) = const ("shiny gold", True) |
|
|
|
loebifyA (Bag l bs) = |
|
|
|
(\ls -> (l, or (unMaybes (map (\f -> f ls) (map lookupify bs))))) |
|
|
|
(\ls -> (l, or [f ls | f <- innerbags])) |
|
|
|
where |
|
|
|
lookupify (_,s) = lookup s |
|
|
|
lookupify = unsafeLookup . snd |
|
|
|
innerbags = map lookupify bs |
|
|
|
|
|
|
|
loebifyB :: Bag -> ([(Label, Int)] -> (Label, Int)) |
|
|
|
loebifyB (Bag l []) = const (l, 1) |
|
|
|
loebifyB (Bag l bs) = |
|
|
|
(\ls -> (l, sum (1:(map (\f -> f ls) (map lookupify bs))))) |
|
|
|
(\ls -> (l, sum $ 1 : [q*(f ls) | (f,q) <- innerbags])) |
|
|
|
where |
|
|
|
lookupify (q,s) = (\ms -> q * (unMaybe $ lookup s ms)) |
|
|
|
lookupify = unsafeLookup . snd |
|
|
|
innerbags = zip (map lookupify bs) |
|
|
|
(map fst bs) |
|
|
|
|
|
|
|
unsafeLookup :: Eq a => a -> [(a,b)] -> b |
|
|
|
unsafeLookup k = unMaybe . (lookup k) |
|
|
|
|
|
|
|
unMaybe :: Maybe a -> a |
|
|
|
unMaybe Nothing = error "invalid bag label" |
|
|
|
unMaybe (Just v) = v |
|
|
|
|
|
|
|
unMaybes :: [Maybe a] -> [a] |
|
|
|
unMaybes = map unMaybe |
|
|
|
|
|
|
|
validate :: [Either ParseError Bag] -> [Bag] |
|
|
|
validate [] = [] |
|
|
|
validate ((Left _):_) = error "invalid input" |
|
|
@@ -57,12 +74,15 @@ lineP = do |
|
|
|
|
|
|
|
baglistP :: Parsec String () [(Quantity, Label)] |
|
|
|
baglistP = do |
|
|
|
((string "no other bags.") >> return []) <|> |
|
|
|
(endBy qlabelP $ oneOf [',', '.'] >> whitespaces) |
|
|
|
((string "no other bags.") >> return []) |
|
|
|
<|> (endBy qlabelP |
|
|
|
$ oneOf [',', '.'] >> whitespaces) |
|
|
|
|
|
|
|
initlabelP :: Parsec String () String |
|
|
|
initlabelP = manyTill anyChar |
|
|
|
(try $ whitespaces >> (string "bags contain") >> whitespaces) |
|
|
|
(try $ whitespaces |
|
|
|
>> (string "bags contain") |
|
|
|
>> whitespaces) |
|
|
|
|
|
|
|
whitespaces :: Parsec String () String |
|
|
|
whitespaces = many $ char ' ' |
|
|
@@ -76,4 +96,6 @@ qlabelP = do |
|
|
|
|
|
|
|
labelP :: Parsec String () String |
|
|
|
labelP = manyTill anyChar |
|
|
|
(try $ whitespaces >> (string "bag") >> optional (char 's')) |
|
|
|
(try $ whitespaces |
|
|
|
>> (string "bag") |
|
|
|
>> optional (char 's')) |