{-# Language RecordWildCards, TemplateHaskell, QuasiQuotes, ImportQualifiedPost #-}
{-|
Module      : Main
Description : Day 24 solution
Copyright   : (c) Eric Mertens, 2018
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2018/day/24>
-}
module Main (main) where

import Advent (format, stageTH)
import Data.IntMap (IntMap)
import Data.IntMap qualified as IntMap
import Data.List (foldl', maximumBy, delete, sortOn)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)

data Group = Group
  { Group -> Int
size          :: !Int
  , Group -> Int
hp            :: !Int
  , Group -> [(Element, Effect)]
special       :: [(Element, Effect)]
  , Group -> Int
attack        :: !Int
  , Group -> Element
attackElement :: !Element
  , Group -> Int
initiative    :: !Int
  , Group -> Team
team          :: !Team
  }
  deriving (Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Group -> ShowS
showsPrec :: Int -> Group -> ShowS
$cshow :: Group -> String
show :: Group -> String
$cshowList :: [Group] -> ShowS
showList :: [Group] -> ShowS
Show, Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
/= :: Group -> Group -> Bool
Eq)

type Team = T
data T = Tgood | Tbad deriving (Team -> Team -> Bool
(Team -> Team -> Bool) -> (Team -> Team -> Bool) -> Eq Team
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Team -> Team -> Bool
== :: Team -> Team -> Bool
$c/= :: Team -> Team -> Bool
/= :: Team -> Team -> Bool
Eq, Eq Team
Eq Team =>
(Team -> Team -> Ordering)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Bool)
-> (Team -> Team -> Team)
-> (Team -> Team -> Team)
-> Ord Team
Team -> Team -> Bool
Team -> Team -> Ordering
Team -> Team -> Team
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Team -> Team -> Ordering
compare :: Team -> Team -> Ordering
$c< :: Team -> Team -> Bool
< :: Team -> Team -> Bool
$c<= :: Team -> Team -> Bool
<= :: Team -> Team -> Bool
$c> :: Team -> Team -> Bool
> :: Team -> Team -> Bool
$c>= :: Team -> Team -> Bool
>= :: Team -> Team -> Bool
$cmax :: Team -> Team -> Team
max :: Team -> Team -> Team
$cmin :: Team -> Team -> Team
min :: Team -> Team -> Team
Ord, Int -> Team -> ShowS
[Team] -> ShowS
Team -> String
(Int -> Team -> ShowS)
-> (Team -> String) -> ([Team] -> ShowS) -> Show Team
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Team -> ShowS
showsPrec :: Int -> Team -> ShowS
$cshow :: Team -> String
show :: Team -> String
$cshowList :: [Team] -> ShowS
showList :: [Team] -> ShowS
Show)

type Effect = E
data E = Eweak | Eimmune deriving (Effect -> Effect -> Bool
(Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool) -> Eq Effect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Effect -> Effect -> Bool
== :: Effect -> Effect -> Bool
$c/= :: Effect -> Effect -> Bool
/= :: Effect -> Effect -> Bool
Eq, Eq Effect
Eq Effect =>
(Effect -> Effect -> Ordering)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Effect)
-> (Effect -> Effect -> Effect)
-> Ord Effect
Effect -> Effect -> Bool
Effect -> Effect -> Ordering
Effect -> Effect -> Effect
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Effect -> Effect -> Ordering
compare :: Effect -> Effect -> Ordering
$c< :: Effect -> Effect -> Bool
< :: Effect -> Effect -> Bool
$c<= :: Effect -> Effect -> Bool
<= :: Effect -> Effect -> Bool
$c> :: Effect -> Effect -> Bool
> :: Effect -> Effect -> Bool
$c>= :: Effect -> Effect -> Bool
>= :: Effect -> Effect -> Bool
$cmax :: Effect -> Effect -> Effect
max :: Effect -> Effect -> Effect
$cmin :: Effect -> Effect -> Effect
min :: Effect -> Effect -> Effect
Ord, Int -> Effect -> ShowS
[Effect] -> ShowS
Effect -> String
(Int -> Effect -> ShowS)
-> (Effect -> String) -> ([Effect] -> ShowS) -> Show Effect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Effect -> ShowS
showsPrec :: Int -> Effect -> ShowS
$cshow :: Effect -> String
show :: Effect -> String
$cshowList :: [Effect] -> ShowS
showList :: [Effect] -> ShowS
Show)

