X-Git-Url: https://git.njae.me.uk/?p=advent-of-code-18.git;a=blobdiff_plain;f=src%2Fadvent24%2Fadvent24iterate.hs;fp=src%2Fadvent24%2Fadvent24iterate.hs;h=0000000000000000000000000000000000000000;hp=ddd2782a736a182f0e596afb8a2e4b5201cdce45;hb=548c9bd095213b388debfb09ba9727b2174b21d4;hpb=c8439c57608fc1b57cba81da2cf841919fc008d7 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