tA/aoc2020
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cleaned up a little

Browse Source
This commit is contained in:
Thorn Avery 2020-12-08 15:55:06 +13:00
parent 30c272f283
commit 170d7b09b8
1 changed files with 40 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
day7.hs
View File

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