Ghost in the Cell -- scoring changes, more refactoring.
This commit is contained in:
parent
c0a611f1d4
commit
0ab65cc688
|
|
@ -1,4 +1,6 @@
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns, LambdaCase, RankNTypes #-}
|
||||||
|
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
|
@ -8,6 +10,7 @@ import Control.Monad.Writer
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.Function
|
import Data.Function
|
||||||
|
import Data.Functor.Identity
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
@ -16,14 +19,15 @@ import Data.Monoid
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
type EntityId = Int
|
type EntityId = Int
|
||||||
type PlayerId = Int
|
|
||||||
type FactoryId = Int
|
type FactoryId = Int
|
||||||
|
|
||||||
|
data PlayerId = ThisPlayer | Neutral | Opponent deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
data Factory = Factory { factoryId :: EntityId
|
data Factory = Factory { factoryId :: EntityId
|
||||||
, factoryOwner :: PlayerId
|
, factoryOwner :: PlayerId
|
||||||
, factoryCyborgs :: Int
|
, factoryCyborgs :: Int
|
||||||
, factoryProduction :: Int
|
, factoryProduction :: Int
|
||||||
, factoryDelay :: Int
|
, factoryTurnsLeft :: Int
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
data Troop = Troop { troopId :: EntityId
|
data Troop = Troop { troopId :: EntityId
|
||||||
|
|
@ -47,54 +51,17 @@ data Action = Move FactoryId FactoryId Int
|
||||||
| Wait
|
| Wait
|
||||||
deriving (Eq, Show)
|
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 =
|
data GameState =
|
||||||
GameState
|
GameState
|
||||||
{ gsLinks :: M.Map (FactoryId, FactoryId) Int
|
{ gsLinks :: M.Map (FactoryId, FactoryId) Int
|
||||||
, gsFactories :: [Factory]
|
, gsFactories :: [Factory]
|
||||||
, gsTroops :: [Troop]
|
, gsTroops :: [Troop]
|
||||||
, gsBombs :: [Bomb]
|
, gsBombs :: [Bomb]
|
||||||
, gsBombsLeft :: Int
|
, gsBombsLeft :: M.Map PlayerId Int
|
||||||
, gsNextEntity :: EntityId
|
, gsNextEntity :: EntityId
|
||||||
, gsTurnCount :: Int
|
, gsTurnCount :: Int
|
||||||
} deriving (Show)
|
} 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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
hSetBuffering stdout NoBuffering -- DO NOT REMOVE
|
hSetBuffering stdout NoBuffering -- DO NOT REMOVE
|
||||||
|
|
@ -107,26 +74,27 @@ main = do
|
||||||
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 2
|
bombsLeftRef <- newIORef $ M.fromList [(ThisPlayer, 2), (Opponent, 2)]
|
||||||
|
|
||||||
forever $ do
|
forever $ do
|
||||||
entityCount <- readLn :: IO Int
|
entityCount <- readLn :: IO Int
|
||||||
(partitionEithers -> (factoryList, partitionEithers -> (troopList, bombList))) <- replicateM entityCount $ do
|
(second partitionEithers . partitionEithers ->
|
||||||
((read -> entityId):entityType:(map read -> [a1,a2,a3,a4,a5])) <- words <$> getLine
|
(factoryList, (troopList, bombList))) <- replicateM entityCount $ do
|
||||||
pure $ case entityType of
|
((read -> eId):eType:(parsePlayerId . read -> a1)
|
||||||
"FACTORY" -> Left $ Factory entityId a1 a2 a3 a4
|
:(map read -> [a2,a3,a4,a5])) <- words <$> getLine
|
||||||
"TROOP" -> Right . Left $ Troop entityId a1 a2 a3 a4 a5
|
pure $ case eType of
|
||||||
"BOMB" -> Right . Right $ Bomb entityId a1 a2 a3 a4
|
"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
|
let nextEntity = (+1) $ maximum $ 0 : map (view entityId) factoryList
|
||||||
++ map entityId troopList
|
++ map (view entityId) troopList
|
||||||
++ map entityId bombList
|
++ map (view entityId) bombList
|
||||||
|
|
||||||
turnCount <- readIORef turnCountRef
|
turnCount <- readIORef turnCountRef
|
||||||
bombsLeft <- readIORef bombsLeftRef
|
bombsLeft <- readIORef bombsLeftRef
|
||||||
|
|
||||||
let chosenActions = chooseActions $
|
let gs = GameState { gsLinks = links
|
||||||
GameState { gsLinks = links
|
|
||||||
, gsFactories = factoryList
|
, gsFactories = factoryList
|
||||||
, gsTroops = troopList
|
, gsTroops = troopList
|
||||||
, gsBombs = bombList
|
, gsBombs = bombList
|
||||||
|
|
@ -135,86 +103,112 @@ main = do
|
||||||
, gsBombsLeft = bombsLeft
|
, gsBombsLeft = bombsLeft
|
||||||
}
|
}
|
||||||
|
|
||||||
|
let oppActions = [] -- chooseActions (flipSides gs) []
|
||||||
|
let chosenActions = chooseActions gs [(Opponent, oppActions)]
|
||||||
|
|
||||||
case chosenActions of
|
case chosenActions of
|
||||||
[] -> putStrLn $ actionString Wait
|
[] -> putStrLn $ actionString Wait
|
||||||
xs -> putStrLn $ intercalate "; " $ map actionString xs
|
xs -> putStrLn $ intercalate "; " $ map actionString xs
|
||||||
|
|
||||||
let isSendBomb act = case act of { SendBomb _ _ -> True; _ -> False }
|
forM_ chosenActions $ \case
|
||||||
modifyIORef bombsLeftRef (subtract $ length $ filter isSendBomb chosenActions)
|
SendBomb _ _ -> modifyIORef bombsLeftRef (M.update (Just . max 0 . subtract 1) ThisPlayer)
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
modifyIORef turnCountRef (+1)
|
modifyIORef turnCountRef (+1)
|
||||||
|
|
||||||
awareness, foresight :: Int
|
awareness, foresight :: Int
|
||||||
awareness = 10 -- number of actions to consider
|
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]
|
scoreGame :: GameState -> Double
|
||||||
chooseActions gs = loop [] (scoreGame (simulate [] foresight gs)) (allFactoryActions ++ bombActions)
|
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
|
where
|
||||||
scoreActions as = scoreGame $ simulate [(thisPlayer, as)] foresight gs
|
|
||||||
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
|
||||||
|
|
||||||
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
|
myFactories = filter (ownedBy ThisPlayer) (gsFactories gs)
|
||||||
[ (to, (mine, theirs))
|
|
||||||
| let (myTroops, theirTroops) = partition (\t -> owner t == thisPlayer) (gsTroops gs)
|
transitMap = M.fromList $ do
|
||||||
, to <- map entityId (gsFactories gs)
|
to <- map (view entityId) (gsFactories gs)
|
||||||
, let mine = sum [ cyborgs t | t <- myTroops, target t == to ]
|
let troops = filter ((== to) . view target) (gsTroops gs)
|
||||||
, let theirs = sum [ cyborgs t | t <- theirTroops, target t == to ]
|
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
|
inTransitTo dst = fromMaybe (0, 0) $ M.lookup dst transitMap
|
||||||
|
|
||||||
distributeScores src = do
|
distributeScores src = do
|
||||||
dst <- myFactories
|
dst <- myFactories
|
||||||
guard $ entityId dst /= entityId src
|
guard $ dst^.entityId /= src^.entityId
|
||||||
let (srcDefending, srcAttacking) = inTransitTo (entityId src)
|
let amount' = src^.cyborgs
|
||||||
let (dstDefending, dstAttacking) = inTransitTo (entityId dst)
|
amount <- nub [amount', amount' `div` 3, src^.production]
|
||||||
let srcTotal = cyborgs src - srcAttacking
|
guard $ amount > 0 && amount <= src^.cyborgs
|
||||||
let dstTotal = cyborgs dst + dstDefending - dstAttacking
|
dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs)
|
||||||
let amount = (cyborgs src + 1) `div` 3
|
pure $ Move (src^.entityId) (dst^.entityId) amount
|
||||||
guard $ amount > 0 && amount <= cyborgs src
|
|
||||||
dist <- toList $ M.lookup (entityId src, entityId dst) (gsLinks gs)
|
|
||||||
pure $ Move (entityId src) (entityId dst) amount
|
|
||||||
|
|
||||||
attackScores src = do
|
attackScores src = do
|
||||||
dst <- filter (\f -> owner f /= thisPlayer) (gsFactories gs)
|
dst <- filter (not . ownedBy ThisPlayer) (gsFactories gs)
|
||||||
dist <- toList $ M.lookup (entityId src, entityId dst) (gsLinks gs)
|
dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs)
|
||||||
let (mineDefending, theirsAttacking) = inTransitTo (entityId src)
|
let (mineDefending, theirsAttacking) = inTransitTo (src^.entityId)
|
||||||
let (mineAttacking, theirsDefending) = inTransitTo (entityId dst)
|
let (mineAttacking, theirsDefending) = inTransitTo (dst^.entityId)
|
||||||
let myTotal = cyborgs src - theirsAttacking
|
let myTotal = src^.cyborgs - theirsAttacking
|
||||||
let theirTotal = cyborgs dst + theirsDefending - mineAttacking
|
let theirTotal = dst^.cyborgs + theirsDefending - mineAttacking
|
||||||
let theirEstimate
|
let theirEstimate
|
||||||
| owner dst == neutralPlayer = theirTotal
|
| ownedBy Neutral dst = theirTotal
|
||||||
| otherwise = theirTotal + factoryProduction dst * (1 + dist)
|
| otherwise = theirTotal + dst^.production * (1 + dist)
|
||||||
let amount = theirEstimate + 1
|
let amount' = theirEstimate + 1
|
||||||
guard $ amount > 0 && amount <= cyborgs src
|
amount <- nub [2 * amount', amount', amount' `div` 2, src^.production]
|
||||||
pure $ Move (entityId src) (entityId dst) amount
|
guard $ amount > 0 && amount <= src^.cyborgs
|
||||||
|
pure $ Move (src^.entityId) (dst^.entityId) amount
|
||||||
|
|
||||||
increaseScores src = do
|
increaseScores src = do
|
||||||
guard $ factoryProduction src < 3
|
guard $ src^.production < 3
|
||||||
guard $ cyborgs src >= 10
|
guard $ src^.cyborgs >= 10
|
||||||
pure $ Increase (entityId src)
|
pure $ Increase (src^.entityId)
|
||||||
|
|
||||||
factoryActions src = foldr mplus mempty $ map ($ src) $
|
factoryActions src = concatMap ($ src) [ distributeScores
|
||||||
[ distributeScores, attackScores, increaseScores ]
|
, attackScores
|
||||||
|
, increaseScores
|
||||||
|
]
|
||||||
|
|
||||||
allFactoryActions = concatMap factoryActions myFactories
|
allFactoryActions = concatMap factoryActions myFactories
|
||||||
|
|
||||||
bombActions = do
|
bombActions = do
|
||||||
guard $ (gsBombsLeft gs) > 0 && not (null myFactories)
|
guard $ fromMaybe 0 (M.lookup ThisPlayer $ gsBombsLeft gs) > 0
|
||||||
guard $ (gsBombsLeft gs) > 1 || (gsTurnCount gs) > 50
|
dst <- gsFactories gs
|
||||||
dst <- filter (\f -> owner f == opponent) (gsFactories gs)
|
src <- toList $ fmap snd $ safeMinimumBy (compare `on` fst) $ do
|
||||||
--guard $ cyborgs dst >= 50 + 50 * (2 - (gsBombsLeft gs))
|
src' <- myFactories
|
||||||
let src = snd $ minimumBy (compare `on` fst) $
|
guard $ src'^.entityId /= dst^.entityId
|
||||||
[ (dist, s) | s <- myFactories
|
dist <- toList $ M.lookup (src'^.entityId, dst^.entityId) (gsLinks gs)
|
||||||
, dist <- toList $ M.lookup (entityId s, entityId dst) (gsLinks gs)
|
pure (dist, src')
|
||||||
]
|
pure $ SendBomb (src^.entityId) (dst^.entityId)
|
||||||
pure $ SendBomb (entityId src) (entityId dst)
|
|
||||||
|
|
||||||
best :: Ord a => Int -> [(a, b)] -> [(a, b)]
|
simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState
|
||||||
best n = take n . sortBy (flip compare `on` fst)
|
simulate orders n 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
|
||||||
|
|
@ -224,106 +218,179 @@ gameTurn orders = moveTroops
|
||||||
>>> solveBattles
|
>>> solveBattles
|
||||||
>>> explodeBombs
|
>>> explodeBombs
|
||||||
|
|
||||||
simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState
|
moveTroops, moveBombs :: GameState -> GameState
|
||||||
simulate orders n gs
|
moveTroops gs0 = gs0 { gsTroops = map (over turnsLeft (subtract 1)) (gsTroops gs0) }
|
||||||
| n > 0 = simulate [] (n-1) (gameTurn orders gs)
|
moveBombs gs0 = gs0 { gsBombs = map (over turnsLeft (subtract 1)) (gsBombs gs0) }
|
||||||
| 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) }
|
|
||||||
|
|
||||||
processOrders :: [(PlayerId, [Action])] -> GameState -> GameState
|
processOrders :: [(PlayerId, [Action])] -> GameState -> GameState
|
||||||
processOrders orders gs0 = foldl processOrder gs0 orders
|
processOrders orders gs0 = foldl processOrder gs0 orders
|
||||||
where
|
where
|
||||||
processOrder gs (p, as) = foldl (processAction p) gs as
|
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
|
Move from to amt -> processMove p from to amt gs
|
||||||
SendBomb from to -> processBomb p from to gs
|
SendBomb from to -> processBomb p from to 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 from to amt gs
|
||||||
gs { gsFactories = map (\f -> if entityId f /= from then f
|
| f:_ <- filter ((== from) . view entityId) (gsFactories gs)
|
||||||
else f { factoryCyborgs = max 0 (cyborgs f - amt) })
|
, 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)
|
(gsFactories gs)
|
||||||
, gsTroops = gsTroops gs ++
|
, gsTroops = gsTroops gs ++
|
||||||
[Troop { troopId = gsNextEntity gs
|
[Troop { troopId = gsNextEntity gs
|
||||||
, troopOwner = p
|
, troopOwner = p
|
||||||
, troopOrigin = from
|
, troopOrigin = from
|
||||||
, troopTarget = to
|
, troopTarget = to
|
||||||
, troopCyborgs = min amt (sum $ map (\f -> if entityId f == from then cyborgs f else 0) (gsFactories gs))
|
, troopCyborgs = adjAmt
|
||||||
, troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
|
, troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
|
||||||
}]
|
}]
|
||||||
, gsNextEntity = gsNextEntity gs + 1
|
, gsNextEntity = gsNextEntity gs + 1
|
||||||
}
|
}
|
||||||
processBomb p from to gs =
|
| otherwise = gs
|
||||||
gs { gsBombs = gsBombs gs ++
|
processBomb p from to gs
|
||||||
|
| fromMaybe 0 (M.lookup p (gsBombsLeft gs)) > 0
|
||||||
|
= gs { gsBombs = gsBombs gs ++
|
||||||
[Bomb { bombId = gsNextEntity gs
|
[Bomb { bombId = gsNextEntity gs
|
||||||
, bombOwner = p
|
, bombOwner = p
|
||||||
, bombOrigin = from
|
, bombOrigin = from
|
||||||
, bombTarget = to
|
, bombTarget = to
|
||||||
, bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
|
, bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
|
||||||
}]
|
}]
|
||||||
|
, gsBombsLeft = M.update (Just . subtract 1) p $ gsBombsLeft gs
|
||||||
, gsNextEntity = gsNextEntity gs + 1
|
, gsNextEntity = gsNextEntity gs + 1
|
||||||
}
|
}
|
||||||
|
| otherwise = gs
|
||||||
processIncrease p factory gs =
|
processIncrease p factory gs =
|
||||||
gs { gsFactories = map (\f -> if entityId f /= factory || cyborgs f < 10 then f else
|
gs { gsFactories = map (\f -> if f^.entityId /= factory || f^.cyborgs < 10 then f else
|
||||||
f { factoryCyborgs = cyborgs f - 10
|
f & over cyborgs (subtract 10)
|
||||||
, factoryProduction = min 3 (factoryProduction f + 1)
|
& over production (min 3 . (+1)))
|
||||||
})
|
|
||||||
(gsFactories gs)
|
(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) }
|
produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) }
|
||||||
where
|
where
|
||||||
produce f
|
produce f
|
||||||
| factoryDelay f > 0 = f { factoryDelay = factoryDelay f - 1 }
|
| f^.turnsLeft > 0 = over turnsLeft (subtract 1) f
|
||||||
| otherwise = f { factoryCyborgs = cyborgs f + factoryProduction f }
|
| otherwise = over cyborgs (+ f^.production) f
|
||||||
|
|
||||||
|
solveBattles :: GameState -> GameState
|
||||||
solveBattles gs =
|
solveBattles gs =
|
||||||
gs { gsFactories = map solveFactory (gsFactories gs)
|
gs { gsFactories = map solveFactory (gsFactories gs)
|
||||||
, gsTroops = troopsInTransit
|
, gsTroops = troopsInTransit
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
(troopsArriving, troopsInTransit) = partition (\t -> turnsLeft t <= 0) (gsTroops gs)
|
(troopsArriving, troopsInTransit) = partition ((<= 0) . view turnsLeft) (gsTroops gs)
|
||||||
solveFactory f
|
solveFactory f
|
||||||
| attacking > defending = f { factoryOwner = attackingPlayer
|
| attacking > defending = f & set owner attackingPlayer
|
||||||
, factoryCyborgs = attacking - defending
|
& set cyborgs (attacking - defending)
|
||||||
}
|
| otherwise = f & set cyborgs (defending - attacking)
|
||||||
| otherwise = f { factoryCyborgs = defending - attacking }
|
|
||||||
where
|
where
|
||||||
troopsArrivingHere = filter (\t -> target t == entityId f) troopsArriving
|
troopsArrivingHere = filter (\t -> t^.target == f^.entityId) troopsArriving
|
||||||
defending = cyborgs f + sum [ cyborgs t | t <- troopsArrivingHere, owner t == owner f ]
|
(defendingHere, attackingHere) = partition (ownedBy (f^.owner)) troopsArrivingHere
|
||||||
attacking = sum [ cyborgs t | t <- troopsArrivingHere, owner t /= owner f ]
|
defending = sum (map (view cyborgs) defendingHere) + f^.cyborgs
|
||||||
attackingPlayer = if owner f == opponent then thisPlayer else opponent
|
attacking = sum (map (view cyborgs) attackingHere)
|
||||||
|
attackingPlayer = otherPlayer (f^.owner)
|
||||||
|
|
||||||
|
explodeBombs :: GameState -> GameState
|
||||||
explodeBombs gs =
|
explodeBombs gs =
|
||||||
gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived
|
gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived
|
||||||
, gsBombs = bombsInTransit
|
, gsBombs = bombsInTransit
|
||||||
}
|
}
|
||||||
where
|
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 ->
|
explodeBomb fs b = flip map fs $ \f ->
|
||||||
if entityId f /= target b then f else
|
if f^.entityId /= b^.target then f else
|
||||||
f { factoryCyborgs = max 0 (cyborgs f - max 10 (cyborgs f `div` 2))
|
f & set cyborgs (max 0 (f^.cyborgs - max 10 (f^.cyborgs `div` 2)))
|
||||||
, factoryDelay = 5
|
& 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"
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue