Gattix/AoC
3
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

Day 11 Part 2

This commit is contained in:
Gattix 2022-12-11 18:57:14 +01:00
parent 707b99ac63
commit 930c6e0745
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
2022/day11/day11.hs
View File

@ -9,7 +9,7 @@ data Monkey =
{ mID :: Int { mID :: Int
, _items :: [Int] , _items :: [Int]
, operation :: Int -> Int , operation :: Int -> Int
, test :: Int -> Bool , test :: Int
, nextMonkey :: (Int, Int) , nextMonkey :: (Int, Int)
, _inspectCounter :: Int , _inspectCounter :: Int
} }
@ -35,7 +35,12 @@ main :: IO ()
main = do main = do
input <- map (map (splitOn ":") . lines) . splitOn "\n\n" <$> readFile "input" input <- map (map (splitOn ":") . lines) . splitOn "\n\n" <$> readFile "input"
let monkes = mapMaybe parseMonkey input let monkes = mapMaybe parseMonkey input
print $ product $ take 2 $ reverse $ sort $ map _inspectCounter $ last $ take 21 $ iterate turns monkes print $ day11 20 (`div` 3) monkes
print $ day11 10000 id monkes
day11 :: Int -> (Int -> Int) -> [Monkey] -> Int
day11 x f m = g $ take (succ x) $ iterate (turns f) m
where g = product . take 2 . reverse . sort . map _inspectCounter . last
parseMonkey :: [[String]] -> Maybe Monkey parseMonkey :: [[String]] -> Maybe Monkey
parseMonkey [[a, _], [_, b], [_, c], [_, d], [_, e], [_, f]] = parseMonkey [[a, _], [_, b], [_, c], [_, d], [_, e], [_, f]] =
@ -44,29 +49,29 @@ parseMonkey [[a, _], [_, b], [_, c], [_, d], [_, e], [_, f]] =
(f' a) (f' a)
(read ('[' : b ++ "]")) (read ('[' : b ++ "]"))
(parseOP $ words c) (parseOP $ words c)
(mtest $ read $ last $ words d) (f' d)
(f' e, f' f) (f' e, f' f)
0 0
where where
f' = read . last . words f' = read . last . words
mtest x y = y `mod` x == 0
parseOP [_, _, _, x, y] parseOP [_, _, _, x, y]
| y == "old" = (^ 2) | y == "old" = (^ (2::Int))
| x == "*" = (*) (read y) | x == "*" = (*) (read y)
| otherwise = (+) (read y) | otherwise = (+) (read y)
parseMonkey _ = Nothing parseMonkey _ = Nothing
turns :: [Monkey] -> [Monkey] turns :: (Int -> Int) -> [Monkey] -> [Monkey]
turns = turns' 0 turns f = turns' 0
where turns' n ms where turns' n ms
| length ms == n = ms | length ms == n = ms
| otherwise = turns' (succ n) monkeNew | otherwise = turns' (succ n) monkeNew
where itemsNew = [ flip div 3 $ operation (ms !! n) x | x<-_items (ms !! n)] where itemsNew = [ f $ flip mod modNum $ operation (ms !! n) x | x<-_items (ms !! n)]
monkeEmptied = ms & ix n .~ ((ms !! n) & items .~ [] & inspectCounter +~ length itemsNew) monkeEmptied = ms & ix n .~ ((ms !! n) & items .~ [] & inspectCounter +~ length itemsNew)
monkeNew = monkeThrow itemsNew n monkeEmptied monkeNew = monkeThrow itemsNew n monkeEmptied
modNum = foldl1 lcm $ map test ms
monkeThrow :: [Int] -> Int -> [Monkey] -> [Monkey] monkeThrow :: [Int] -> Int -> [Monkey] -> [Monkey]
monkeThrow (x:xs) n ms = monkeThrow xs n (ms & ix next .~ ((ms !! next) & items .~ (_items (ms !! next) ++ [x]) )) monkeThrow (x:xs) n ms = monkeThrow xs n (ms & ix next .~ ((ms !! next) & items .~ (_items (ms !! next) ++ [x]) ))
where next = if test (ms !! n) x then fst targets else snd targets where next = if mod x (test (ms !! n)) == 0 then fst targets else snd targets
targets = nextMonkey (ms !! n) targets = nextMonkey (ms !! n)
monkeThrow _ _ ms = ms monkeThrow _ _ ms = ms