diff --git a/day7.hs b/day7.hs index af38a4a..1eff021 100644 --- a/day7.hs +++ b/day7.hs @@ -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) -loeb :: Functor f => f (f a -> a) -> f a -loeb x = go where go = fmap ($ go) x +solveA :: [Bag] -> Int +solveA bs = pred + $ length + $ filter (== True) + $ map snd + $ loeb + $ map loebifyA bs -loebifyA :: Bag -> ([(Label, Bool)] -> (Label, Bool)) +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 + +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'))