o.winkels
/
aoc2022
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

day11 part 2

This commit is contained in:
Oskar Winkels 2022-12-12 02:38:21 +01:00
parent 03914c88af
commit 3ae9fd5a4d
Signed by: o.winkels
GPG Key ID: E7484A06E99DAEF1
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
day11/main.hs
View File

@ -32,16 +32,17 @@ parseOFunc ["+",num] = (\x -> x + n) where n = read num :: Integer
parseOFunc ["*","old"] = (\x -> x * x) parseOFunc ["*","old"] = (\x -> x * x)
parseOFunc ["*",num] = (\x -> x * n) where n = read num :: Integer parseOFunc ["*",num] = (\x -> x * n) where n = read num :: Integer
parseTFunc :: String -> (Integer -> Bool) parseTFunc :: Integer -> (Integer -> Bool)
parseTFunc divi = (\x -> (x `mod` d) == 0) where d = read divi :: Integer parseTFunc d = (\x -> (x `mod` d) == 0)
parseMonkey :: [String] -> Monkey parseMonkey :: [String] -> (Monkey,Integer)
parseMonkey xs = Monkey n i o t d 0 parseMonkey xs = (Monkey n i o t d 0,t')
where where
n = read [head $ drop 7 (xs !! 0)] :: Int n = read [head $ drop 7 (xs !! 0)] :: Int
i = map (\x -> read x :: Integer) $ splitOn ", " $ drop 18 (xs !! 1) i = map (\x -> read x :: Integer) $ splitOn ", " $ drop 18 (xs !! 1)
o = parseOFunc $ splitOn " " $ drop 23 (xs !! 2) o = parseOFunc $ splitOn " " $ drop 23 (xs !! 2)
t = parseTFunc $ last $ splitOn " " (xs !! 3) t'= read (last $ splitOn " " (xs !! 3)) :: Integer
t = parseTFunc t'
d'= map (\x -> read (last $ splitOn " " x) :: Int) $ drop 4 xs d'= map (\x -> read (last $ splitOn " " x) :: Int) $ drop 4 xs
d = (\x -> if x then head d' else last d') d = (\x -> if x then head d' else last d')
@ -62,18 +63,18 @@ throw (Monkey from _ _ _ de _) throws = map throwMod -- trace ("THROWS: " ++ sho
| n == deF = Monkey n (i ++ toF) o t d c | n == deF = Monkey n (i ++ toF) o t d c
| otherwise = m | otherwise = m
applyTurn :: Integer -> Monkey -> [Monkey] -> [Monkey] applyTurn :: Integer -> Integer -> Monkey -> [Monkey] -> [Monkey]
applyTurn wrd m@(Monkey n i o t d _) ms = nms -- trace ("NEW: " ++ show nms) applyTurn lcmd wrd m@(Monkey n i o t d _) ms = nms -- trace ("NEW: " ++ show nms)
where where
postInsp = map o i -- trace ("TURN: " ++ show m) postInsp = map ((`mod` lcmd) . o) i -- trace ("TURN: " ++ show m)
postBore = map (`div` wrd) postInsp postBore = map (`div` wrd) postInsp
postTest = map t postBore postTest = map t postBore
throwTo = map d postTest throwTo = map d postTest
nms = throw m (zip postBore throwTo) ms nms = throw m (zip postBore throwTo) ms
applyTurns :: Integer -> [Monkey] -> [Monkey] -> [Monkey] applyTurns :: Integer -> Integer -> [Monkey] -> [Monkey] -> [Monkey]
applyTurns _ [] ms = ms applyTurns _ _ [] ms = ms
applyTurns wrd (t:ts) ms = applyTurns wrd ts (applyTurn wrd (ms !! (name t)) ms) applyTurns l wrd (t:ts) ms = applyTurns l wrd ts (applyTurn l wrd (ms !! (name t)) ms)
@ -83,10 +84,11 @@ handler :: String -> String
handler s = (show p1) ++ "\n" ++ handler s = (show p1) ++ "\n" ++
(show p2) ++ "\n" (show p2) ++ "\n"
where where
monkeys = map parseMonkey $ splitOn [""] $ lines s (monkeys,divisors) = unzip $ map parseMonkey $ splitOn [""] $ lines s
lcmd = foldl1 lcm divisors
turns = (\nt -> take (nt * length monkeys) $ concat $ repeat monkeys) turns = (\nt -> take (nt * length monkeys) $ concat $ repeat monkeys)
final1 = applyTurns 3 (turns 20) monkeys final1 = applyTurns lcmd 3 (turns 20) monkeys
final2 = applyTurns 1 (turns 10000) monkeys final2 = applyTurns lcmd 1 (turns 10000) monkeys
topprod = product . map counter . take 2 . reverse . sort topprod = product . map counter . take 2 . reverse . sort
[p1,p2] = map topprod [final1,final2] [p1,p2] = map topprod [final1,final2]