From: Neil Smith Date: Fri, 29 Nov 2019 12:03:10 +0000 (+0000) Subject: Done day 24 part 2 X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=548c9bd095213b388debfb09ba9727b2174b21d4;p=advent-of-code-18.git Done day 24 part 2 --- diff --git a/advent-of-code.cabal b/advent-of-code.cabal index b9a7c03..61d8e63 100644 --- a/advent-of-code.cabal +++ b/advent-of-code.cabal @@ -291,9 +291,9 @@ executable advent24 , text , megaparsec -executable advent24iterate +executable advent24naive hs-source-dirs: src/advent24 - main-is: advent24iterate.hs + main-is: advent24naive.hs default-language: Haskell2010 build-depends: base >= 4.7 && < 5 , containers diff --git a/src/advent24/advent24.hs b/src/advent24/advent24.hs index 45a0c51..6231418 100644 --- a/src/advent24/advent24.hs +++ b/src/advent24/advent24.hs @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} --- Box division approach taken from fizbin: --- https://www.reddit.com/r/adventofcode/comments/a8s17l/2018_day_23_solutions/ecfmpy0/ - import Debug.Trace -- import Prelude hiding ((++)) @@ -20,7 +17,7 @@ import qualified Text.Megaparsec.Char.Lexer as L import qualified Control.Applicative as CA import Data.List hiding (group) -import Data.Function (on) +-- import Data.Function (on) import qualified Data.Map.Strict as M import Data.Map.Strict ((!)) @@ -51,9 +48,47 @@ main = do let armies = successfulParse text print armies print $ part1 (fst armies) (snd armies) + print $ part2 (fst armies) (snd armies) + + +part1 :: Army -> Army -> Int +part1 immuneArmy infectionArmy = uncurry remainingUnitCount endState + where endState = battle immuneArmy infectionArmy + + +part2 immuneArmy infectionArmy = (minimalBoost, part1 immuneArmy' infectionArmy) + where boostUpper = findSuccessfulBoost 1 immuneArmy infectionArmy + minimalBoost = boostSearch 0 boostUpper immuneArmy infectionArmy + immuneArmy' = applyBoost minimalBoost immuneArmy + + +findSuccessfulBoost boost immuneArmy infectionArmy = + if success + then boost + else findSuccessfulBoost (2 * boost) immuneArmy infectionArmy + where success = immuneSuccessWithBoost boost immuneArmy infectionArmy + +boostSearch lower upper _ _ | trace ("Searching in " ++ show (lower, upper)) False = undefined +boostSearch lower upper immuneArmy infectionArmy = + if lower == upper + then lower + else boostSearch lower' upper' immuneArmy infectionArmy + where boost = lower + (upper - lower) `div` 2 + success = immuneSuccessWithBoost boost immuneArmy infectionArmy + lower' = if success then lower else boost + 1 + upper' = if success then boost else upper +immuneSuccessWithBoost :: Int -> Army -> Army -> Bool +immuneSuccessWithBoost boost _ _ | trace ("Trial with boost " ++ show boost) False = undefined +immuneSuccessWithBoost boost immuneArmy infectionArmy = immuneWins $ battle immuneArmy' infectionArmy + where immuneArmy' = applyBoost boost immuneArmy + + + +effectivePower :: Group -> Int effectivePower group = (_units group) * (_damage group) +damageCaused :: Group -> Group -> Int damageCaused attacker defender = if attackType `elem` immunities then 0 else if attackType `elem` weaknesses then (2 * effectivePower attacker) @@ -62,12 +97,15 @@ damageCaused attacker defender = weaknesses = foldl' extractWeakness [] (_modifiers defender) immunities = foldl' extractImmunity [] (_modifiers defender) +extractWeakness :: [String] -> Modifier -> [String] extractWeakness currentWeaknesses (Weakness ws) = currentWeaknesses ++ ws extractWeakness currentWeaknesses (Immunity _ws) = currentWeaknesses +extractImmunity :: [String] -> Modifier -> [String] extractImmunity currentImmunity (Weakness _ms) = currentImmunity extractImmunity currentImmunity (Immunity ms) = currentImmunity ++ ms +applyDamage :: Group -> Int -> Group applyDamage group damage = group { _units = unitsRemaining } where unitsKilled = damage `div` (_hps group) unitsRemaining = maximum [0, (_units group) - unitsKilled] @@ -102,7 +140,6 @@ allocateAttacker attackers defenders (assignedTargets, availableTargets) attacke battleOrder :: Army -> Army -> [BattleOrder] battleOrder immuneArmy infectionArmy = mergeOrders immuneIds infectIds where armyIds army = reverse $ sort [(_initiative (army!k), k) | k <- M.keys army] - -- $ sortOn (\k -> (_initiative (army!k), k)) $ M.keys army immuneIds = armyIds immuneArmy infectIds = armyIds infectionArmy @@ -113,18 +150,21 @@ mergeOrders ((i1, k1):id1s) ((i2, k2):id2s) | i1 >= i2 = (Immune k1):(mergeOrders id1s ((i2, k2):id2s)) | otherwise = (Infection k2):(mergeOrders ((i1, k1):id1s) id2s) -battleRound :: Army -> Army -> (Army, Army) -battleRound immuneArmy infectionArmy | trace ("Round\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined +battleRound :: (Army, Army) -> (Army, Army) +-- battleRound (immuneArmy, infectionArmy) | trace ("Round\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined -- battleRound immuneArmy infectionArmy | trace (show (armyCount immuneArmy) ++ " " ++ show (armyCount infectionArmy)) False = undefined -battleRound immuneArmy infectionArmy = (pruneArmy immuneArmy', pruneArmy infectionArmy') +battleRound (immuneArmy, infectionArmy) = (pruneArmy immuneArmy'', pruneArmy infectionArmy') where immuneAllocations = allocateAttackers immuneArmy infectionArmy infectionAllocations = allocateAttackers infectionArmy immuneArmy actionOrder = battleOrder immuneArmy infectionArmy (immuneArmy', infectionArmy') = foldl' (\ (a1, a2) order -> handleOrder order immuneAllocations infectionAllocations a1 a2) (immuneArmy, infectionArmy) actionOrder + -- test for stalemate + immuneArmy'' = if (immuneArmy' == immuneArmy) && (infectionArmy' == infectionArmy) + then M.empty + else immuneArmy' --- armyCount army = sum [_units g | g <- M.elems army ] handleOrder :: BattleOrder -> [Allocation] -> [Allocation] -> Army -> Army -> (Army, Army) handleOrder (Immune k) allocations _ attackArmy defendArmy = (attackArmy, defendArmy') @@ -143,12 +183,9 @@ handleAttack attacker allocations attackArmy defendArmy = damage = damageCaused (attackArmy!attacker) defendGroup defendGroup' = applyDamage defendGroup damage -battle :: Army -> Army -> Int -battle immuneArmy infectionArmy = - if battleOver immuneArmy infectionArmy - then remainingUnitCount immuneArmy infectionArmy - else battle immuneArmy' infectionArmy' - where (immuneArmy', infectionArmy') = battleRound immuneArmy infectionArmy + +battle :: Army -> Army -> (Army, Army) +battle immuneArmy infectionArmy = head $ dropWhile (not . uncurry battleOver) $ iterate battleRound (immuneArmy, infectionArmy) pruneArmy :: Army -> Army @@ -161,10 +198,17 @@ battleOver immuneArmy infectionArmy = (M.null immuneArmy) || (M.null infectionAr remainingUnitCount :: Army -> Army -> Int -- remainingUnitCount immuneArmy infectionArmy | trace ("End with\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined remainingUnitCount immuneArmy infectionArmy = (unitCount immuneArmy) + (unitCount infectionArmy) - where unitCount army = sum $ [_units g | g <- M.elems army] + +unitCount :: Army -> Int +unitCount army = sum [_units g | g <- M.elems army] + + +immuneWins :: (Army, Army) -> Bool +immuneWins (immuneArmy, infectionArmy) = (unitCount immuneArmy > 0) && (unitCount infectionArmy == 0) -part1 = battle +applyBoost :: Int -> Army -> Army +applyBoost boost = M.map (\g -> g { _damage = (_damage g + boost)}) type Parser = Parsec Void Text diff --git a/src/advent24/advent24iterate.hs b/src/advent24/advent24iterate.hs deleted file mode 100644 index ddd2782..0000000 --- a/src/advent24/advent24iterate.hs +++ /dev/null @@ -1,238 +0,0 @@ -{-# LANGUAGE NegativeLiterals #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} - --- Box division approach taken from fizbin: --- https://www.reddit.com/r/adventofcode/comments/a8s17l/2018_day_23_solutions/ecfmpy0/ - -import Debug.Trace - --- import Prelude hiding ((++)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as TIO - -import Data.Void (Void) -import Text.Megaparsec hiding (State) -import Text.Megaparsec.Char -import qualified Text.Megaparsec.Char.Lexer as L -import qualified Control.Applicative as CA - -import Data.List hiding (group) -import Data.Function (on) -import qualified Data.Map.Strict as M -import Data.Map.Strict ((!)) - - -data Group = Group { _units :: Int - , _hps :: Int - , _modifiers :: [Modifier] - , _damage :: Int - , _damageType :: String - , _initiative :: Int - } deriving (Eq, Show) -instance Ord Group where - g1 `compare` g2 = if (effectivePower g1) == (effectivePower g2) - then (_initiative g1) `compare` (_initiative g2) - else (effectivePower g1) `compare` (effectivePower g2) - -data Modifier = Weakness [String] | Immunity [String] - deriving (Eq, Show) - -type Army = M.Map Int Group -type Allocation = (Int, Int) -data BattleOrder = Immune Int | Infection Int deriving (Eq, Show) - - -main :: IO () -main = do - text <- TIO.readFile "data/advent24.txt" - let armies = successfulParse text - print armies - print $ part1 (fst armies) (snd armies) - - -part1 = battle - -effectivePower :: Group -> Int -effectivePower group = (_units group) * (_damage group) - -damageCaused :: Group -> Group -> Int -damageCaused attacker defender = - if attackType `elem` immunities then 0 - else if attackType `elem` weaknesses then (2 * effectivePower attacker) - else effectivePower attacker - where attackType = _damageType attacker - weaknesses = foldl' extractWeakness [] (_modifiers defender) - immunities = foldl' extractImmunity [] (_modifiers defender) - -extractWeakness :: [String] -> Modifier -> [String] -extractWeakness currentWeaknesses (Weakness ws) = currentWeaknesses ++ ws -extractWeakness currentWeaknesses (Immunity _ws) = currentWeaknesses - -extractImmunity :: [String] -> Modifier -> [String] -extractImmunity currentImmunity (Weakness _ms) = currentImmunity -extractImmunity currentImmunity (Immunity ms) = currentImmunity ++ ms - -applyDamage :: Group -> Int -> Group -applyDamage group damage = group { _units = unitsRemaining } - where unitsKilled = damage `div` (_hps group) - unitsRemaining = maximum [0, (_units group) - unitsKilled] - - -keysByEffectivePower :: Army -> [Int] -keysByEffectivePower army = reverse $ sortOn (\k -> effectivePower (army!k)) (M.keys army) - -allocateAttackers :: Army -> Army -> [Allocation] -allocateAttackers attackers defenders = fst $ foldl' (allocateAttacker attackers defenders) ([], M.keys defenders) $ keysByEffectivePower attackers - -allocateAttacker :: Army -> Army -> ([Allocation], [Int]) -> Int -> ([Allocation], [Int]) --- allocateAttacker attackers defenders allocated@(assignedTargets, availableTargets) attackerKey | trace ("Allocate " ++ show attackerKey ++ "\n" ++ show allocated ++ "\n" ++ show [(t, sortTarget t) | t <- targets]) False = undefined --- where targets = reverse $ sortOn sortTarget availableTargets --- sortTarget t = ( damageCaused (attackers!attackerKey) (defenders!t) --- , effectivePower (defenders!t) --- , _initiative (defenders!t) --- ) -allocateAttacker attackers defenders (assignedTargets, availableTargets) attackerKey = - if null viableTargets - then (assignedTargets, availableTargets) - else (((attackerKey, target):assignedTargets), delete target availableTargets) - where attacker = attackers!attackerKey - viableTargets = filter (\t -> damageCaused attacker (defenders!t) > 0 ) availableTargets - target = head $ reverse $ sortOn sortTarget viableTargets - sortTarget t = ( damageCaused attacker (defenders!t) - , effectivePower (defenders!t) - , _initiative (defenders!t) - ) - - -battleOrder :: Army -> Army -> [BattleOrder] -battleOrder immuneArmy infectionArmy = mergeOrders immuneIds infectIds - where armyIds army = reverse $ sort [(_initiative (army!k), k) | k <- M.keys army] - -- $ sortOn (\k -> (_initiative (army!k), k)) $ M.keys army - immuneIds = armyIds immuneArmy - infectIds = armyIds infectionArmy - -mergeOrders :: [(Int, Int)] -> [(Int, Int)] -> [BattleOrder] -mergeOrders [] ids = [ Infection k | (_, k) <- ids ] -mergeOrders ids [] = [ Immune k | (_, k) <- ids ] -mergeOrders ((i1, k1):id1s) ((i2, k2):id2s) - | i1 >= i2 = (Immune k1):(mergeOrders id1s ((i2, k2):id2s)) - | otherwise = (Infection k2):(mergeOrders ((i1, k1):id1s) id2s) - -battleRound :: (Army, Army) -> (Army, Army) --- battleRound (immuneArmy, infectionArmy) | trace ("Round\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined --- battleRound immuneArmy infectionArmy | trace (show (armyCount immuneArmy) ++ " " ++ show (armyCount infectionArmy)) False = undefined -battleRound (immuneArmy, infectionArmy) = (pruneArmy immuneArmy', pruneArmy infectionArmy') - where immuneAllocations = allocateAttackers immuneArmy infectionArmy - infectionAllocations = allocateAttackers infectionArmy immuneArmy - actionOrder = battleOrder immuneArmy infectionArmy - (immuneArmy', infectionArmy') = foldl' (\ (a1, a2) order -> handleOrder order immuneAllocations infectionAllocations a1 a2) - (immuneArmy, infectionArmy) actionOrder - - --- armyCount army = sum [_units g | g <- M.elems army ] - -handleOrder :: BattleOrder -> [Allocation] -> [Allocation] -> Army -> Army -> (Army, Army) -handleOrder (Immune k) allocations _ attackArmy defendArmy = (attackArmy, defendArmy') - where defendArmy' = handleAttack k allocations attackArmy defendArmy -handleOrder (Infection k) _ allocations defendArmy attackArmy = (defendArmy', attackArmy) - where defendArmy' = handleAttack k allocations attackArmy defendArmy - -handleAttack :: Int -> [Allocation] -> Army -> Army -> Army -handleAttack attacker allocations attackArmy defendArmy = - if not $ null attackersAllocations - then M.insert defender defendGroup' defendArmy - else defendArmy - where attackersAllocations = filter (\a -> attacker == fst a ) allocations - defender = snd $ head attackersAllocations - defendGroup = (defendArmy!defender) - damage = damageCaused (attackArmy!attacker) defendGroup - defendGroup' = applyDamage defendGroup damage - -battle :: Army -> Army -> Int -battle immuneArmy infectionArmy = uncurry remainingUnitCount endState - where endState = head $ dropWhile (not . uncurry battleOver) $ iterate battleRound (immuneArmy, infectionArmy) - - -pruneArmy :: Army -> Army -pruneArmy = M.filter (\g -> _units g > 0) - -battleOver :: Army -> Army -> Bool -battleOver immuneArmy infectionArmy = (M.null immuneArmy) || (M.null infectionArmy) - - -remainingUnitCount :: Army -> Army -> Int --- remainingUnitCount immuneArmy infectionArmy | trace ("End with\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined -remainingUnitCount immuneArmy infectionArmy = (unitCount immuneArmy) + (unitCount infectionArmy) - where unitCount army = sum $ [_units g | g <- M.elems army] - - - -type Parser = Parsec Void Text - -sc :: Parser () -sc = L.space (skipSome spaceChar) CA.empty CA.empty - -lexeme = L.lexeme sc -integer = lexeme L.decimal --- signedInteger = L.signed sc integer -symb = L.symbol sc -comma = symb "," -semicolon = symb ";" -openBracket = symb "(" -closeBracket = symb ")" - -immuneHeaderP = symb "Immune System:" -infectionHeaderP = symb "Infection:" - -sizePaddingP = symb "units each with" -hpPaddingP = symb "hit points" -attackPaddingP = symb "with an attack that does" -initiativePaddingP = symb "damage at initiative" -weaknessPaddingP = symb "weak to" -immunityPaddingP = symb "immune to" - - -armiesP = (,) <$> immuneGroupsP <*> infectionGroupsP - -immuneGroupsP = immuneHeaderP *> many groupP -infectionGroupsP = infectionHeaderP *> many groupP - --- 72 units each with 5294 hit points (weak to slashing; immune to radiation, cold) with an attack that does 639 fire damage at initiative 1 - -groupP = engroup <$> (integer <* sizePaddingP ) - <*> (integer <* hpPaddingP) - <*> (attackModifierGroupP <* attackPaddingP ) - <*> integer - <*> (damageTypeP <* initiativePaddingP) - <*> integer - where engroup units hps aMods damage damageType initative = - Group { _units = units - , _hps = hps - , _modifiers = aMods - , _damage = damage - , _damageType = damageType - , _initiative = initative - } - - -attackModifierGroupP = option [] ((openBracket `between` closeBracket) attackModifiersP) - -attackModifiersP = attackModifierP `sepBy` semicolon -attackModifierP = weaknessP <|> immunityP -weaknessP = Weakness <$> (weaknessPaddingP *> damageTypesP) -immunityP = Immunity <$> (immunityPaddingP *> damageTypesP) - -damageTypeP = some letterChar <* sc -damageTypesP = damageTypeP `sepBy` comma - -successfulParse :: Text -> (Army, Army) --- successfulParse _ = [] -successfulParse input = - case parse armiesP "input" input of - Left _error -> (M.empty, M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err - Right armies -> idTag armies - where idTag (immune, infect) = (tagArmy immune, tagArmy infect) - tagArmy army = M.fromList $ zip [1..] army diff --git a/src/advent24/advent24naive.hs b/src/advent24/advent24naive.hs new file mode 100644 index 0000000..45a0c51 --- /dev/null +++ b/src/advent24/advent24naive.hs @@ -0,0 +1,235 @@ +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +-- Box division approach taken from fizbin: +-- https://www.reddit.com/r/adventofcode/comments/a8s17l/2018_day_23_solutions/ecfmpy0/ + +import Debug.Trace + +-- import Prelude hiding ((++)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +import Data.Void (Void) +import Text.Megaparsec hiding (State) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + +import Data.List hiding (group) +import Data.Function (on) +import qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) + + +data Group = Group { _units :: Int + , _hps :: Int + , _modifiers :: [Modifier] + , _damage :: Int + , _damageType :: String + , _initiative :: Int + } deriving (Eq, Show) +instance Ord Group where + g1 `compare` g2 = if (effectivePower g1) == (effectivePower g2) + then (_initiative g1) `compare` (_initiative g2) + else (effectivePower g1) `compare` (effectivePower g2) + +data Modifier = Weakness [String] | Immunity [String] + deriving (Eq, Show) + +type Army = M.Map Int Group +type Allocation = (Int, Int) +data BattleOrder = Immune Int | Infection Int deriving (Eq, Show) + + +main :: IO () +main = do + text <- TIO.readFile "data/advent24.txt" + let armies = successfulParse text + print armies + print $ part1 (fst armies) (snd armies) + +effectivePower group = (_units group) * (_damage group) + +damageCaused attacker defender = + if attackType `elem` immunities then 0 + else if attackType `elem` weaknesses then (2 * effectivePower attacker) + else effectivePower attacker + where attackType = _damageType attacker + weaknesses = foldl' extractWeakness [] (_modifiers defender) + immunities = foldl' extractImmunity [] (_modifiers defender) + +extractWeakness currentWeaknesses (Weakness ws) = currentWeaknesses ++ ws +extractWeakness currentWeaknesses (Immunity _ws) = currentWeaknesses + +extractImmunity currentImmunity (Weakness _ms) = currentImmunity +extractImmunity currentImmunity (Immunity ms) = currentImmunity ++ ms + +applyDamage group damage = group { _units = unitsRemaining } + where unitsKilled = damage `div` (_hps group) + unitsRemaining = maximum [0, (_units group) - unitsKilled] + + +keysByEffectivePower :: Army -> [Int] +keysByEffectivePower army = reverse $ sortOn (\k -> effectivePower (army!k)) (M.keys army) + +allocateAttackers :: Army -> Army -> [Allocation] +allocateAttackers attackers defenders = fst $ foldl' (allocateAttacker attackers defenders) ([], M.keys defenders) $ keysByEffectivePower attackers + +allocateAttacker :: Army -> Army -> ([Allocation], [Int]) -> Int -> ([Allocation], [Int]) +-- allocateAttacker attackers defenders allocated@(assignedTargets, availableTargets) attackerKey | trace ("Allocate " ++ show attackerKey ++ "\n" ++ show allocated ++ "\n" ++ show [(t, sortTarget t) | t <- targets]) False = undefined +-- where targets = reverse $ sortOn sortTarget availableTargets +-- sortTarget t = ( damageCaused (attackers!attackerKey) (defenders!t) +-- , effectivePower (defenders!t) +-- , _initiative (defenders!t) +-- ) +allocateAttacker attackers defenders (assignedTargets, availableTargets) attackerKey = + if null viableTargets + then (assignedTargets, availableTargets) + else (((attackerKey, target):assignedTargets), delete target availableTargets) + where attacker = attackers!attackerKey + viableTargets = filter (\t -> damageCaused attacker (defenders!t) > 0 ) availableTargets + target = head $ reverse $ sortOn sortTarget viableTargets + sortTarget t = ( damageCaused attacker (defenders!t) + , effectivePower (defenders!t) + , _initiative (defenders!t) + ) + + +battleOrder :: Army -> Army -> [BattleOrder] +battleOrder immuneArmy infectionArmy = mergeOrders immuneIds infectIds + where armyIds army = reverse $ sort [(_initiative (army!k), k) | k <- M.keys army] + -- $ sortOn (\k -> (_initiative (army!k), k)) $ M.keys army + immuneIds = armyIds immuneArmy + infectIds = armyIds infectionArmy + +mergeOrders :: [(Int, Int)] -> [(Int, Int)] -> [BattleOrder] +mergeOrders [] ids = [ Infection k | (_, k) <- ids ] +mergeOrders ids [] = [ Immune k | (_, k) <- ids ] +mergeOrders ((i1, k1):id1s) ((i2, k2):id2s) + | i1 >= i2 = (Immune k1):(mergeOrders id1s ((i2, k2):id2s)) + | otherwise = (Infection k2):(mergeOrders ((i1, k1):id1s) id2s) + +battleRound :: Army -> Army -> (Army, Army) +battleRound immuneArmy infectionArmy | trace ("Round\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined +-- battleRound immuneArmy infectionArmy | trace (show (armyCount immuneArmy) ++ " " ++ show (armyCount infectionArmy)) False = undefined +battleRound immuneArmy infectionArmy = (pruneArmy immuneArmy', pruneArmy infectionArmy') + where immuneAllocations = allocateAttackers immuneArmy infectionArmy + infectionAllocations = allocateAttackers infectionArmy immuneArmy + actionOrder = battleOrder immuneArmy infectionArmy + (immuneArmy', infectionArmy') = foldl' (\ (a1, a2) order -> handleOrder order immuneAllocations infectionAllocations a1 a2) + (immuneArmy, infectionArmy) actionOrder + + +-- armyCount army = sum [_units g | g <- M.elems army ] + +handleOrder :: BattleOrder -> [Allocation] -> [Allocation] -> Army -> Army -> (Army, Army) +handleOrder (Immune k) allocations _ attackArmy defendArmy = (attackArmy, defendArmy') + where defendArmy' = handleAttack k allocations attackArmy defendArmy +handleOrder (Infection k) _ allocations defendArmy attackArmy = (defendArmy', attackArmy) + where defendArmy' = handleAttack k allocations attackArmy defendArmy + +handleAttack :: Int -> [Allocation] -> Army -> Army -> Army +handleAttack attacker allocations attackArmy defendArmy = + if not $ null attackersAllocations + then M.insert defender defendGroup' defendArmy + else defendArmy + where attackersAllocations = filter (\a -> attacker == fst a ) allocations + defender = snd $ head attackersAllocations + defendGroup = (defendArmy!defender) + damage = damageCaused (attackArmy!attacker) defendGroup + defendGroup' = applyDamage defendGroup damage + +battle :: Army -> Army -> Int +battle immuneArmy infectionArmy = + if battleOver immuneArmy infectionArmy + then remainingUnitCount immuneArmy infectionArmy + else battle immuneArmy' infectionArmy' + where (immuneArmy', infectionArmy') = battleRound immuneArmy infectionArmy + + +pruneArmy :: Army -> Army +pruneArmy = M.filter (\g -> _units g > 0) + +battleOver :: Army -> Army -> Bool +battleOver immuneArmy infectionArmy = (M.null immuneArmy) || (M.null infectionArmy) + + +remainingUnitCount :: Army -> Army -> Int +-- remainingUnitCount immuneArmy infectionArmy | trace ("End with\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined +remainingUnitCount immuneArmy infectionArmy = (unitCount immuneArmy) + (unitCount infectionArmy) + where unitCount army = sum $ [_units g | g <- M.elems army] + + +part1 = battle + + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal +-- signedInteger = L.signed sc integer +symb = L.symbol sc +comma = symb "," +semicolon = symb ";" +openBracket = symb "(" +closeBracket = symb ")" + +immuneHeaderP = symb "Immune System:" +infectionHeaderP = symb "Infection:" + +sizePaddingP = symb "units each with" +hpPaddingP = symb "hit points" +attackPaddingP = symb "with an attack that does" +initiativePaddingP = symb "damage at initiative" +weaknessPaddingP = symb "weak to" +immunityPaddingP = symb "immune to" + + +armiesP = (,) <$> immuneGroupsP <*> infectionGroupsP + +immuneGroupsP = immuneHeaderP *> many groupP +infectionGroupsP = infectionHeaderP *> many groupP + +-- 72 units each with 5294 hit points (weak to slashing; immune to radiation, cold) with an attack that does 639 fire damage at initiative 1 + +groupP = engroup <$> (integer <* sizePaddingP ) + <*> (integer <* hpPaddingP) + <*> (attackModifierGroupP <* attackPaddingP ) + <*> integer + <*> (damageTypeP <* initiativePaddingP) + <*> integer + where engroup units hps aMods damage damageType initative = + Group { _units = units + , _hps = hps + , _modifiers = aMods + , _damage = damage + , _damageType = damageType + , _initiative = initative + } + + +attackModifierGroupP = option [] ((openBracket `between` closeBracket) attackModifiersP) + +attackModifiersP = attackModifierP `sepBy` semicolon +attackModifierP = weaknessP <|> immunityP +weaknessP = Weakness <$> (weaknessPaddingP *> damageTypesP) +immunityP = Immunity <$> (immunityPaddingP *> damageTypesP) + +damageTypeP = some letterChar <* sc +damageTypesP = damageTypeP `sepBy` comma + +successfulParse :: Text -> (Army, Army) +-- successfulParse _ = [] +successfulParse input = + case parse armiesP "input" input of + Left _error -> (M.empty, M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err + Right armies -> idTag armies + where idTag (immune, infect) = (tagArmy immune, tagArmy infect) + tagArmy army = M.fromList $ zip [1..] army