CodinGame/Contests/GhostInTheCell/GhostInTheCell.hs

178 lines
8.3 KiB
Haskell

{-# LANGUAGE ViewPatterns, LambdaCase, DataKinds, GADTs #-}
import System.IO
import Control.Applicative
import Control.Arrow (first, second)
import Control.Monad
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import qualified Data.Map as M
type EntityId = Int
type PlayerId = Int
type FactoryId = Int
data Factory = Factory { factoryId :: EntityId
, factoryOwner :: PlayerId
, factoryCyborgs :: Int
, factoryProduction :: Int
, factoryDelay :: Int
} deriving (Eq, Show)
data Troop = Troop { troopId :: EntityId
, troopOwner :: PlayerId
, troopOrigin :: FactoryId
, troopTarget :: FactoryId
, troopCyborgs :: Int
, troopTurnsLeft :: Int
} deriving (Eq, Show)
data Bomb = Bomb { bombId :: EntityId
, bombSender :: PlayerId
, bombOrigin :: FactoryId
, bombTarget :: FactoryId
, bombDelay :: Int
} deriving (Eq, Show)
data Action = Move FactoryId FactoryId Int
| SendBomb FactoryId FactoryId
| Increase FactoryId
| Wait
deriving (Eq, 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
factoryCount <- readLn :: IO Int -- the number of factories
linkCount <- readLn :: IO Int -- the number of links between factories
links <- fmap (M.fromList . concat) $ replicateM linkCount $ do
[f1, f2, dist] <- map read . words <$> getLine
pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)])
bombsLeftRef <- newIORef 2
forever $ do
bombsLeft <- readIORef bombsLeftRef
entityCount <- readLn :: IO Int -- the number of entities (e.g. factories and troops)
(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
let factories = M.fromList [ (factoryId f, f) | f <- factoryList ]
let myFactories = filter (\f -> factoryOwner f == thisPlayer) factoryList
let inTransitTo =
let transitMap = M.fromList
[ (to, (mine, theirs))
| let myTroops = filter (\t -> troopOwner t == thisPlayer) troopList
, let theirTroops = filter (\t -> troopOwner t /= thisPlayer) troopList
, to <- map factoryId factoryList
, let mine = sum $ map troopCyborgs $ filter (\t -> troopTarget t == to) myTroops
, let theirs = sum $ map troopCyborgs $ filter (\t -> troopTarget t == to) theirTroops
]
in \dst -> fromMaybe (0, 0) $ M.lookup dst transitMap
let myTotalProduction = sum $ map factoryProduction myFactories
let distributeScores src = do
dst <- myFactories
guard $ factoryId dst /= factoryId src
let (srcDefending, srcAttacking) = inTransitTo (factoryId src)
let (dstDefending, dstAttacking) = inTransitTo (factoryId dst)
let srcTotal = factoryCyborgs src - srcAttacking
let dstTotal = factoryCyborgs dst + dstDefending - dstAttacking
guard $ 2 * srcTotal >= 3 * dstTotal
let amount = (factoryCyborgs src + 1) `div` 3
guard $ amount > 0
dist <- toList $ M.lookup (factoryId src, factoryId dst) links
let threshold = (1.0 - saturate 20.0 (fromIntegral (factoryCyborgs src)))
* (fromIntegral (factoryProduction src + 1) / 4.0)
* 0.5
let score = saturate 10.0 (fromIntegral (srcTotal - dstTotal))
* saturate 20.0 (fromIntegral (srcTotal - amount))
* (1.0 - 0.25 * saturate 20.0 (fromIntegral dstTotal))
guard $ score >= threshold
pure (score, [Move (factoryId src) (factoryId dst) amount])
let attackScores src = do
guard $ factoryCyborgs src >= 5 * factoryProduction src
dst <- filter (\f -> factoryOwner f /= thisPlayer) factoryList
dist <- toList $ M.lookup (factoryId src, factoryId dst) links
let (mineDefending, theirsAttacking) = inTransitTo (factoryId src)
let (mineAttacking, theirsDefending) = inTransitTo (factoryId dst)
let myTotal = factoryCyborgs src - theirsAttacking
let theirTotal = factoryCyborgs dst + theirsDefending - mineAttacking
let theirEstimate
| factoryOwner dst == neutralPlayer = theirTotal
| otherwise = theirTotal + factoryProduction dst * (1 + dist)
guard $ 2 * myTotal >= 3 * theirTotal
let amount = theirEstimate + 1
guard $ amount > 0
let threshold = (1.0 - saturate 20.0 (fromIntegral (factoryCyborgs src)))
* (fromIntegral (factoryProduction src + 1) / 4.0)
* saturate 6.0 (fromIntegral myTotalProduction)
* 0.5
let score = fromIntegral (factoryProduction dst + 8) / 10.0
* saturate 10.0 (fromIntegral (myTotal - amount))
* (40.0 / (39.0 + fromIntegral dist))
guard $ score >= threshold
pure (score, [Move (factoryId src) (factoryId dst) amount])
let increaseScores src = do
guard $ factoryProduction src < 3
guard $ factoryCyborgs src >= 10
let score = saturate 10.0 $ fromIntegral myTotalProduction
pure (score, [Increase (factoryId src)])
let factoryActions src = concatMap snd $ best 1 $ concatMap ($ src) $
[ distributeScores, attackScores, increaseScores ]
let actions = concatMap factoryActions myFactories
let bombActions = concatMap snd $ best 1 $ do
guard $ bombsLeft > 0 && not (null myFactories)
dst <- filter (\f -> factoryOwner f == opponent) factoryList
guard $ factoryCyborgs dst >= 50 + 50 * (2 - bombsLeft)
let src = snd $ minimumBy (compare `on` fst) $
[ (dist, s) | s <- myFactories
, dist <- toList $ M.lookup (factoryId s, factoryId dst) links
]
let score = saturate 100.0 $ fromIntegral $ factoryCyborgs dst
pure (score, [SendBomb (factoryId src) (factoryId dst)])
let actions' = actions ++ bombActions
case actions' 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 actions')
saturate :: Double -> Double -> Double
saturate hl x = if x < 0.0 then 0.0 else 1.0 - (2.0 ** (-x / hl))
best :: Ord a => Int -> [(a, b)] -> [(a, b)]
best n = take n . sortBy (flip compare `on` fst)