442 lines
18 KiB
Haskell
442 lines
18 KiB
Haskell
{-# LANGUAGE ViewPatterns, LambdaCase, RankNTypes #-}
|
|
|
|
module Main (main) where
|
|
|
|
import Control.Applicative
|
|
import Control.Arrow (first, second, (>>>))
|
|
import Control.Monad
|
|
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
|
|
import Data.Monoid
|
|
import System.CPUTime
|
|
import System.IO
|
|
|
|
import qualified Data.Map as M
|
|
|
|
type EntityId = Int
|
|
type FactoryId = EntityId
|
|
type TroopId = EntityId
|
|
type BombId = EntityId
|
|
|
|
data PlayerId = ThisPlayer | Neutral | Opponent deriving (Eq, Ord, Show)
|
|
|
|
data Factory = Factory { factoryId :: FactoryId
|
|
, factoryOwner :: PlayerId
|
|
, factoryCyborgs :: Int
|
|
, factoryProduction :: Int
|
|
, factoryTurnsLeft :: Int
|
|
} deriving (Eq, Show)
|
|
|
|
data Troop = Troop { troopId :: TroopId
|
|
, troopOwner :: PlayerId
|
|
, troopOrigin :: FactoryId
|
|
, troopTarget :: FactoryId
|
|
, troopCyborgs :: Int
|
|
, troopTurnsLeft :: Int
|
|
} deriving (Eq, Show)
|
|
|
|
data Bomb = Bomb { bombId :: BombId
|
|
, bombOwner :: PlayerId
|
|
, bombOrigin :: FactoryId
|
|
, bombTarget :: FactoryId
|
|
, bombTurnsLeft :: Int
|
|
} deriving (Eq, Show)
|
|
|
|
data Action = Move FactoryId FactoryId Int
|
|
| SendBomb FactoryId FactoryId
|
|
| Increase FactoryId
|
|
| Wait
|
|
deriving (Eq, Show)
|
|
|
|
data GameState =
|
|
GameState
|
|
{ _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 <- 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 <$> 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 <- 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 <$> 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
|
|
|
|
turnCount <- readIORef turnCountRef
|
|
bombsLeft <- readIORef bombsLeftRef
|
|
|
|
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)] 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 $
|
|
atKey ThisPlayer . _Just %~ max 0 . subtract 1
|
|
_ -> pure ()
|
|
|
|
modifyIORef turnCountRef (+1)
|
|
|
|
scoreGame :: GameState -> Double
|
|
scoreGame gs = (playerScore ThisPlayer) - (1.25 * playerScore Opponent)
|
|
where
|
|
playerScore p = 1 * numCyborgs
|
|
+ 50 * produced
|
|
+ 25 * upgradable
|
|
+ 10 * factories
|
|
+ 50 * bombsLeft
|
|
where
|
|
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])] -> 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 = sum $
|
|
zipWith (\n gs' -> (fromIntegral n)**(0.5) * scoreGame gs')
|
|
[1..foresight]
|
|
(simulate (acts ++ [(ThisPlayer, as)]) gs)
|
|
|
|
myFactories = M.filter (ownedBy ThisPlayer) (gs^.gsFactories)
|
|
|
|
transitMap = M.fromList $ do
|
|
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
|
|
guard $ src^.cyborgs > 0
|
|
dst <- M.elems myFactories
|
|
guard $ dst^.entityId /= src^.entityId
|
|
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) (gs^.gsLinks)
|
|
pure $ Move (src^.entityId) (dst^.entityId) amount
|
|
|
|
attackScores src = do
|
|
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 theirTotal = dst^.cyborgs + theirsDefending - mineAttacking
|
|
let theirEstimate
|
|
| ownedBy Neutral dst = theirTotal
|
|
| otherwise = theirTotal + dst^.production * (1 + dist)
|
|
amount <- nub [src^.cyborgs, theirEstimate + 10, theirEstimate + 1, src^.production]
|
|
guard $ amount > 0 && amount <= src^.cyborgs
|
|
pure $ Move (src^.entityId) (dst^.entityId) amount
|
|
|
|
increaseScores src = do
|
|
guard $ src^.production < 3
|
|
guard $ src^.cyborgs >= 10
|
|
pure $ Increase (src^.entityId)
|
|
|
|
factoryActions src = concatMap ($ src) [ distributeScores
|
|
, attackScores
|
|
, increaseScores
|
|
]
|
|
|
|
allFactoryActions = concatMap factoryActions (M.elems myFactories)
|
|
|
|
bombActions = do
|
|
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])] -> GameState -> [GameState]
|
|
simulate orders gs = iterate (gameTurn []) (gameTurn orders gs)
|
|
|
|
gameTurn :: [(PlayerId, [Action])] -> GameState -> GameState
|
|
gameTurn orders = moveTroops
|
|
>>> moveBombs
|
|
>>> processOrders orders
|
|
>>> produceCyborgs
|
|
>>> solveBattles
|
|
>>> explodeBombs
|
|
|
|
moveTroops, moveBombs :: GameState -> GameState
|
|
moveTroops = gsTroops . traverse . turnsLeft %~ subtract 1
|
|
moveBombs = gsBombs . traverse . turnsLeft %~ subtract 1
|
|
|
|
processOrders :: [(PlayerId, [Action])] -> GameState -> GameState
|
|
processOrders = flip (foldl processOrder)
|
|
where
|
|
processOrder gs (p, as) = foldl (processAction p) gs as
|
|
processAction p gs = \case
|
|
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 org tgt amt gs
|
|
| Just f <- M.lookup org (gs^.gsFactories)
|
|
, ownedBy p f
|
|
, adjAmt <- min (f^.cyborgs) amt
|
|
, 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 = org
|
|
, troopTarget = tgt
|
|
, troopCyborgs = adjAmt
|
|
, troopTurnsLeft = dist
|
|
})
|
|
& gsNextEntity %~ (+1)
|
|
| otherwise = gs
|
|
processBomb p from to 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 = 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
|
|
|
|
produceCyborgs :: GameState -> GameState
|
|
produceCyborgs = gsFactories . traverse %~ produce
|
|
where
|
|
produce f
|
|
| f^.turnsLeft > 0 = f & turnsLeft %~ subtract 1
|
|
| f^.owner == Neutral = f
|
|
| otherwise = f & cyborgs %~ (+ f^.production)
|
|
|
|
solveBattles :: GameState -> GameState
|
|
solveBattles gs =
|
|
gs & gsFactories %~ flip (foldl' (flip (M.adjust solveFactory))) factoriesWithArrivals
|
|
& gsTroops .~ troopsInTransit
|
|
where
|
|
(troopsArriving, troopsInTransit) = M.partition ((<= 0) . view turnsLeft) (gs^.gsTroops)
|
|
factoriesWithArrivals = nub $ foldMap ((:[]) . view target) troopsArriving
|
|
solveFactory f
|
|
| attacking > defending = f & owner .~ attackingPlayer
|
|
& cyborgs .~ attacking - defending
|
|
| otherwise = f & cyborgs .~ defending - attacking
|
|
where
|
|
(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 %~ flip (M.foldl' explodeBomb) bombsArrived
|
|
& gsBombs .~ bombsInTransit
|
|
where
|
|
(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
|
|
safeMinimumBy cmp xs = Just (minimumBy cmp xs)
|
|
|
|
safeMaximumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
|
|
safeMaximumBy _ [] = Nothing
|
|
safeMaximumBy cmp xs = Just (maximumBy cmp xs)
|
|
|
|
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 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 :: Setter s t a b -> (a -> b) -> s -> t
|
|
over l f = runIdentity . l (Identity . f)
|
|
|
|
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)
|
|
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)
|
|
|
|
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 = gsFactories . traverse %~ flipOwner
|
|
>>> gsTroops . traverse %~ flipOwner
|
|
>>> gsBombs . traverse %~ flipOwner
|
|
>>> gsBombsLeft %~ M.mapKeys otherPlayer
|
|
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"
|