cleaned up a little
This commit is contained in:
parent
30c272f283
commit
170d7b09b8
58
day7.hs
58
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'))
|
||||
|
Loading…
Reference in New Issue
Block a user