src/advent24/advent24.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 effectivePower group = (_units group) * (_damage group)
  56
  57 damageCaused attacker defender =
  58     if attackType `elem` immunities then 0
  59     else if attackType `elem` weaknesses then (2 * effectivePower attacker)
  60          else effectivePower attacker
  61     where attackType = _damageType attacker
  62           weaknesses = foldl' extractWeakness [] (_modifiers defender)
  63           immunities = foldl' extractImmunity [] (_modifiers defender)
  64
  65 extractWeakness currentWeaknesses (Weakness ws) = currentWeaknesses ++ ws
  66 extractWeakness currentWeaknesses (Immunity _ws) = currentWeaknesses
  67
  68 extractImmunity currentImmunity (Weakness _ms) = currentImmunity
  69 extractImmunity currentImmunity (Immunity ms) = currentImmunity ++ ms
  70
  71 applyDamage group damage = group { _units = unitsRemaining }
  72     where unitsKilled = damage `div` (_hps group)
  73           unitsRemaining = maximum [0, (_units group) - unitsKilled]
  74
  75
  76 keysByEffectivePower :: Army -> [Int]
  77 keysByEffectivePower army = reverse $ sortOn (\k -> effectivePower (army!k)) (M.keys army)
  78
  79 allocateAttackers :: Army -> Army -> [Allocation]
  80 allocateAttackers attackers defenders = fst $ foldl' (allocateAttacker attackers defenders) ([], M.keys defenders) $ keysByEffectivePower attackers
  81
  82 allocateAttacker :: Army -> Army -> ([Allocation], [Int]) -> Int -> ([Allocation], [Int])
  83 -- allocateAttacker attackers defenders allocated@(assignedTargets, availableTargets) attackerKey | trace ("Allocate " ++ show attackerKey ++ "\n" ++ show allocated ++ "\n" ++ show [(t, sortTarget t) | t <- targets]) False = undefined
  84 --     where targets = reverse $ sortOn sortTarget availableTargets
  85 --           sortTarget t = ( damageCaused (attackers!attackerKey) (defenders!t)
  86 --                          , effectivePower (defenders!t)
  87 --                          , _initiative (defenders!t)
  88 --                          )
  89 allocateAttacker attackers defenders (assignedTargets, availableTargets) attackerKey =
  90     if null viableTargets
  91     then (assignedTargets, availableTargets)
  92     else (((attackerKey, target):assignedTargets), delete target availableTargets)
  93     where attacker = attackers!attackerKey
  94           viableTargets = filter (\t -> damageCaused attacker (defenders!t) > 0 ) availableTargets
  95           target = head $ reverse $ sortOn sortTarget viableTargets
  96           sortTarget t = ( damageCaused attacker (defenders!t)
  97                          , effectivePower (defenders!t)
  98                          , _initiative (defenders!t)
  99                          )
 100
 101
 102 battleOrder :: Army -> Army -> [BattleOrder]
 103 battleOrder immuneArmy infectionArmy = mergeOrders immuneIds infectIds
 104     where armyIds army = reverse $ sort [(_initiative (army!k), k) | k <- M.keys army]
 105     -- $ sortOn (\k -> (_initiative (army!k), k)) $ M.keys army
 106           immuneIds = armyIds immuneArmy
 107           infectIds = armyIds infectionArmy
 108
 109 mergeOrders :: [(Int, Int)] -> [(Int, Int)] -> [BattleOrder]
 110 mergeOrders [] ids = [ Infection k | (_, k) <- ids ]
 111 mergeOrders ids [] = [ Immune k | (_, k) <- ids ]
 112 mergeOrders ((i1, k1):id1s) ((i2, k2):id2s)
 113     | i1 >= i2  = (Immune k1):(mergeOrders id1s ((i2, k2):id2s))
 114     | otherwise = (Infection k2):(mergeOrders ((i1, k1):id1s) id2s)
 115
 116 battleRound :: Army -> Army -> (Army, Army)
 117 battleRound immuneArmy infectionArmy | trace ("Round\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined
 118 -- battleRound immuneArmy infectionArmy | trace (show (armyCount immuneArmy) ++ " " ++ show (armyCount infectionArmy)) False = undefined
 119 battleRound immuneArmy infectionArmy = (pruneArmy immuneArmy', pruneArmy infectionArmy')
 120     where immuneAllocations = allocateAttackers immuneArmy infectionArmy
 121           infectionAllocations = allocateAttackers infectionArmy immuneArmy
 122           actionOrder = battleOrder immuneArmy infectionArmy
 123           (immuneArmy', infectionArmy') =     foldl' (\ (a1, a2) order -> handleOrder order immuneAllocations infectionAllocations a1 a2)
 124                                                      (immuneArmy, infectionArmy)  actionOrder
 125
 126
 127 -- armyCount army = sum [_units g | g <- M.elems army ]
 128
 129 handleOrder :: BattleOrder -> [Allocation] -> [Allocation] -> Army -> Army -> (Army, Army)
 130 handleOrder (Immune k) allocations _ attackArmy defendArmy = (attackArmy, defendArmy')
 131     where defendArmy' = handleAttack k allocations attackArmy defendArmy
 132 handleOrder (Infection k) _ allocations defendArmy attackArmy = (defendArmy', attackArmy)
 133     where defendArmy' = handleAttack k allocations attackArmy defendArmy
 134
 135 handleAttack :: Int -> [Allocation] -> Army -> Army -> Army
 136 handleAttack attacker allocations attackArmy defendArmy =
 137     if not $ null attackersAllocations
 138     then M.insert defender defendGroup' defendArmy
 139     else defendArmy
 140     where attackersAllocations = filter (\a -> attacker == fst a ) allocations
 141           defender = snd $ head attackersAllocations
 142           defendGroup = (defendArmy!defender)
 143           damage = damageCaused (attackArmy!attacker) defendGroup
 144           defendGroup' = applyDamage defendGroup damage
 145
 146 battle :: Army -> Army -> Int
 147 battle immuneArmy infectionArmy =
 148     if battleOver immuneArmy infectionArmy
 149     then remainingUnitCount immuneArmy infectionArmy
 150     else battle immuneArmy' infectionArmy'
 151     where (immuneArmy', infectionArmy') = battleRound immuneArmy infectionArmy
 152
 153
 154 pruneArmy :: Army -> Army
 155 pruneArmy = M.filter (\g -> _units g > 0)
 156
 157 battleOver :: Army -> Army -> Bool
 158 battleOver immuneArmy infectionArmy = (M.null immuneArmy) || (M.null infectionArmy)
 159
 160
 161 remainingUnitCount :: Army -> Army -> Int
 162 -- remainingUnitCount immuneArmy infectionArmy | trace ("End with\n" ++ show immuneArmy ++ " " ++ show infectionArmy) False = undefined
 163 remainingUnitCount immuneArmy infectionArmy = (unitCount immuneArmy) + (unitCount infectionArmy)
 164     where unitCount army = sum $ [_units g | g <- M.elems army]
 165
 166
 167 part1 = battle
 168
 169
 170 type Parser = Parsec Void Text
 171
 172 sc :: Parser ()
 173 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 174
 175 lexeme  = L.lexeme sc
 176 integer = lexeme L.decimal
 177 -- signedInteger = L.signed sc integer
 178 symb = L.symbol sc
 179 comma = symb ","
 180 semicolon = symb ";"
 181 openBracket = symb "("
 182 closeBracket = symb ")"
 183
 184 immuneHeaderP = symb "Immune System:"
 185 infectionHeaderP = symb "Infection:"
 186
 187 sizePaddingP = symb "units each with"
 188 hpPaddingP = symb "hit points"
 189 attackPaddingP = symb "with an attack that does"
 190 initiativePaddingP = symb "damage at initiative"
 191 weaknessPaddingP = symb "weak to"
 192 immunityPaddingP = symb "immune to"
 193
 194
 195 armiesP = (,) <$> immuneGroupsP <*> infectionGroupsP
 196
 197 immuneGroupsP = immuneHeaderP *> many groupP
 198 infectionGroupsP = infectionHeaderP *> many groupP
 199
 200 -- 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
 201
 202 groupP = engroup <$> (integer <* sizePaddingP )
 203                  <*> (integer <* hpPaddingP)
 204                  <*> (attackModifierGroupP <* attackPaddingP )
 205                  <*> integer
 206                  <*> (damageTypeP <* initiativePaddingP)
 207                  <*> integer
 208     where engroup units hps aMods damage damageType initative =
 209                 Group { _units = units
 210                       , _hps = hps
 211                       , _modifiers = aMods
 212                       , _damage = damage
 213                       , _damageType = damageType
 214                       , _initiative = initative
 215                       }
 216
 217
 218 attackModifierGroupP = option [] ((openBracket `between` closeBracket) attackModifiersP)
 219
 220 attackModifiersP = attackModifierP `sepBy` semicolon
 221 attackModifierP = weaknessP <|> immunityP
 222 weaknessP = Weakness <$> (weaknessPaddingP *> damageTypesP)
 223 immunityP = Immunity <$> (immunityPaddingP *> damageTypesP)
 224
 225 damageTypeP = some letterChar <* sc
 226 damageTypesP = damageTypeP `sepBy` comma
 227
 228 successfulParse :: Text -> (Army, Army)
 229 -- successfulParse _ = []
 230 successfulParse input =
 231         case parse armiesP "input" input of
 232                 Left  _error -> (M.empty, M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
 233                 Right armies -> idTag armies
 234         where idTag (immune, infect) = (tagArmy immune, tagArmy infect)
 235               tagArmy army = M.fromList $ zip [1..] army