[hs] Solve 2020_22 part 2

This commit is contained in:
Joscha 2020-12-22 11:48:26 +00:00
parent 91adf899f3
commit d4c395b713

View file

@ -1,3 +1,4 @@
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Aoc.Y2020.D22 module Aoc.Y2020.D22
@ -8,11 +9,14 @@ import Control.Monad
import Data.Foldable import Data.Foldable
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Aoc.Day import Aoc.Day
import Aoc.Parse import Aoc.Parse
parser :: Parser (Seq.Seq Int, Seq.Seq Int) type Hand = Seq.Seq Int
parser :: Parser (Hand, Hand)
parser = do parser = do
void $ string "Player 1:\n" void $ string "Player 1:\n"
p1 <- many (decimal <* newline) p1 <- many (decimal <* newline)
@ -20,23 +24,41 @@ parser = do
p2 <- many (decimal <* newline) p2 <- many (decimal <* newline)
pure (Seq.fromList p1, Seq.fromList p2) pure (Seq.fromList p1, Seq.fromList p2)
step :: (Seq.Seq Int, Seq.Seq Int) -> Either (Seq.Seq Int) (Seq.Seq Int, Seq.Seq Int) combat :: (Hand, Hand) -> Hand
step (Seq.Empty, crab) = Left crab combat (Seq.Empty, crab) = crab
step (self, Seq.Empty) = Left self combat (self, Seq.Empty) = self
step (s Seq.:<| self, c Seq.:<| crab) combat (s Seq.:<| self, c Seq.:<| crab)
| s >= c = Right (self Seq.|> s Seq.|> c, crab) | s >= c = combat (self Seq.|> s Seq.|> c, crab)
| otherwise = Right (self, crab Seq.|> c Seq.|> s) | otherwise = combat (self, crab Seq.|> c Seq.|> s)
untilLeft :: (a -> Either b a) -> a -> b recursiveCombat :: Set.Set (Hand, Hand) -> (Hand, Hand) -> Either Hand Hand
untilLeft f a = case f a of recursiveCombat _ (Seq.Empty, crab) = Right crab
Left b -> b recursiveCombat _ (self, Seq.Empty) = Left self
Right a2 -> untilLeft f a2 recursiveCombat previously now@(s Seq.:<| self, c Seq.:<| crab)
| now `Set.member` previously = Left self
| otherwise = recursiveCombat (Set.insert now previously) $ case winner of
Left _ -> (self Seq.|> s Seq.|> c, crab)
Right _ -> (self, crab Seq.|> c Seq.|> s)
where
sLen = Seq.length self
cLen = Seq.length crab
winner = if
| s <= sLen && c <= cLen -> recursiveCombat Set.empty (Seq.take s self, Seq.take c crab)
| s >= c -> Left self
| otherwise -> Right crab
solver :: (Seq.Seq Int, Seq.Seq Int) -> IO ()
score :: Hand -> Int
score = sum . zipWith (*) [1..] . toList . Seq.reverse
solver :: (Hand, Hand) -> IO ()
solver (self, crab) = do solver (self, crab) = do
putStrLn ">> Part 1" putStrLn ">> Part 1"
let winner = untilLeft step (self, crab) print $ score $ combat (self, crab)
print $ sum $ zipWith (*) [1..] $ toList $ Seq.reverse winner
putStrLn ""
putStrLn ">> Part 2"
print $ score $ either id id $ recursiveCombat Set.empty (self, crab)
day :: Day day :: Day
day = dayParse parser solver day = dayParse parser solver