From 399eeff0cf5ff7cbffe48c65f96ea53d349649f7 Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sun, 26 Feb 2017 11:18:44 -0600 Subject: [PATCH] Ghost in the Cell contest -- Bronze League, initial version. --- Contests/GhostInTheCell/GhostInTheCell.hs | 177 ++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 Contests/GhostInTheCell/GhostInTheCell.hs diff --git a/Contests/GhostInTheCell/GhostInTheCell.hs b/Contests/GhostInTheCell/GhostInTheCell.hs new file mode 100644 index 0000000..e5aef4d --- /dev/null +++ b/Contests/GhostInTheCell/GhostInTheCell.hs @@ -0,0 +1,177 @@ +{-# 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) +