diff --git a/Contests/GhostInTheCell/GhostInTheCell.hs b/Contests/GhostInTheCell/GhostInTheCell.hs index 2201edb..0524fcf 100644 --- a/Contests/GhostInTheCell/GhostInTheCell.hs +++ b/Contests/GhostInTheCell/GhostInTheCell.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns, LambdaCase, RankNTypes #-} + +module Main (main) where import System.IO import Control.Applicative @@ -8,6 +10,7 @@ import Control.Monad.Writer import Data.Either import Data.Foldable import Data.Function +import Data.Functor.Identity import Data.IORef import Data.List import Data.Maybe @@ -15,15 +18,16 @@ import Data.Monoid import qualified Data.Map as M -type EntityId = Int -type PlayerId = Int -type FactoryId = Int +type EntityId = Int +type FactoryId = Int + +data PlayerId = ThisPlayer | Neutral | Opponent deriving (Eq, Ord, Show) data Factory = Factory { factoryId :: EntityId , factoryOwner :: PlayerId , factoryCyborgs :: Int , factoryProduction :: Int - , factoryDelay :: Int + , factoryTurnsLeft :: Int } deriving (Eq, Show) data Troop = Troop { troopId :: EntityId @@ -47,54 +51,17 @@ data Action = Move FactoryId FactoryId Int | Wait deriving (Eq, Show) -class HasEntityId a where entityId :: a -> EntityId -instance HasEntityId Factory where entityId = factoryId -instance HasEntityId Troop where entityId = troopId -instance HasEntityId Bomb where entityId = bombId - -class HasOwner a where owner :: a -> PlayerId -instance HasOwner Factory where owner = factoryOwner -instance HasOwner Troop where owner = troopOwner -instance HasOwner Bomb where owner = bombOwner - -class HasCyborgs a where cyborgs :: a -> Int -instance HasCyborgs Factory where cyborgs = factoryCyborgs -instance HasCyborgs Troop where cyborgs = troopCyborgs - -class HasOrigin a where origin :: a -> FactoryId -instance HasOrigin Troop where origin = troopOrigin -instance HasOrigin Bomb where origin = bombOrigin - -class HasTarget a where target :: a -> FactoryId -instance HasTarget Troop where target = troopTarget -instance HasTarget Bomb where target = bombTarget - -class HasTurnsLeft a where turnsLeft :: a -> Int -instance HasTurnsLeft Troop where turnsLeft = troopTurnsLeft -instance HasTurnsLeft Bomb where turnsLeft = bombTurnsLeft - data GameState = GameState { gsLinks :: M.Map (FactoryId, FactoryId) Int , gsFactories :: [Factory] , gsTroops :: [Troop] , gsBombs :: [Bomb] - , gsBombsLeft :: Int + , gsBombsLeft :: M.Map PlayerId Int , gsNextEntity :: EntityId , gsTurnCount :: Int } deriving (Show) -actionString :: Action -> String -actionString (Move src dst cnt) = unwords ["MOVE", show src, show dst, show cnt] -actionString (SendBomb src dst) = unwords ["BOMB", show src, show dst] -actionString (Increase fid) = unwords ["INC", show fid] -actionString Wait = "WAIT" - -thisPlayer, neutralPlayer, opponent :: PlayerId -thisPlayer = 1 -neutralPlayer = 0 -opponent = -1 - main :: IO () main = do hSetBuffering stdout NoBuffering -- DO NOT REMOVE @@ -107,114 +74,141 @@ main = do pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)]) turnCountRef <- newIORef 1 - bombsLeftRef <- newIORef 2 + bombsLeftRef <- newIORef $ M.fromList [(ThisPlayer, 2), (Opponent, 2)] forever $ do entityCount <- readLn :: IO Int - (partitionEithers -> (factoryList, partitionEithers -> (troopList, bombList))) <- replicateM entityCount $ do - ((read -> entityId):entityType:(map read -> [a1,a2,a3,a4,a5])) <- words <$> getLine - pure $ case entityType of - "FACTORY" -> Left $ Factory entityId a1 a2 a3 a4 - "TROOP" -> Right . Left $ Troop entityId a1 a2 a3 a4 a5 - "BOMB" -> Right . Right $ Bomb entityId a1 a2 a3 a4 + (second partitionEithers . partitionEithers -> + (factoryList, (troopList, bombList))) <- replicateM entityCount $ do + ((read -> eId):eType:(parsePlayerId . read -> a1) + :(map read -> [a2,a3,a4,a5])) <- words <$> getLine + pure $ case eType of + "FACTORY" -> Left $ Factory eId a1 a2 a3 a4 + "TROOP" -> Right . Left $ Troop eId a1 a2 a3 a4 a5 + "BOMB" -> Right . Right $ Bomb eId a1 a2 a3 a4 - let nextEntity = (+1) $ maximum $ 0 : map entityId factoryList - ++ map entityId troopList - ++ map entityId bombList + let nextEntity = (+1) $ maximum $ 0 : map (view entityId) factoryList + ++ map (view entityId) troopList + ++ map (view entityId) bombList turnCount <- readIORef turnCountRef bombsLeft <- readIORef bombsLeftRef - let chosenActions = chooseActions $ - GameState { gsLinks = links - , gsFactories = factoryList - , gsTroops = troopList - , gsBombs = bombList - , gsNextEntity = nextEntity - , gsTurnCount = turnCount - , gsBombsLeft = bombsLeft - } + let gs = GameState { gsLinks = links + , gsFactories = factoryList + , gsTroops = troopList + , gsBombs = bombList + , gsNextEntity = nextEntity + , gsTurnCount = turnCount + , gsBombsLeft = bombsLeft + } + + let oppActions = [] -- chooseActions (flipSides gs) [] + let chosenActions = chooseActions gs [(Opponent, oppActions)] case chosenActions of [] -> putStrLn $ actionString Wait xs -> putStrLn $ intercalate "; " $ map actionString xs - let isSendBomb act = case act of { SendBomb _ _ -> True; _ -> False } - modifyIORef bombsLeftRef (subtract $ length $ filter isSendBomb chosenActions) + forM_ chosenActions $ \case + SendBomb _ _ -> modifyIORef bombsLeftRef (M.update (Just . max 0 . subtract 1) ThisPlayer) + _ -> pure () + modifyIORef turnCountRef (+1) awareness, foresight :: Int awareness = 10 -- number of actions to consider -foresight = 30 -- number of moves to look ahead +foresight = 20 -- number of moves to look ahead (>10) -chooseActions :: GameState -> [Action] -chooseActions gs = loop [] (scoreGame (simulate [] foresight gs)) (allFactoryActions ++ bombActions) +scoreGame :: GameState -> Double +scoreGame gs = (playerScore ThisPlayer :: Double) + / (playerScore Opponent + 100) + where + playerScore p = fromIntegral + $ 1 * numCyborgs + + 15 * produced + + 50 * factories + + 60 * bombsLeft + where + numCyborgs = sum [ f^.cyborgs | f <- gsFactories gs, ownedBy p f ] + + sum [ (30 * t^.cyborgs) `div` (30 + t^.turnsLeft) + | t <- gsTroops gs, ownedBy p t ] + produced = sum [ f^.production | f <- gsFactories gs, ownedBy p f, f^.turnsLeft == 0 ] + factories = count (ownedBy p) (gsFactories gs) + bombsLeft = fromMaybe 0 $ M.lookup p (gsBombsLeft gs) + +chooseActions :: GameState -> [(PlayerId, [Action])] -> [Action] +chooseActions gs acts = loop [] (scoreGame (simulate acts foresight gs)) (allFactoryActions ++ bombActions) where - scoreActions as = scoreGame $ simulate [(thisPlayer, as)] foresight gs loop cs sc as = case best awareness $ map (\a -> (scoreActions (cs ++ [a]), a)) as of (sc',a):rs | sc' > sc -> loop (cs ++ [a]) sc' (map snd rs) _ -> cs - myFactories = filter (\f -> owner f == thisPlayer) (gsFactories gs) + scoreActions as = 3 * scoreGame (simulate (acts++[(ThisPlayer, as)]) 5 gs) + + 2 * scoreGame (simulate (acts++[(ThisPlayer, as)]) 10 gs) + + 1 * scoreGame (simulate (acts++[(ThisPlayer, as)]) foresight gs) - transitMap = M.fromList - [ (to, (mine, theirs)) - | let (myTroops, theirTroops) = partition (\t -> owner t == thisPlayer) (gsTroops gs) - , to <- map entityId (gsFactories gs) - , let mine = sum [ cyborgs t | t <- myTroops, target t == to ] - , let theirs = sum [ cyborgs t | t <- theirTroops, target t == to ] - ] + myFactories = filter (ownedBy ThisPlayer) (gsFactories gs) + + transitMap = M.fromList $ do + to <- map (view entityId) (gsFactories gs) + let troops = filter ((== to) . view target) (gsTroops gs) + let (myTroops, theirTroops) = partition (ownedBy ThisPlayer) troops + let mine = sum $ map (view cyborgs) myTroops + let theirs = sum $ map (view cyborgs) theirTroops + pure (to, (mine, theirs)) inTransitTo dst = fromMaybe (0, 0) $ M.lookup dst transitMap distributeScores src = do dst <- myFactories - guard $ entityId dst /= entityId src - let (srcDefending, srcAttacking) = inTransitTo (entityId src) - let (dstDefending, dstAttacking) = inTransitTo (entityId dst) - let srcTotal = cyborgs src - srcAttacking - let dstTotal = cyborgs dst + dstDefending - dstAttacking - let amount = (cyborgs src + 1) `div` 3 - guard $ amount > 0 && amount <= cyborgs src - dist <- toList $ M.lookup (entityId src, entityId dst) (gsLinks gs) - pure $ Move (entityId src) (entityId dst) amount + guard $ dst^.entityId /= src^.entityId + let amount' = src^.cyborgs + amount <- nub [amount', amount' `div` 3, src^.production] + guard $ amount > 0 && amount <= src^.cyborgs + dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs) + pure $ Move (src^.entityId) (dst^.entityId) amount attackScores src = do - dst <- filter (\f -> owner f /= thisPlayer) (gsFactories gs) - dist <- toList $ M.lookup (entityId src, entityId dst) (gsLinks gs) - let (mineDefending, theirsAttacking) = inTransitTo (entityId src) - let (mineAttacking, theirsDefending) = inTransitTo (entityId dst) - let myTotal = cyborgs src - theirsAttacking - let theirTotal = cyborgs dst + theirsDefending - mineAttacking + dst <- filter (not . ownedBy ThisPlayer) (gsFactories gs) + dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs) + let (mineDefending, theirsAttacking) = inTransitTo (src^.entityId) + let (mineAttacking, theirsDefending) = inTransitTo (dst^.entityId) + let myTotal = src^.cyborgs - theirsAttacking + let theirTotal = dst^.cyborgs + theirsDefending - mineAttacking let theirEstimate - | owner dst == neutralPlayer = theirTotal - | otherwise = theirTotal + factoryProduction dst * (1 + dist) - let amount = theirEstimate + 1 - guard $ amount > 0 && amount <= cyborgs src - pure $ Move (entityId src) (entityId dst) amount + | ownedBy Neutral dst = theirTotal + | otherwise = theirTotal + dst^.production * (1 + dist) + let amount' = theirEstimate + 1 + amount <- nub [2 * amount', amount', amount' `div` 2, src^.production] + guard $ amount > 0 && amount <= src^.cyborgs + pure $ Move (src^.entityId) (dst^.entityId) amount increaseScores src = do - guard $ factoryProduction src < 3 - guard $ cyborgs src >= 10 - pure $ Increase (entityId src) + guard $ src^.production < 3 + guard $ src^.cyborgs >= 10 + pure $ Increase (src^.entityId) - factoryActions src = foldr mplus mempty $ map ($ src) $ - [ distributeScores, attackScores, increaseScores ] + factoryActions src = concatMap ($ src) [ distributeScores + , attackScores + , increaseScores + ] allFactoryActions = concatMap factoryActions myFactories bombActions = do - guard $ (gsBombsLeft gs) > 0 && not (null myFactories) - guard $ (gsBombsLeft gs) > 1 || (gsTurnCount gs) > 50 - dst <- filter (\f -> owner f == opponent) (gsFactories gs) - --guard $ cyborgs dst >= 50 + 50 * (2 - (gsBombsLeft gs)) - let src = snd $ minimumBy (compare `on` fst) $ - [ (dist, s) | s <- myFactories - , dist <- toList $ M.lookup (entityId s, entityId dst) (gsLinks gs) - ] - pure $ SendBomb (entityId src) (entityId dst) + guard $ fromMaybe 0 (M.lookup ThisPlayer $ gsBombsLeft gs) > 0 + dst <- gsFactories gs + src <- toList $ fmap snd $ safeMinimumBy (compare `on` fst) $ do + src' <- myFactories + guard $ src'^.entityId /= dst^.entityId + dist <- toList $ M.lookup (src'^.entityId, dst^.entityId) (gsLinks gs) + pure (dist, src') + pure $ SendBomb (src^.entityId) (dst^.entityId) -best :: Ord a => Int -> [(a, b)] -> [(a, b)] -best n = take n . sortBy (flip compare `on` fst) +simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState +simulate orders n gs + | n > 0 = simulate [] (n-1) (gameTurn orders gs) + | otherwise = gs gameTurn :: [(PlayerId, [Action])] -> GameState -> GameState gameTurn orders = moveTroops @@ -224,106 +218,179 @@ gameTurn orders = moveTroops >>> solveBattles >>> explodeBombs -simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState -simulate orders n gs - | n > 0 = simulate [] (n-1) (gameTurn orders gs) - | otherwise = gs - -scoreGame :: GameState -> Double -scoreGame gs = (fromIntegral myCyborgs + 10 * fromIntegral myProduction + 10 * fromIntegral myFactories) - / (fromIntegral oppCyborgs + 10 * fromIntegral oppProduction + 10 * fromIntegral oppFactories + 1) - where - myFactories = length $ filter (\f -> owner f == thisPlayer) (gsFactories gs) - oppFactories = length $ filter (\f -> owner f == opponent) (gsFactories gs) - ((Sum myCyborgs, Sum myProduction), (Sum oppCyborgs, Sum oppProduction)) = execWriter $ do - forM_ (gsFactories gs) $ \f -> do - when (owner f == thisPlayer) $ tell ((Sum (cyborgs f), Sum (factoryProduction f)), mempty) - when (owner f == opponent) $ tell (mempty, (Sum (cyborgs f), Sum (factoryProduction f))) - forM_ (gsTroops gs) $ \t -> do - when (owner t == thisPlayer) $ tell ((Sum (cyborgs t), mempty), mempty) - when (owner t == opponent) $ tell (mempty, (Sum (cyborgs t), mempty)) - -moveTroops, moveBombs, produceCyborgs, - solveBattles, explodeBombs :: GameState -> GameState - -moveTroops gs0 = gs0 { gsTroops = map (\t -> t { troopTurnsLeft = turnsLeft t - 1 }) (gsTroops gs0) } -moveBombs gs0 = gs0 { gsBombs = map (\b -> b { bombTurnsLeft = turnsLeft b - 1 }) (gsBombs gs0) } +moveTroops, moveBombs :: GameState -> GameState +moveTroops gs0 = gs0 { gsTroops = map (over turnsLeft (subtract 1)) (gsTroops gs0) } +moveBombs gs0 = gs0 { gsBombs = map (over turnsLeft (subtract 1)) (gsBombs gs0) } processOrders :: [(PlayerId, [Action])] -> GameState -> GameState processOrders orders gs0 = foldl processOrder gs0 orders where processOrder gs (p, as) = foldl (processAction p) gs as - processAction p gs a = checkBalances $ case a of + processAction p gs = \case Move from to amt -> processMove p from to amt gs SendBomb from to -> processBomb p from to gs Increase factory -> processIncrease p factory gs Wait -> gs - processMove p from to amt gs = - gs { gsFactories = map (\f -> if entityId f /= from then f - else f { factoryCyborgs = max 0 (cyborgs f - amt) }) - (gsFactories gs) - , gsTroops = gsTroops gs ++ - [Troop { troopId = gsNextEntity gs - , troopOwner = p - , troopOrigin = from - , troopTarget = to - , troopCyborgs = min amt (sum $ map (\f -> if entityId f == from then cyborgs f else 0) (gsFactories gs)) - , troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs) - }] - , gsNextEntity = gsNextEntity gs + 1 - } - processBomb p from to gs = - gs { gsBombs = gsBombs gs ++ - [Bomb { bombId = gsNextEntity gs - , bombOwner = p - , bombOrigin = from - , bombTarget = to - , bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs) - }] - , gsNextEntity = gsNextEntity gs + 1 - } + processMove p from to amt gs + | f:_ <- filter ((== from) . view entityId) (gsFactories gs) + , ownedBy p f + , adjAmt <- min (f^.cyborgs) amt + = gs { gsFactories = map (\f -> if f^.entityId /= from then f else + over cyborgs (subtract adjAmt) f) + (gsFactories gs) + , gsTroops = gsTroops gs ++ + [Troop { troopId = gsNextEntity gs + , troopOwner = p + , troopOrigin = from + , troopTarget = to + , troopCyborgs = adjAmt + , troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs) + }] + , gsNextEntity = gsNextEntity gs + 1 + } + | otherwise = gs + processBomb p from to gs + | fromMaybe 0 (M.lookup p (gsBombsLeft gs)) > 0 + = gs { gsBombs = gsBombs gs ++ + [Bomb { bombId = gsNextEntity gs + , bombOwner = p + , bombOrigin = from + , bombTarget = to + , bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs) + }] + , gsBombsLeft = M.update (Just . subtract 1) p $ gsBombsLeft gs + , gsNextEntity = gsNextEntity gs + 1 + } + | otherwise = gs processIncrease p factory gs = - gs { gsFactories = map (\f -> if entityId f /= factory || cyborgs f < 10 then f else - f { factoryCyborgs = cyborgs f - 10 - , factoryProduction = min 3 (factoryProduction f + 1) - }) + gs { gsFactories = map (\f -> if f^.entityId /= factory || f^.cyborgs < 10 then f else + f & over cyborgs (subtract 10) + & over production (min 3 . (+1))) (gsFactories gs) } - checkBalances gs - | all (\f -> cyborgs f >= 0) (gsFactories gs) = gs - | otherwise = error "Cyborg count is negative!" + +produceCyborgs :: GameState -> GameState produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) } where produce f - | factoryDelay f > 0 = f { factoryDelay = factoryDelay f - 1 } - | otherwise = f { factoryCyborgs = cyborgs f + factoryProduction f } + | f^.turnsLeft > 0 = over turnsLeft (subtract 1) f + | otherwise = over cyborgs (+ f^.production) f +solveBattles :: GameState -> GameState solveBattles gs = gs { gsFactories = map solveFactory (gsFactories gs) , gsTroops = troopsInTransit } where - (troopsArriving, troopsInTransit) = partition (\t -> turnsLeft t <= 0) (gsTroops gs) + (troopsArriving, troopsInTransit) = partition ((<= 0) . view turnsLeft) (gsTroops gs) solveFactory f - | attacking > defending = f { factoryOwner = attackingPlayer - , factoryCyborgs = attacking - defending - } - | otherwise = f { factoryCyborgs = defending - attacking } + | attacking > defending = f & set owner attackingPlayer + & set cyborgs (attacking - defending) + | otherwise = f & set cyborgs (defending - attacking) where - troopsArrivingHere = filter (\t -> target t == entityId f) troopsArriving - defending = cyborgs f + sum [ cyborgs t | t <- troopsArrivingHere, owner t == owner f ] - attacking = sum [ cyborgs t | t <- troopsArrivingHere, owner t /= owner f ] - attackingPlayer = if owner f == opponent then thisPlayer else opponent + troopsArrivingHere = filter (\t -> t^.target == f^.entityId) troopsArriving + (defendingHere, attackingHere) = partition (ownedBy (f^.owner)) troopsArrivingHere + defending = sum (map (view cyborgs) defendingHere) + f^.cyborgs + attacking = sum (map (view cyborgs) attackingHere) + attackingPlayer = otherPlayer (f^.owner) +explodeBombs :: GameState -> GameState explodeBombs gs = gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived , gsBombs = bombsInTransit } where - (bombsArrived, bombsInTransit) = partition (\b -> turnsLeft b <= 0) (gsBombs gs) + (bombsArrived, bombsInTransit) = partition (\b -> b^.turnsLeft <= 0) (gsBombs gs) explodeBomb fs b = flip map fs $ \f -> - if entityId f /= target b then f else - f { factoryCyborgs = max 0 (cyborgs f - max 10 (cyborgs f `div` 2)) - , factoryDelay = 5 - } + if f^.entityId /= b^.target then f else + f & set cyborgs (max 0 (f^.cyborgs - max 10 (f^.cyborgs `div` 2))) + & set turnsLeft 5 + +safeMinimumBy :: (a -> a -> Ordering) -> [a] -> Maybe a +safeMinimumBy _ [] = Nothing +safeMinimumBy cmp xs = Just (minimumBy cmp xs) + +safeMaximumBy :: (a -> a -> Ordering) -> [a] -> Maybe a +safeMaximumBy _ [] = Nothing +safeMaximumBy cmp xs = Just (maximumBy cmp xs) + +count :: (a -> Bool) -> [a] -> Int +count p = length . filter p + +best :: Ord a => Int -> [(a, b)] -> [(a, b)] +best n = take n . sortBy (flip compare `on` fst) + +type Getting r s a = (a -> Const r a) -> s -> Const r s +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t +type Lens' s a = Lens s s a a + +view :: Getting a s a -> s -> a +view g = getConst . g Const + +over :: Lens s t a b -> (a -> b) -> s -> t +over l f = runIdentity . l (Identity . f) + +set :: Lens s t a b -> b -> s -> t +set l = over l . const + +(^.) :: s -> Getting a s a -> a +(^.) = flip view +infixl 8 ^. + +class HasEntityId a where entityId :: Lens' a EntityId +instance HasEntityId Factory where entityId f s = (\b -> s { factoryId = b }) <$> f (factoryId s) +instance HasEntityId Troop where entityId f s = (\b -> s { troopId = b }) <$> f (troopId s) +instance HasEntityId Bomb where entityId f s = (\b -> s { bombId = b }) <$> f (bombId s) + +class HasOwner a where owner :: Lens' a PlayerId +instance HasOwner Factory where owner f s = (\b -> s { factoryOwner = b }) <$> f (factoryOwner s) +instance HasOwner Troop where owner f s = (\b -> s { troopOwner = b }) <$> f (troopOwner s) +instance HasOwner Bomb where owner f s = (\b -> s { bombOwner = b }) <$> f (bombOwner s) + +class HasCyborgs a where cyborgs :: Lens' a Int +instance HasCyborgs Factory where cyborgs f s = (\b -> s { factoryCyborgs = b }) <$> f (factoryCyborgs s) +instance HasCyborgs Troop where cyborgs f s = (\b -> s { troopCyborgs = b }) <$> f (troopCyborgs s) + +class HasTarget a where target :: Lens' a FactoryId +instance HasTarget Troop where target f s = (\b -> s { troopTarget = b }) <$> f (troopTarget s) +instance HasTarget Bomb where target f s = (\b -> s { bombTarget = b }) <$> f (bombTarget s) + +class HasTurnsLeft a where turnsLeft :: Lens' a Int +instance HasTurnsLeft Factory where turnsLeft f s = (\b -> s { factoryTurnsLeft = b }) <$> f (factoryTurnsLeft s) +instance HasTurnsLeft Troop where turnsLeft f s = (\b -> s { troopTurnsLeft = b }) <$> f (troopTurnsLeft s) +instance HasTurnsLeft Bomb where turnsLeft f s = (\b -> s { bombTurnsLeft = b }) <$> f (bombTurnsLeft s) + +production :: Lens' Factory Int +production f s = (\b -> s { factoryProduction = b }) <$> f (factoryProduction s) + +flipSides :: GameState -> GameState +flipSides gs = + gs { gsFactories = map flipOwner (gsFactories gs) + , gsTroops = map flipOwner (gsTroops gs) + , gsBombs = map flipOwner (gsBombs gs) + , gsBombsLeft = M.mapKeys otherPlayer (gsBombsLeft gs) + } + where + flipOwner :: HasOwner a => a -> a + flipOwner = over owner otherPlayer + +otherPlayer :: PlayerId -> PlayerId +otherPlayer = \case + ThisPlayer -> Opponent + Neutral -> Neutral + Opponent -> ThisPlayer + +ownedBy :: HasOwner a => PlayerId -> a -> Bool +ownedBy p a = a^.owner == p + +parsePlayerId :: Int -> PlayerId +parsePlayerId 1 = ThisPlayer +parsePlayerId 0 = Neutral +parsePlayerId (-1) = Opponent + +actionString :: Action -> String +actionString (Move src dst cnt) = unwords ["MOVE", show src, show dst, show cnt] +actionString (SendBomb src dst) = unwords ["BOMB", show src, show dst] +actionString (Increase fid) = unwords ["INC", show fid] +actionString Wait = "WAIT"