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

day11: hindent

This commit is contained in:
Gattix 2022-12-11 18:57:35 +01:00
parent 930c6e0745
commit 2721636c9e
1 changed files with 29 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
2022/day11/day11.hs
View File

@ -1,8 +1,9 @@
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Data.List
import Data.List.Split
import Data.Maybe
import Data.List
data Monkey =
Monkey
@ -13,6 +14,7 @@ data Monkey =
, nextMonkey :: (Int, Int)
, _inspectCounter :: Int
}
makeLenses ''Monkey
instance Show Monkey where
@ -40,7 +42,8 @@ main = do
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
where
g = product . take 2 . reverse . sort . map _inspectCounter . last
parseMonkey :: [[String]] -> Maybe Monkey
parseMonkey [[a, _], [_, b], [_, c], [_, d], [_, e], [_, f]] =
@ -55,23 +58,36 @@ parseMonkey [[a, _], [_, b], [_, c], [_, d], [_, e], [_, f]] =
where
f' = read . last . words
parseOP [_, _, _, x, y]
| y == "old" = (^ (2::Int))
| y == "old" = (^ (2 :: Int))
| x == "*" = (*) (read y)
| otherwise = (+) (read y)
parseMonkey _ = Nothing
turns :: (Int -> Int) -> [Monkey] -> [Monkey]
turns f = turns' 0
where turns' n ms
| length ms == n = ms
| otherwise = turns' (succ n) monkeNew
where itemsNew = [ f $ flip mod modNum $ operation (ms !! n) x | x<-_items (ms !! n)]
monkeEmptied = ms & ix n .~ ((ms !! n) & items .~ [] & inspectCounter +~ length itemsNew)
monkeNew = monkeThrow itemsNew n monkeEmptied
modNum = foldl1 lcm $ map test ms
where
turns' n ms
| length ms == n = ms
| otherwise = turns' (succ n) monkeNew
where
itemsNew =
[f $ flip mod modNum $ operation (ms !! n) x | x <- _items (ms !! n)]
monkeEmptied =
ms &
ix n .~ ((ms !! n) & items .~ [] & inspectCounter +~ length itemsNew)
monkeNew = monkeThrow itemsNew n monkeEmptied
modNum = foldl1 lcm $ map test ms
monkeThrow :: [Int] -> Int -> [Monkey] -> [Monkey]
monkeThrow (x:xs) n ms = monkeThrow xs n (ms & ix next .~ ((ms !! next) & items .~ (_items (ms !! next) ++ [x]) ))
where next = if mod x (test (ms !! n)) == 0 then fst targets else snd targets
targets = nextMonkey (ms !! n)
monkeThrow (x:xs) n ms =
monkeThrow
xs
n
(ms & ix next .~ ((ms !! next) & items .~ (_items (ms !! next) ++ [x])))
where
next =
if mod x (test (ms !! n)) == 0
then fst targets
else snd targets
targets = nextMonkey (ms !! n)
monkeThrow _ _ ms = ms