type Element = D
data D = Dbludgeoning | Dfire | Dslashing | Dradiation | Dcold
  deriving (Element -> Element -> Bool
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
/= :: Element -> Element -> Bool
Eq, Eq Element
Eq Element =>
(Element -> Element -> Ordering)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Element)
-> (Element -> Element -> Element)
-> Ord Element
Element -> Element -> Bool
Element -> Element -> Ordering
Element -> Element -> Element
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Element -> Element -> Ordering
compare :: Element -> Element -> Ordering
$c< :: Element -> Element -> Bool
< :: Element -> Element -> Bool
$c<= :: Element -> Element -> Bool
<= :: Element -> Element -> Bool
$c> :: Element -> Element -> Bool
> :: Element -> Element -> Bool
$c>= :: Element -> Element -> Bool
>= :: Element -> Element -> Bool
$cmax :: Element -> Element -> Element
max :: Element -> Element -> Element
$cmin :: Element -> Element -> Element
min :: Element -> Element -> Element
Ord, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Element -> ShowS
showsPrec :: Int -> Element -> ShowS
$cshow :: Element -> String
show :: Element -> String
$cshowList :: [Element] -> ShowS
showList :: [Element] -> ShowS
Show)

stageTH

-- | Print the answers to day 24
--
-- >>> :main
-- 16747
-- 5923
main :: IO ()
IO ()
main =
 do ([(Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)]
goods, [(Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)]
bads) <- [format|2018 24
      Immune System:%n
      (%u units each with %u hit points(| %((@E to @D&(, ))&(; )%)) with an attack that does %u @D damage at initiative %u%n)*
      %n
      Infection:%n
      (%u units each with %u hit points(| %((@E to @D&(, ))&(; )%)) with an attack that does %u @D damage at initiative %u%n)*|]
    let toGroup :: Team
-> (Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)
-> Group
toGroup Team
team (Int
size, Int
hp, Maybe [(Effect, [Element])]
mbSpecial, Int
attack, Element
attackElement, Int
initiative) =
          Group{ special :: [(Element, Effect)]
special = [(Element
d, Effect
e) | (Effect
e, [Element]
ds) <- [(Effect, [Element])]
-> Maybe [(Effect, [Element])] -> [(Effect, [Element])]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(Effect, [Element])]
mbSpecial, Element
d <- [Element]
ds], Int
Element
Team
size :: Int
hp :: Int
attack :: Int
attackElement :: Element
initiative :: Int
team :: Team
team :: Team
size :: Int
hp :: Int
attack :: Int
attackElement :: Element
initiative :: Int
..}
    let groups :: [Group]
groups = ((Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)
 -> Group)
-> [(Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)]
-> [Group]
forall a b. (a -> b) -> [a] -> [b]
map (Team
-> (Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)
-> Group
toGroup Team
Tgood) [(Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)]
goods [Group] -> [Group] -> [Group]
forall a. [a] -> [a] -> [a]
++ ((Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)
 -> Group)
-> [(Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)]
-> [Group]
forall a b. (a -> b) -> [a] -> [b]
map (Team
-> (Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)
-> Group
toGroup Team
Tbad) [(Int, Int, Maybe [(Effect, [Element])], Int, Element, Int)]
bads
    let groupMap :: IntMap Group
groupMap = [(Int, Group)] -> IntMap Group
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [ (Group -> Int
initiative Group
g, Group
g) | Group
g <- [Group]
groups ]
    Int -> IO ()
forall a. Show a => a -> IO ()
print (IntMap Group -> Int
evaluate (IntMap Group -> IntMap Group
simulate IntMap Group
groupMap))
    Int -> IO ()
forall a. Show a => a -> IO ()
print (IntMap Group -> Int
evaluate ((Int -> Maybe (IntMap Group))
-> Int -> Maybe (Int, IntMap Group) -> IntMap Group
forall a. (Int -> Maybe a) -> Int -> Maybe (Int, a) -> a
search (IntMap Group -> Int -> Maybe (IntMap Group)
attemptBoost IntMap Group
groupMap) Int
1 Maybe (Int, IntMap Group)
forall a. Maybe a
Nothing))

