src/advent24/advent24iterate.hs

   1 {-# LANGUAGE NegativeLiterals #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5
   6 -- Box division approach taken from fizbin:
   7 -- https://www.reddit.com/r/adventofcode/comments/a8s17l/2018_day_23_solutions/ecfmpy0/
   8
   9 import Debug.Trace
  10
  11 -- import Prelude hiding ((++))
  12 import Data.Text (Text)
  13 import qualified Data.Text as T
  14 import qualified Data.Text.IO as TIO
  15
  16 import Data.Void (Void)
  17 import Text.Megaparsec hiding (State)
  18 import Text.Megaparsec.Char
  19 import qualified Text.Megaparsec.Char.Lexer as L
  20 import qualified Control.Applicative as CA
  21
  22 import Data.List hiding (group)
  23 import Data.Function (on)
  24 import qualified Data.Map.Strict as M
  25 import Data.Map.Strict ((!))
  26
  27
  28 data Group = Group { _units :: Int
  29                    , _hps :: Int
  30                    , _modifiers :: [Modifier]
  31                    , _damage :: Int
  32                    , _damageType :: String
  33                    , _initiative :: Int
  34                    } deriving (Eq, Show)
  35 instance Ord Group where
  36     g1 `compare` g2 = if (effectivePower g1) == (effectivePower g2)
  37                       then (_initiative g1) `compare` (_initiative g2)
  38                       else (effectivePower g1) `compare` (effectivePower g2)
  39
  40 data Modifier = Weakness [String] | Immunity [String]
  41         deriving (Eq, Show)
  42
  43 type Army = M.Map Int Group
  44 type Allocation = (Int, Int)
  45 data BattleOrder = Immune Int | Infection Int deriving (Eq, Show)
  46
  47
  48 main :: IO ()
  49 main = do
  50         text <- TIO.readFile "data/advent24.txt"
  51         let armies = successfulParse text
  52         print armies
  53         print $ part1 (fst armies) (snd armies)
  54
  55
  56 part1 = battle
  57
  58 effectivePower :: Group -> Int
  59 effectivePower group = (_units group) * (_damage group)
  60
  61 damageCaused :: Group -> Group -> Int
  62 damageCaused attacker defender =
  63     if attackType `elem` immunities then 0
  64     else if attackType `elem` weaknesses then (2 * effectivePower attacker)
  65          else effectivePower attacker
  66     where attackType = _damageType attacker
  67           weaknesses = foldl' extractWeakness [] (_modifiers defender)
  68           immunities = foldl' extractImmunity [] (_modifiers defender)
  69
  70 extractWeakness :: [String] -> Modifier -> [String]
  71 extractWeakness currentWeaknesses (Weakness ws) = currentWeaknesses ++ ws
  72 extractWeakness currentWeaknesses (Immunity _ws) = currentWeaknesses
  73
  74 extractImmunity :: [String] -> Modifier -> [String]
  75 extractImmunity currentImmunity (Weakness _ms) = currentImmunity
  76 extractImmunity currentImmunity (Immunity ms) = currentImmunity ++ ms
  77
  78 applyDamage :: Group -> Int -> Group
  79 applyDamage group damage = group { _units = unitsRemaining }
  80     where unitsKilled = damage `div` (_hps group)
  81           unitsRemaining = maximum [0, (_units group) - unitsKilled]
  82
  83
  84 keysByEffectivePower :: Army -> [Int]
  85 keysByEffectivePower army = reverse $ sortOn (\k -> effectivePower (army!k)) (M.keys army)
  86
  87 allocateAttackers :: Army -> Army -> [Allocation]
  88 allocateAttackers attackers defenders = fst $ foldl' (allocateAttacker attackers defenders) ([], M.keys defenders) $ keysByEffectivePower attackers
  89
  90 allocateAttacker :: Army -> Army -> ([Allocation], [Int]) -> Int -> ([Allocation], [Int])
  91 -- allocateAttacker attackers defenders allocated@(assignedTargets, availableTargets) attackerKey | trace ("Allocate " ++ show attackerKey ++ "\n" ++ show allocated ++ "\n" ++ show [(t, sortTarget t) | t <- targets]) False = undefined
  92 --     where targets = reverse $ sortOn sortTarget availableTargets
  93 --           sortTarget t = ( damageCaused (attackers!attackerKey) (defenders!t)
  94 --                          , effectivePower (defenders!t)
  95 --                          , _initiative (defenders!t)
  96 --                          )
  97 allocateAttacker attackers defenders (assignedTargets, availableTargets) attackerKey =
  98     if null viableTargets
  99     then (assignedTargets, availableTargets)
 100     else (((attackerKey, target):assignedTargets), delete target availableTargets)
 101     where attacker = attackers!attackerKey
 102           viableTargets = filter (\t -> damageCaused attacker (defenders!t) > 0 ) availableTargets
 103           target = head $ reverse $ sortOn sortTarget viableTargets
 104           sortTarget t = ( damageCaused attacker (defenders!t)
 105                          , effectivePower (defenders!t)
 106                          , _initiative (defenders!t)
 107                          )
 108
 109
 110 battleOrder :: Army -> Army -> [BattleOrder]
 111 battleOrder immuneArmy infectionArmy = mergeOrders immuneIds infectIds
 112     where armyIds army = reverse $ sort [(_initiative (army!k), k) | k <- M.keys army]
 113     -- $ sortOn (\k -> (_initiative (army!k), k)) $ M.keys army
 114           immuneIds = armyIds immuneArmy
 115           infectIds = armyIds infectionArmy
 116
 117 mergeOrders :: [(Int, Int)] -> [(Int, Int)] -> [BattleOrder]
 118 mergeOrders [] ids = [ Infection k | (_, k) <- ids ]
 119 mergeOrders ids [] = [ Immune k | (_, k) <- ids ]
 120 mergeOrders ((i1, k1):id1s) ((i2, k2):id2s)
 121     | i1 >= i2  = (Immune k1):(mergeOrders id1s ((i2, k2):id2s))
 122     | otherwise = (Infection k2):(mergeOrders ((i1, k1):id1s) id2s)
 123
 124 battleRound :: (Army, Army) -> (Army, Army)
 125 -- battleRound (immuneArmy, infectionArmy) | trace ("Round\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined
 126 -- battleRound immuneArmy infectionArmy | trace (show (armyCount immuneArmy) ++ " " ++ show (armyCount infectionArmy)) False = undefined
 127 battleRound (immuneArmy, infectionArmy) = (pruneArmy immuneArmy', pruneArmy infectionArmy')
 128     where immuneAllocations = allocateAttackers immuneArmy infectionArmy
 129           infectionAllocations = allocateAttackers infectionArmy immuneArmy
 130           actionOrder = battleOrder immuneArmy infectionArmy
 131           (immuneArmy', infectionArmy') =     foldl' (\ (a1, a2) order -> handleOrder order immuneAllocations infectionAllocations a1 a2)
 132                                                      (immuneArmy, infectionArmy)  actionOrder
 133
 134
 135 -- armyCount army = sum [_units g | g <- M.elems army ]
 136
 137 handleOrder :: BattleOrder -> [Allocation] -> [Allocation] -> Army -> Army -> (Army, Army)
 138 handleOrder (Immune k) allocations _ attackArmy defendArmy = (attackArmy, defendArmy')
 139     where defendArmy' = handleAttack k allocations attackArmy defendArmy
 140 handleOrder (Infection k) _ allocations defendArmy attackArmy = (defendArmy', attackArmy)
 141     where defendArmy' = handleAttack k allocations attackArmy defendArmy
 142
 143 handleAttack :: Int -> [Allocation] -> Army -> Army -> Army
 144 handleAttack attacker allocations attackArmy defendArmy =
 145     if not $ null attackersAllocations
 146     then M.insert defender defendGroup' defendArmy
 147     else defendArmy
 148     where attackersAllocations = filter (\a -> attacker == fst a ) allocations
 149           defender = snd $ head attackersAllocations
 150           defendGroup = (defendArmy!defender)
 151           damage = damageCaused (attackArmy!attacker) defendGroup
 152           defendGroup' = applyDamage defendGroup damage
 153
 154 battle :: Army -> Army -> Int
 155 battle immuneArmy infectionArmy = uncurry remainingUnitCount endState
 156     where endState = head $ dropWhile (not . uncurry battleOver) $ iterate battleRound (immuneArmy, infectionArmy)
 157
 158
 159 pruneArmy :: Army -> Army
 160 pruneArmy = M.filter (\g -> _units g > 0)
 161
 162 battleOver :: Army -> Army -> Bool
 163 battleOver immuneArmy infectionArmy = (M.null immuneArmy) || (M.null infectionArmy)
 164
 165
 166 remainingUnitCount :: Army -> Army -> Int
 167 -- remainingUnitCount immuneArmy infectionArmy | trace ("End with\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined
 168 remainingUnitCount immuneArmy infectionArmy = (unitCount immuneArmy) + (unitCount infectionArmy)
 169     where unitCount army = sum $ [_units g | g <- M.elems army]
 170
 171
 172
 173 type Parser = Parsec Void Text
 174
 175 sc :: Parser ()
 176 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 177
 178 lexeme  = L.lexeme sc
 179 integer = lexeme L.decimal
 180 -- signedInteger = L.signed sc integer
 181 symb = L.symbol sc
 182 comma = symb ","
 183 semicolon = symb ";"
 184 openBracket = symb "("
 185 closeBracket = symb ")"
 186
 187 immuneHeaderP = symb "Immune System:"
 188 infectionHeaderP = symb "Infection:"
 189
 190 sizePaddingP = symb "units each with"
 191 hpPaddingP = symb "hit points"
 192 attackPaddingP = symb "with an attack that does"
 193 initiativePaddingP = symb "damage at initiative"
 194 weaknessPaddingP = symb "weak to"
 195 immunityPaddingP = symb "immune to"
 196
 197
 198 armiesP = (,) <$> immuneGroupsP <*> infectionGroupsP
 199
 200 immuneGroupsP = immuneHeaderP *> many groupP
 201 infectionGroupsP = infectionHeaderP *> many groupP
 202
 203 -- 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
 204
 205 groupP = engroup <$> (integer <* sizePaddingP )
 206                  <*> (integer <* hpPaddingP)
 207                  <*> (attackModifierGroupP <* attackPaddingP )
 208                  <*> integer
 209                  <*> (damageTypeP <* initiativePaddingP)
 210                  <*> integer
 211     where engroup units hps aMods damage damageType initative =
 212                 Group { _units = units
 213                       , _hps = hps
 214                       , _modifiers = aMods
 215                       , _damage = damage
 216                       , _damageType = damageType
 217                       , _initiative = initative
 218                       }
 219
 220
 221 attackModifierGroupP = option [] ((openBracket `between` closeBracket) attackModifiersP)
 222
 223 attackModifiersP = attackModifierP `sepBy` semicolon
 224 attackModifierP = weaknessP <|> immunityP
 225 weaknessP = Weakness <$> (weaknessPaddingP *> damageTypesP)
 226 immunityP = Immunity <$> (immunityPaddingP *> damageTypesP)
 227
 228 damageTypeP = some letterChar <* sc
 229 damageTypesP = damageTypeP `sepBy` comma
 230
 231 successfulParse :: Text -> (Army, Army)
 232 -- successfulParse _ = []
 233 successfulParse input =
 234         case parse armiesP "input" input of
 235                 Left  _error -> (M.empty, M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
 236                 Right armies -> idTag armies
 237         where idTag (immune, infect) = (tagArmy immune, tagArmy infect)
 238               tagArmy army = M.fromList $ zip [1..] army