nybble
/
CodinGame
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Ghost in the Cell -- final version.

This commit is contained in:
Jesse D. McDonald 2017-03-05 12:59:41 -06:00
parent 0ab65cc688
commit 81231223fa
1 changed files with 196 additions and 151 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

341
Contests/GhostInTheCell/GhostInTheCell.hs
View File

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