2022-12-11 15:14:49 +01:00
{- # LANGUAGE TemplateHaskell # -}
2022-12-11 18:57:35 +01:00
2022-12-11 15:14:49 +01:00
import Control.Lens
2022-12-11 18:57:35 +01:00
import Data.List
2022-12-11 15:14:49 +01:00
import Data.List.Split
import Data.Maybe
data Monkey =
Monkey
{ mID :: Int
, _items :: [ Int ]
, operation :: Int -> Int
2022-12-11 18:57:14 +01:00
, test :: Int
2022-12-11 15:14:49 +01:00
, nextMonkey :: ( Int , Int )
, _inspectCounter :: Int
}
2022-12-11 18:57:35 +01:00
2022-12-11 15:14:49 +01:00
makeLenses ''Monkey
instance Show Monkey where
show ( Monkey a b c d ( e , f ) g ) =
" Monkey " ++
show a ++
" : \ n Items: " ++
show b ++
" \ n Operation: e.g. 1 -> " ++
show ( c 1 ) ++
" , 2 -> " ++
show ( c 2 ) ++
2022-12-11 19:03:28 +01:00
" \ n Test: divisible by " ++
show d ++
2022-12-11 15:14:49 +01:00
" \ n If true: throw to monkey " ++
show e ++
2022-12-11 19:03:28 +01:00
" \ n If false: throw to monkey " ++
2022-12-11 15:14:49 +01:00
show f ++ " \ n This monkey has inspected " ++ show g ++ " items. \ n "
main :: IO ()
main = do
input <- map ( map ( splitOn " : " ) . lines ) . splitOn " \ n \ n " <$> readFile " input "
let monkes = mapMaybe parseMonkey input
2022-12-11 18:57:14 +01:00
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
2022-12-11 18:57:35 +01:00
where
g = product . take 2 . reverse . sort . map _inspectCounter . last
2022-12-11 15:14:49 +01:00
parseMonkey :: [ [ String ] ] -> Maybe Monkey
parseMonkey [ [ a , _ ] , [ _ , b ] , [ _ , c ] , [ _ , d ] , [ _ , e ] , [ _ , f ] ] =
Just $
Monkey
( f' a )
( read ( '[' : b ++ " ] " ) )
( parseOP $ words c )
2022-12-11 18:57:14 +01:00
( f' d )
2022-12-11 15:14:49 +01:00
( f' e , f' f )
0
where
f' = read . last . words
parseOP [ _ , _ , _ , x , y ]
2022-12-11 18:57:35 +01:00
| y == " old " = ( ^ ( 2 :: Int ) )
2022-12-11 15:14:49 +01:00
| x == " * " = ( * ) ( read y )
| otherwise = ( + ) ( read y )
parseMonkey _ = Nothing
2022-12-11 18:57:14 +01:00
turns :: ( Int -> Int ) -> [ Monkey ] -> [ Monkey ]
turns f = turns' 0
2022-12-11 18:57:35 +01:00
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
2022-12-11 15:14:49 +01:00
monkeThrow :: [ Int ] -> Int -> [ Monkey ] -> [ Monkey ]
2022-12-11 18:57:35 +01:00
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 )
2022-12-11 15:14:49 +01:00
monkeThrow _ _ ms = ms