-- | Find the sum of the sizes of all the groups.
evaluate :: IntMap Group -> Int
evaluate :: IntMap Group -> Int
evaluate = IntMap Int -> Int
forall a. Num a => IntMap a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (IntMap Int -> Int)
-> (IntMap Group -> IntMap Int) -> IntMap Group -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Group -> Int) -> IntMap Group -> IntMap Int
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group -> Int
size

-- | Determine the lowest value that satisfies the given
-- predicate and return the result.
search ::
  (Int -> Maybe a) {- ^ satisfication condition -} ->
  Int              {- ^ known too low bound     -} ->
  Maybe (Int, a)   {- ^ known satisfying int    -} ->
  a                {- satisfying result         -}
search :: forall a. (Int -> Maybe a) -> Int -> Maybe (Int, a) -> a
search Int -> Maybe a
f Int
tooLo (Just (Int
hi, a
best)) | Int
tooLo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hi = a
best
search Int -> Maybe a
f Int
tooLo Maybe (Int, a)
mbHi =
  case Int -> Maybe a
f Int
i of
    Maybe a
Nothing   -> (Int -> Maybe a) -> Int -> Maybe (Int, a) -> a
forall a. (Int -> Maybe a) -> Int -> Maybe (Int, a) -> a
search Int -> Maybe a
f Int
i Maybe (Int, a)
mbHi
    Just a
best -> (Int -> Maybe a) -> Int -> Maybe (Int, a) -> a
forall a. (Int -> Maybe a) -> Int -> Maybe (Int, a) -> a
search Int -> Maybe a
f Int
tooLo ((Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
i, a
best))
  where
    i :: Int
i = case Maybe (Int, a)
mbHi of
          Maybe (Int, a)
Nothing     -> Int
tooLoInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2
          Just (Int
hi,a
_) -> (Int
tooLoInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hi) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2

-- | Test if a group is on the reindeer team.
isGood :: Group -> Bool
isGood :: Group -> Bool
isGood Group
g = Team
Tgood Team -> Team -> Bool
forall a. Eq a => a -> a -> Bool
== Group -> Team
team Group
g

-- | Determine if a boost is enough to allow the reindeer to
-- win. If it is return the final group of reindeer.
attemptBoost :: IntMap Group -> Int -> Maybe (IntMap Group)
attemptBoost :: IntMap Group -> Int -> Maybe (IntMap Group)
attemptBoost IntMap Group
groups Int
boost
  | (Group -> Bool) -> IntMap Group -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Group -> Bool
isGood IntMap Group
outcome = IntMap Group -> Maybe (IntMap Group)
forall a. a -> Maybe a
Just IntMap Group
outcome
  | Bool
otherwise          = Maybe (IntMap Group)
forall a. Maybe a
Nothing
  where
    boostGood :: Group -> Group
boostGood Group
g
      | Group -> Bool
isGood Group
g  = Group
g { attack = attack g + boost }
      | Bool
otherwise = Group
g

    outcome :: IntMap Group
outcome = IntMap Group -> IntMap Group
simulate ((Group -> Group) -> IntMap Group -> IntMap Group
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group -> Group
boostGood IntMap Group
groups)

-- battle logic --------------------------------------------------------

-- | Run a battle until it stops making progress due to immunities
-- or due to a team being wiped out.
simulate :: IntMap Group -> IntMap Group
simulate :: IntMap Group -> IntMap Group
simulate IntMap Group
groups
  | IntMap Group
groups IntMap Group -> IntMap Group -> Bool
forall a. Eq a => a -> a -> Bool
== IntMap Group
groups' = IntMap Group
groups
  | Bool
otherwise         = IntMap Group -> IntMap Group
simulate IntMap Group
groups'
  where
    groups' :: IntMap Group
groups' = IntMap Group -> IntMap Group
combat IntMap Group
groups

-- | Determine the effectiveness multiplier of an attack element against
-- a particular group.
effectiveness ::
  Group {- ^ attacker          -} ->
  Group {- ^ defender          -} ->
  Int   {- ^ damage multiplier -}
effectiveness :: Group -> Group -> Int
effectiveness Group
atk Group
def =
  case Element -> [(Element, Effect)] -> Maybe Effect
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Group -> Element
attackElement Group
atk) (Group -> [(Element, Effect)]
special Group
def) of
    Just Effect
Eimmune -> Int
0
    Maybe Effect
Nothing      -> Int
1
    Just Effect
Eweak   -> Int
2

