From 81231223fa3bba71a180815fee90f472298e9e09 Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sun, 5 Mar 2017 12:59:41 -0600 Subject: [PATCH] Ghost in the Cell -- final version. --- Contests/GhostInTheCell/GhostInTheCell.hs | 347 ++++++++++++---------- 1 file changed, 196 insertions(+), 151 deletions(-) diff --git a/Contests/GhostInTheCell/GhostInTheCell.hs b/Contests/GhostInTheCell/GhostInTheCell.hs index 0524fcf..de3e5ef 100644 --- a/Contests/GhostInTheCell/GhostInTheCell.hs +++ b/Contests/GhostInTheCell/GhostInTheCell.hs @@ -2,7 +2,6 @@ module Main (main) where -import System.IO import Control.Applicative import Control.Arrow (first, second, (>>>)) import Control.Monad @@ -15,22 +14,26 @@ import Data.IORef import Data.List import Data.Maybe import Data.Monoid +import System.CPUTime +import System.IO import qualified Data.Map as M type EntityId = Int -type FactoryId = Int +type FactoryId = EntityId +type TroopId = EntityId +type BombId = EntityId data PlayerId = ThisPlayer | Neutral | Opponent deriving (Eq, Ord, Show) -data Factory = Factory { factoryId :: EntityId +data Factory = Factory { factoryId :: FactoryId , factoryOwner :: PlayerId , factoryCyborgs :: Int , factoryProduction :: Int , factoryTurnsLeft :: Int } deriving (Eq, Show) -data Troop = Troop { troopId :: EntityId +data Troop = Troop { troopId :: TroopId , troopOwner :: PlayerId , troopOrigin :: FactoryId , troopTarget :: FactoryId @@ -38,7 +41,7 @@ data Troop = Troop { troopId :: EntityId , troopTurnsLeft :: Int } deriving (Eq, Show) -data Bomb = Bomb { bombId :: EntityId +data Bomb = Bomb { bombId :: BombId , bombOwner :: PlayerId , bombOrigin :: FactoryId , bombTarget :: FactoryId @@ -53,133 +56,139 @@ data Action = Move FactoryId FactoryId Int data GameState = GameState - { gsLinks :: M.Map (FactoryId, FactoryId) Int - , gsFactories :: [Factory] - , gsTroops :: [Troop] - , gsBombs :: [Bomb] - , gsBombsLeft :: M.Map PlayerId Int - , gsNextEntity :: EntityId - , gsTurnCount :: Int + { _gsLinks :: M.Map (FactoryId, FactoryId) Int + , _gsFactories :: M.Map FactoryId Factory + , _gsTroops :: M.Map TroopId Troop + , _gsBombs :: M.Map BombId Bomb + , _gsBombsLeft :: M.Map PlayerId Int + , _gsNextEntity :: EntityId + , _gsTurnCount :: Int } deriving (Show) main :: IO () +--main = withFile "input.txt" ReadMode $ \input -> do main = do + let input = stdin hSetBuffering stdout NoBuffering -- DO NOT REMOVE - factoryCount <- readLn :: IO Int -- the number of factories (not used) - linkCount <- readLn :: IO Int -- the number of links between factories + factoryCount <- read <$> hGetLine input :: IO Int -- the number of factories (not used) + linkCount <- read <$> hGetLine input :: IO Int -- the number of links between factories links <- fmap (M.fromList . concat) $ replicateM linkCount $ do - [f1, f2, dist] <- map read . words <$> getLine + [f1, f2, dist] <- map read . words <$> hGetLine input pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)]) turnCountRef <- newIORef 1 bombsLeftRef <- newIORef $ M.fromList [(ThisPlayer, 2), (Opponent, 2)] forever $ do - entityCount <- readLn :: IO Int + entityCount <- read <$> hGetLine input :: IO Int + startTime <- getCPUTime + (second partitionEithers . partitionEithers -> (factoryList, (troopList, bombList))) <- replicateM entityCount $ do ((read -> eId):eType:(parsePlayerId . read -> a1) - :(map read -> [a2,a3,a4,a5])) <- words <$> getLine + :(map read -> [a2,a3,a4,a5])) <- words <$> hGetLine input 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 (view entityId) factoryList - ++ map (view entityId) troopList - ++ map (view entityId) bombList - turnCount <- readIORef turnCountRef bombsLeft <- readIORef bombsLeftRef - let gs = GameState { gsLinks = links - , gsFactories = factoryList - , gsTroops = troopList - , gsBombs = bombList - , gsNextEntity = nextEntity - , gsTurnCount = turnCount - , gsBombsLeft = bombsLeft + let gs = GameState { _gsLinks = links + , _gsFactories = M.fromList [ (f^.entityId, f) | f <- factoryList ] + , _gsTroops = M.fromList [ (t^.entityId, t) | t <- troopList ] + , _gsBombs = M.fromList [ (b^.entityId, b) | b <- bombList ] + , _gsNextEntity = fromMaybe 0 . fmap (+1) . safeMaximumBy compare + $ M.keys (gs^.gsFactories) + ++ M.keys (gs^.gsTroops) + ++ M.keys (gs^.gsBombs) + , _gsTurnCount = turnCount + , _gsBombsLeft = bombsLeft } let oppActions = [] -- chooseActions (flipSides gs) [] - let chosenActions = chooseActions gs [(Opponent, oppActions)] + let chosenActions = chooseActions gs [(Opponent, oppActions)] 15 22 case chosenActions of [] -> putStrLn $ actionString Wait xs -> putStrLn $ intercalate "; " $ map actionString xs + stopTime <- getCPUTime + + hPutStrLn stderr . show . floor $ fromIntegral (stopTime - startTime) / 1e9 + forM_ chosenActions $ \case - SendBomb _ _ -> modifyIORef bombsLeftRef (M.update (Just . max 0 . subtract 1) ThisPlayer) + SendBomb _ _ -> modifyIORef bombsLeftRef $ + atKey ThisPlayer . _Just %~ max 0 . subtract 1 _ -> pure () modifyIORef turnCountRef (+1) -awareness, foresight :: Int -awareness = 10 -- number of actions to consider -foresight = 20 -- number of moves to look ahead (>10) - scoreGame :: GameState -> Double -scoreGame gs = (playerScore ThisPlayer :: Double) - / (playerScore Opponent + 100) +scoreGame gs = (playerScore ThisPlayer) - (1.25 * playerScore Opponent) where - playerScore p = fromIntegral - $ 1 * numCyborgs - + 15 * produced - + 50 * factories - + 60 * bombsLeft + playerScore p = 1 * numCyborgs + + 50 * produced + + 25 * upgradable + + 10 * factories + + 50 * 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) + numCyborgs = sum [ fromIntegral (f^.cyborgs) | f <- M.elems (gs^.gsFactories), ownedBy p f ] + + sum [ fromIntegral (t^.cyborgs) * (180.0 / (180.0 + fromIntegral (t^.turnsLeft))) | t <- M.elems (gs^.gsTroops), ownedBy p t ] + produced = sum [ fromIntegral (f^.production) | f <- M.elems (gs^.gsFactories), ownedBy p f, f^.turnsLeft == 0 ] + upgradable = fromIntegral . count (\f -> ownedBy p f && f^.production < 3 && f^.cyborgs >= 10) $ gs^.gsFactories + factories = fromIntegral . count (ownedBy p) $ gs^.gsFactories + bombsLeft = fromIntegral . fromMaybe 0 . M.lookup p $ gs^.gsBombsLeft -chooseActions :: GameState -> [(PlayerId, [Action])] -> [Action] -chooseActions gs acts = loop [] (scoreGame (simulate acts foresight gs)) (allFactoryActions ++ bombActions) +chooseActions :: GameState -> [(PlayerId, [Action])] -> Int -> Int -> [Action] +chooseActions gs acts awareness foresight = + loop [] (scoreActions []) (allFactoryActions ++ bombActions) where 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 - 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) + scoreActions as = sum $ + zipWith (\n gs' -> (fromIntegral n)**(0.5) * scoreGame gs') + [1..foresight] + (simulate (acts ++ [(ThisPlayer, as)]) gs) - myFactories = filter (ownedBy ThisPlayer) (gsFactories gs) + myFactories = M.filter (ownedBy ThisPlayer) (gs^.gsFactories) 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)) + tgt <- M.keys (gs^.gsFactories) + let (Sum mine, Sum theirs) = flip foldMap (gs^.gsTroops) $ \t -> + if t^.target /= tgt then mempty else + if t^.owner == ThisPlayer + then (Sum (t^.cyborgs), mempty) + else (mempty, Sum (t^.cyborgs)) + pure (tgt, (mine, theirs)) inTransitTo dst = fromMaybe (0, 0) $ M.lookup dst transitMap distributeScores src = do - dst <- myFactories + guard $ src^.cyborgs > 0 + dst <- M.elems myFactories guard $ dst^.entityId /= src^.entityId - let amount' = src^.cyborgs - amount <- nub [amount', amount' `div` 3, src^.production] + let supply = src^.cyborgs + amount <- nub [supply, 2 * supply `div` 3, supply `div` 2, supply `div` 3, src^.production] guard $ amount > 0 && amount <= src^.cyborgs - dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs) + dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gs^.gsLinks) pure $ Move (src^.entityId) (dst^.entityId) amount attackScores src = do - dst <- filter (not . ownedBy ThisPlayer) (gsFactories gs) - dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs) - let (mineDefending, theirsAttacking) = inTransitTo (src^.entityId) + guard $ src^.cyborgs > 0 + dst <- M.elems $ gs^.gsFactories + guard . not . ownedBy ThisPlayer $ dst + dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gs^.gsLinks) let (mineAttacking, theirsDefending) = inTransitTo (dst^.entityId) - let myTotal = src^.cyborgs - theirsAttacking let theirTotal = dst^.cyborgs + theirsDefending - mineAttacking let theirEstimate | ownedBy Neutral dst = theirTotal | otherwise = theirTotal + dst^.production * (1 + dist) - let amount' = theirEstimate + 1 - amount <- nub [2 * amount', amount', amount' `div` 2, src^.production] + amount <- nub [src^.cyborgs, theirEstimate + 10, theirEstimate + 1, src^.production] guard $ amount > 0 && amount <= src^.cyborgs pure $ Move (src^.entityId) (dst^.entityId) amount @@ -193,22 +202,20 @@ chooseActions gs acts = loop [] (scoreGame (simulate acts foresight gs)) (allFac , increaseScores ] - allFactoryActions = concatMap factoryActions myFactories + allFactoryActions = concatMap factoryActions (M.elems myFactories) bombActions = do - 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) + guard $ fromMaybe 0 (M.lookup ThisPlayer $ gs^.gsBombsLeft) > 0 + tgt <- M.keys $ gs^.gsFactories + org <- toList . fmap snd . safeMinimumBy (compare `on` fst) $ do + org' <- M.keys myFactories + guard $ org' /= tgt + dist <- toList . M.lookup (org', tgt) $ gs^.gsLinks + pure (dist, org') + pure $ SendBomb org tgt -simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState -simulate orders n gs - | n > 0 = simulate [] (n-1) (gameTurn orders gs) - | otherwise = gs +simulate :: [(PlayerId, [Action])] -> GameState -> [GameState] +simulate orders gs = iterate (gameTurn []) (gameTurn orders gs) gameTurn :: [(PlayerId, [Action])] -> GameState -> GameState gameTurn orders = moveTroops @@ -219,93 +226,96 @@ gameTurn orders = moveTroops >>> explodeBombs 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) } +moveTroops = gsTroops . traverse . turnsLeft %~ subtract 1 +moveBombs = gsBombs . traverse . turnsLeft %~ subtract 1 processOrders :: [(PlayerId, [Action])] -> GameState -> GameState -processOrders orders gs0 = foldl processOrder gs0 orders +processOrders = flip (foldl processOrder) where processOrder gs (p, as) = foldl (processAction p) gs as processAction p gs = \case - Move from to amt -> processMove p from to amt gs - SendBomb from to -> processBomb p from to gs + Move org tgt amt -> processMove p org tgt amt gs + SendBomb org tgt -> processBomb p org tgt gs Increase factory -> processIncrease p factory gs Wait -> gs - processMove p from to amt gs - | f:_ <- filter ((== from) . view entityId) (gsFactories gs) + processMove p org tgt amt gs + | Just f <- M.lookup org (gs^.gsFactories) , 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 + , adjAmt > 0 + , Just dist <- M.lookup (org, tgt) (gs^.gsLinks) + = gs & gsFactories . atKey org . _Just . cyborgs %~ subtract adjAmt + & gsTroops %~ M.insert (gs^.gsNextEntity) + (Troop { troopId = gs^.gsNextEntity , troopOwner = p - , troopOrigin = from - , troopTarget = to + , troopOrigin = org + , troopTarget = tgt , troopCyborgs = adjAmt - , troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs) - }] - , gsNextEntity = gsNextEntity gs + 1 - } + , troopTurnsLeft = dist + }) + & gsNextEntity %~ (+1) | otherwise = gs processBomb p from to gs - | fromMaybe 0 (M.lookup p (gsBombsLeft gs)) > 0 - = gs { gsBombs = gsBombs gs ++ - [Bomb { bombId = gsNextEntity gs + | fromMaybe 0 (M.lookup p (gs^.gsBombsLeft)) > 0 + , Just dist <- M.lookup (from, to) (gs^.gsLinks) + = gs & gsBombs %~ M.insert (gs^.gsNextEntity) + (Bomb { bombId = gs^.gsNextEntity , 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 - } + , bombTurnsLeft = dist + }) + & gsBombsLeft . atKey p . _Just %~ subtract 1 + & gsNextEntity %~ (+1) + | otherwise = gs + processIncrease p factory gs + | Just True <- (\f -> f^.cyborgs >= 10 && f^.owner == p) + <$> M.lookup factory (gs^.gsFactories) + = gs & gsFactories . atKey factory . _Just %~ over cyborgs (subtract 10) + . over production (min 3 . (+1)) | otherwise = gs - processIncrease p factory gs = - 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) - } - produceCyborgs :: GameState -> GameState -produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) } +produceCyborgs = gsFactories . traverse %~ produce where produce f - | f^.turnsLeft > 0 = over turnsLeft (subtract 1) f - | otherwise = over cyborgs (+ f^.production) f + | f^.turnsLeft > 0 = f & turnsLeft %~ subtract 1 + | f^.owner == Neutral = f + | otherwise = f & cyborgs %~ (+ f^.production) solveBattles :: GameState -> GameState solveBattles gs = - gs { gsFactories = map solveFactory (gsFactories gs) - , gsTroops = troopsInTransit - } + gs & gsFactories %~ flip (foldl' (flip (M.adjust solveFactory))) factoriesWithArrivals + & gsTroops .~ troopsInTransit where - (troopsArriving, troopsInTransit) = partition ((<= 0) . view turnsLeft) (gsTroops gs) + (troopsArriving, troopsInTransit) = M.partition ((<= 0) . view turnsLeft) (gs^.gsTroops) + factoriesWithArrivals = nub $ foldMap ((:[]) . view target) troopsArriving solveFactory f - | attacking > defending = f & set owner attackingPlayer - & set cyborgs (attacking - defending) - | otherwise = f & set cyborgs (defending - attacking) + | attacking > defending = f & owner .~ attackingPlayer + & cyborgs .~ attacking - defending + | otherwise = f & cyborgs .~ defending - attacking where - 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) + (Sum defending, Sum mineAttacking, Sum theirsAttacking) + = mappend (Sum (f^.cyborgs), mempty, mempty) + . flip foldMap troopsArriving $ \t -> case () of + _ | t^.target /= f^.entityId -> mempty + | t^.owner == f^.owner -> (Sum (t^.cyborgs), mempty, mempty) + | t^.owner == ThisPlayer -> (mempty, Sum (t^.cyborgs), mempty) + | otherwise -> (mempty, mempty, Sum (t^.cyborgs)) + attackingPlayer + | mineAttacking > theirsAttacking = ThisPlayer + | otherwise = Opponent + attacking = abs (mineAttacking - theirsAttacking) explodeBombs :: GameState -> GameState explodeBombs gs = - gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived - , gsBombs = bombsInTransit - } + gs & gsFactories %~ flip (M.foldl' explodeBomb) bombsArrived + & gsBombs .~ bombsInTransit where - (bombsArrived, bombsInTransit) = partition (\b -> b^.turnsLeft <= 0) (gsBombs gs) - explodeBomb fs b = flip map fs $ \f -> - if f^.entityId /= b^.target then f else - f & set cyborgs (max 0 (f^.cyborgs - max 10 (f^.cyborgs `div` 2))) - & set turnsLeft 5 + (bombsArrived, bombsInTransit) = M.partition (\b -> b^.turnsLeft <= 0) (gs^.gsBombs) + explodeBomb fs b = ($ fs) . flip M.adjust (b^.target) $ \f -> + f & cyborgs %~ max 0 . subtract (max 10 (f^.cyborgs `div` 2)) + & turnsLeft .~ 5 safeMinimumBy :: (a -> a -> Ordering) -> [a] -> Maybe a safeMinimumBy _ [] = Nothing @@ -315,29 +325,44 @@ 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 +count :: Foldable f => (a -> Bool) -> f a -> Int +count p = getSum . foldMap (\x -> if p x then Sum 1 else mempty) 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 +type Getting r s a = (a -> Const r a) -> s -> Const r s +type Setter s t a b = (a -> Identity b) -> s -> Identity t +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 :: Setter 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 :: Setter s t a b -> b -> s -> t set l = over l . const (^.) :: s -> Getting a s a -> a (^.) = flip view infixl 8 ^. +(.~) :: Setter s t a b -> b -> s -> t +(.~) = set +infixr 4 .~ + +(%~) :: Setter s t a b -> (a -> b) -> s -> t +(%~) = over +infixr 4 %~ + +to :: (s -> a) -> Getting a s a +to f g = Const . getConst . g . f + +atKey :: Ord k => k -> Lens' (M.Map k a) (Maybe a) +atKey k f s = (\b -> M.alter (const b) k s) <$> f (M.lookup k s) + 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) @@ -364,13 +389,33 @@ instance HasTurnsLeft Bomb where turnsLeft f s = (\b -> s { bombTurnsLeft production :: Lens' Factory Int production f s = (\b -> s { factoryProduction = b }) <$> f (factoryProduction s) +gsLinks :: Lens' GameState (M.Map (FactoryId, FactoryId) Int) +gsFactories :: Lens' GameState (M.Map FactoryId Factory) +gsTroops :: Lens' GameState (M.Map TroopId Troop) +gsBombs :: Lens' GameState (M.Map BombId Bomb) +gsBombsLeft :: Lens' GameState (M.Map PlayerId Int) +gsNextEntity :: Lens' GameState EntityId +gsTurnCount :: Lens' GameState Int + +gsLinks f s = (\b -> s { _gsLinks = b }) <$> f (_gsLinks s) +gsFactories f s = (\b -> s { _gsFactories = b }) <$> f (_gsFactories s) +gsTroops f s = (\b -> s { _gsTroops = b }) <$> f (_gsTroops s) +gsBombs f s = (\b -> s { _gsBombs = b }) <$> f (_gsBombs s) +gsBombsLeft f s = (\b -> s { _gsBombsLeft = b }) <$> f (_gsBombsLeft s) +gsNextEntity f s = (\b -> s { _gsNextEntity = b }) <$> f (_gsNextEntity s) +gsTurnCount f s = (\b -> s { _gsTurnCount = b }) <$> f (_gsTurnCount s) + +type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t +type Traversal' s a = Traversal s s a a + +_Just :: Traversal (Maybe a) (Maybe b) a b +_Just = maybe (pure Nothing) . (fmap Just .) + 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) - } +flipSides = gsFactories . traverse %~ flipOwner + >>> gsTroops . traverse %~ flipOwner + >>> gsBombs . traverse %~ flipOwner + >>> gsBombsLeft %~ M.mapKeys otherPlayer where flipOwner :: HasOwner a => a -> a flipOwner = over owner otherPlayer