--- /dev/null
+{-# 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
projects / advent-of-code-18.git / blobdiff