-- | Compute effective power of a group
effectivePower :: Group -> Int
effectivePower :: Group -> Int
effectivePower Group
grp = Group -> Int
size Group
grp Int -> Int -> Int
forall a. Num a => a -> a -> a
* Group -> Int
attack Group
grp

-- | Order a list of groups by the order they get to chose their
-- targets.
targetSelectionOrder ::
  [Group] {- ^ unordered groups        -} ->
  [Group] {- ^ target preference order -}
targetSelectionOrder :: [Group] -> [Group]
targetSelectionOrder = (Group -> (Int, Int)) -> [Group] -> [Group]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Group -> (Int, Int)
prj
  where
    -- ascending sort lexicographic order:
    -- * effectiveness (negated for descending order)
    -- * initiative    (negated for descending order)
    prj :: Group -> (Int, Int)
prj Group
grp = (Int -> Int
forall a. Num a => a -> a
negate (Group -> Int
effectivePower Group
grp), Int -> Int
forall a. Num a => a -> a
negate (Group -> Int
initiative Group
grp))

-- | Given a list of groups generate a targetting assignment.
targetSelection ::
  [Group]    {- ^ unordered groups        -} ->
  IntMap Int {- ^ attacker / defender IDs -}
targetSelection :: [Group] -> IntMap Int
targetSelection [Group]
groups =
  (IntMap Int, [Group]) -> IntMap Int
forall a b. (a, b) -> a
fst (((IntMap Int, [Group]) -> Group -> (IntMap Int, [Group]))
-> (IntMap Int, [Group]) -> [Group] -> (IntMap Int, [Group])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (IntMap Int, [Group]) -> Group -> (IntMap Int, [Group])
chooseTarget (IntMap Int
forall a. IntMap a
IntMap.empty, [Group]
groups) ([Group] -> [Group]
targetSelectionOrder [Group]
groups))

-- | Given the current targetting assignment and a list of the groups
-- not yet targeted, update the assignment and list given the
-- preferences of the next attacker.
chooseTarget ::
  (IntMap Int, [Group]) {- ^ targets so far and remaining groups -} ->
  Group                 {- ^ attacker                            -} ->
  (IntMap Int, [Group])
chooseTarget :: (IntMap Int, [Group]) -> Group -> (IntMap Int, [Group])
chooseTarget (IntMap Int
targets, [Group]
groups) Group
atk =
  (IntMap Int, [Group])
-> Maybe (IntMap Int, [Group]) -> (IntMap Int, [Group])
forall a. a -> Maybe a -> a
fromMaybe (IntMap Int
targets, [Group]
groups) (Maybe (IntMap Int, [Group]) -> (IntMap Int, [Group]))
-> Maybe (IntMap Int, [Group]) -> (IntMap Int, [Group])
forall a b. (a -> b) -> a -> b
$ -- use previous values if no target
  do Group
def <- Group -> [Group] -> Maybe Group
targetChoice Group
atk [Group]
groups
     let targets' :: IntMap Int
targets' = Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (Group -> Int
initiative Group
atk) (Group -> Int
initiative Group
def) IntMap Int
targets
         groups' :: [Group]
groups'  = Group -> [Group] -> [Group]
forall a. Eq a => a -> [a] -> [a]
delete Group
def [Group]
groups
     IntMap Int
targets' IntMap Int
-> Maybe (IntMap Int, [Group]) -> Maybe (IntMap Int, [Group])
forall a b. a -> b -> b
`seq` (IntMap Int, [Group]) -> Maybe (IntMap Int, [Group])
forall a. a -> Maybe a
Just (IntMap Int
targets', [Group]
groups')

-- | Given a group and the list of remaining target choices, determine
-- the chosen group, if any.
targetChoice ::
  Group   {- ^ attacker          -} ->
  [Group] {- ^ elligible targets -} ->
  Maybe Group
targetChoice :: Group -> [Group] -> Maybe Group
targetChoice Group
atk [Group]
groups = (Group -> (Int, Int, Int)) -> [Group] -> Maybe Group
forall (t :: * -> *) b a.
(Foldable t, Ord b) =>
(a -> b) -> t a -> Maybe a
maximumOn Group -> (Int, Int, Int)
prj ((Group -> Bool) -> [Group] -> [Group]
forall a. (a -> Bool) -> [a] -> [a]
filter (Group -> Group -> Bool
isValidTarget Group
atk) [Group]
groups)
  where
    -- maximum lexicographic order:
    -- * effectiveness   (prefer targeting groups weak to this unit)
    -- * effective power (prefer targeting strong groups)
    -- * initiative      (prefer targeting high initiative groups)
    prj :: Group -> (Int, Int, Int)
prj Group
def = (Group -> Group -> Int
effectiveness Group
atk Group
def, Group -> Int
effectivePower Group
def, Group -> Int
initiative Group
def)

-- | Check if one unit can attack another.
isValidTarget ::
  Group {- ^ attacker            -} ->
  Group {- ^ defender            -} ->
  Bool  {- ^ valid attack choice -}
isValidTarget :: Group -> Group -> Bool
isValidTarget Group
atk Group
def = Group -> Team
team Group
atk Team -> Team -> Bool
forall a. Eq a => a -> a -> Bool
/= Group -> Team
team Group
def      -- no friendly fire
                     Bool -> Bool -> Bool
&& Group -> Group -> Int
effectiveness Group
atk Group
def Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -- skip if immune

-- | Given an unordered list of groups, compute the result of combat
combat :: IntMap Group -> IntMap Group
combat :: IntMap Group -> IntMap Group
combat IntMap Group
groups = (IntMap Group -> Int -> IntMap Group)
-> IntMap Group -> [Int] -> IntMap Group
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (IntMap Int -> IntMap Group -> Int -> IntMap Group
combatTurn IntMap Int
targets) IntMap Group
groups [Int]
combatOrder
  where
    targets :: IntMap Int
targets     = [Group] -> IntMap Int
targetSelection (IntMap Group -> [Group]
forall a. IntMap a -> [a]
IntMap.elems IntMap Group
groups)

    combatOrder :: [Int]
combatOrder = [Int] -> [Int]
forall a. [a] -> [a]
reverse (IntMap Group -> [Int]
forall a. IntMap a -> [Int]
IntMap.keys IntMap Group
groups)

-- Apply the combat effect for a specific group identified by its ID
combatTurn ::
  IntMap Int   {- ^ targets        -} ->
  IntMap Group {- ^ all groups     -} ->
  Int          {- ^ attacker ID    -} ->
  IntMap Group {- ^ updated groups -}
combatTurn :: IntMap Int -> IntMap Group -> Int -> IntMap Group
combatTurn IntMap Int
targets IntMap Group
groups Int
atkid =
  IntMap Group -> Maybe (IntMap Group) -> IntMap Group
forall a. a -> Maybe a -> a
fromMaybe IntMap Group
groups (Maybe (IntMap Group) -> IntMap Group)
-> Maybe (IntMap Group) -> IntMap Group
forall a b. (a -> b) -> a -> b
$ -- in case of no target or dead group, no change
  do Int
defid <- Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
atkid IntMap Int
targets
     Group
atk   <- Int -> IntMap Group -> Maybe Group
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
atkid IntMap Group
groups
     Group
def   <- Int -> IntMap Group -> Maybe Group
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
defid IntMap Group
groups
     let dmg :: Int
dmg    = Group -> Group -> Int
effectiveness Group
atk Group
def Int -> Int -> Int
forall a. Num a => a -> a -> a
* Group -> Int
effectivePower Group
atk
         killed :: Int
killed = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Group -> Int
size Group
def) (Int
dmg Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Group -> Int
hp Group
def)
         size' :: Int
size'  = Group -> Int
size Group
def Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
killed
         groups' :: IntMap Group
groups'
           | Int
size' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Group -> IntMap Group -> IntMap Group
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
defid Group
def { size = size' } IntMap Group
groups
           | Bool
otherwise = Int -> IntMap Group -> IntMap Group
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
defid IntMap Group
groups
     IntMap Group -> Maybe (IntMap Group)
forall a. a -> Maybe a
Just IntMap Group
groups'

-- foldable utility function -------------------------------------------

-- | Returns the element that maximizes the result of a key function
-- applied to the elements. See also: 'sortOn'
maximumOn :: (Foldable t, Ord b) => (a -> b) -> t a -> Maybe a
maximumOn :: forall (t :: * -> *) b a.
(Foldable t, Ord b) =>
(a -> b) -> t a -> Maybe a
maximumOn a -> b
prj t a
xs
  | t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs   = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! (a -> a -> Ordering) -> t a -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((a -> b) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
prj) t a
xs