From 175c641522bfa75a5cb27640f725582eb714129a Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Mon, 27 Feb 2017 22:45:39 -0600 Subject: [PATCH] Ghost in the Cell contest -- simulator version --- Contests/GhostInTheCell/GhostInTheCell.hs | 371 +++++++++++++++------- 1 file changed, 259 insertions(+), 112 deletions(-) diff --git a/Contests/GhostInTheCell/GhostInTheCell.hs b/Contests/GhostInTheCell/GhostInTheCell.hs index e5aef4d..ebd3493 100644 --- a/Contests/GhostInTheCell/GhostInTheCell.hs +++ b/Contests/GhostInTheCell/GhostInTheCell.hs @@ -1,15 +1,17 @@ -{-# LANGUAGE ViewPatterns, LambdaCase, DataKinds, GADTs #-} +{-# LANGUAGE ViewPatterns #-} import System.IO import Control.Applicative -import Control.Arrow (first, second) +import Control.Arrow (first, second, (>>>)) import Control.Monad +import Control.Monad.Writer import Data.Either import Data.Foldable import Data.Function import Data.IORef import Data.List import Data.Maybe +import Data.Monoid import qualified Data.Map as M @@ -23,7 +25,7 @@ data Factory = Factory { factoryId :: EntityId , factoryProduction :: Int , factoryDelay :: Int } deriving (Eq, Show) - + data Troop = Troop { troopId :: EntityId , troopOwner :: PlayerId , troopOrigin :: FactoryId @@ -45,6 +47,16 @@ data Action = Move FactoryId FactoryId Int | Wait deriving (Eq, Show) +data GameState = + GameState + { gsLinks :: M.Map (FactoryId, FactoryId) Int + , gsFactories :: [Factory] + , gsTroops :: [Troop] + , gsBombs :: [Bomb] + , gsMyBombsLeft :: Int + , gsNextEntity :: EntityId + } 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] @@ -58,120 +70,255 @@ 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 + hSetBuffering stdout NoBuffering -- DO NOT REMOVE - 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]) + factoryCount <- readLn :: IO Int -- the number of factories + linkCount <- readLn :: IO Int -- the number of links between factories - 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]) + 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)]) - let increaseScores src = do - guard $ factoryProduction src < 3 - guard $ factoryCyborgs src >= 10 - let score = saturate 10.0 $ fromIntegral myTotalProduction - pure (score, [Increase (factoryId src)]) + bombsLeftRef <- newIORef 2 + turnCountRef <- newIORef 1 - 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') + forever $ do + turnCount <- readIORef turnCountRef + bombsLeft <- readIORef bombsLeftRef + entityCount <- readLn :: IO Int -- the number of entities (e.g. factories and troops) -saturate :: Double -> Double -> Double -saturate hl x = if x < 0.0 then 0.0 else 1.0 - (2.0 ** (-x / hl)) + (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 nextEntity = (+1) $ maximum $ 0 : map factoryId factoryList + ++ map troopId troopList + ++ map bombId bombList + + let gs = GameState { gsLinks = links + , gsFactories = factoryList + , gsTroops = troopList + , gsBombs = bombList + , gsMyBombsLeft = bombsLeft + , gsNextEntity = nextEntity + } + + 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 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 + let amount = (factoryCyborgs src + 1) `div` 3 + guard $ amount > 0 && amount <= factoryCyborgs src + dist <- toList $ M.lookup (factoryId src, factoryId dst) links + pure $ Move (factoryId src) (factoryId dst) amount + + let attackScores src = do + 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) + let amount = theirEstimate + 1 + guard $ amount > 0 && amount <= factoryCyborgs src + pure $ Move (factoryId src) (factoryId dst) amount + + let increaseScores src = do + guard $ factoryProduction src < 3 + guard $ factoryCyborgs src >= 10 + pure $ Increase (factoryId src) + + let factoryActions src = foldr mplus mempty $ map ($ src) $ + [ distributeScores, attackScores, increaseScores ] + + let actions = concatMap factoryActions myFactories + + let bombActions = do + guard $ bombsLeft > 0 && not (null myFactories) + guard $ bombsLeft > 1 || turnCount > 50 + 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 + ] + pure $ SendBomb (factoryId src) (factoryId dst) + + remainingActions <- newIORef (actions ++ bombActions) + chosenActions <- newIORef [] + projScore <- newIORef (scoreGame (simulate [] 20 gs)) + + fix $ \loop -> do + cs <- readIORef chosenActions + as <- readIORef remainingActions + sc <- readIORef projScore + let scoredActions = map (\a -> (scoreGame (simulate [(thisPlayer, cs++[a])] 20 gs), a)) as + case best 10 scoredActions of + [] -> pure () + (sc',a):rs -> when (sc' > sc) $ do + writeIORef chosenActions (cs ++ [a]) + writeIORef remainingActions (map snd rs) + writeIORef projScore sc' + loop + + chosenActions' <- readIORef chosenActions + case chosenActions' 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 chosenActions') + modifyIORef turnCountRef (+1) best :: Ord a => Int -> [(a, b)] -> [(a, b)] best n = take n . sortBy (flip compare `on` fst) - + +gameTurn :: [(PlayerId, [Action])] -> GameState -> GameState +gameTurn orders = moveTroops + >>> moveBombs + >>> processOrders orders + >>> produceCyborgs + >>> solveBattles + >>> explodeBombs + +simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState +simulate orders n gs + | n > 0 = simulate [] (n-1) (gameTurn orders gs) + | 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 -> factoryOwner f == thisPlayer) (gsFactories gs) + oppFactories = length $ filter (\f -> factoryOwner f == opponent) (gsFactories gs) + ((Sum myCyborgs, Sum myProduction), + (Sum oppCyborgs, Sum oppProduction)) = execWriter $ do + forM_ (gsFactories gs) $ \f -> do + when (factoryOwner f == thisPlayer) $ + tell ((Sum (factoryCyborgs f), Sum (factoryProduction f)), mempty) + when (factoryOwner f == opponent) $ + tell (mempty, (Sum (factoryCyborgs f), Sum (factoryProduction f))) + forM_ (gsTroops gs) $ \t -> do + when (troopOwner t == thisPlayer) $ + tell ((Sum (troopCyborgs t), mempty), mempty) + when (troopOwner t == opponent) $ + tell (mempty, (Sum (troopCyborgs t), mempty)) + +moveTroops, moveBombs, produceCyborgs, + solveBattles, explodeBombs :: GameState -> GameState + +moveTroops gs0 = gs0 { gsTroops = map moveTroop (gsTroops gs0) } + where + moveTroop t = t { troopTurnsLeft = troopTurnsLeft t - 1 } + +moveBombs gs0 = gs0 { gsBombs = map moveBomb (gsBombs gs0) } + where + moveBomb b = b { bombDelay = bombDelay b - 1 } + +processOrders :: [(PlayerId, [Action])] -> GameState -> GameState +processOrders orders gs0 = foldl processOrder gs0 orders + where + processOrder gs (p, as) = foldl (processAction p) gs as + processAction p gs a = checkBalances $ case a of + Move from to amt -> processMove p from to amt gs + SendBomb from to -> processBomb p from to gs + Increase factory -> processIncrease p factory gs + Wait -> gs + processMove p from to amt gs = + gs { gsFactories = map (\f -> if factoryId f /= from then f + else f { factoryCyborgs = max 0 (factoryCyborgs f - amt) }) + (gsFactories gs) + , gsTroops = gsTroops gs ++ + [Troop { troopId = gsNextEntity gs + , troopOwner = p + , troopOrigin = from + , troopTarget = to + , troopCyborgs = min amt (sum $ map (\f -> if factoryId f == from then factoryCyborgs f else 0) (gsFactories gs)) + , troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs) + }] + , gsNextEntity = gsNextEntity gs + 1 + } + processBomb p from to gs = + gs { gsBombs = gsBombs gs ++ + [Bomb { bombId = gsNextEntity gs + , bombSender = p + , bombOrigin = from + , bombTarget = to + , bombDelay = fromJust $ M.lookup (from, to) (gsLinks gs) + }] + , gsNextEntity = gsNextEntity gs + 1 + } + processIncrease p factory gs = + gs { gsFactories = map (\f -> if factoryId f /= factory || factoryCyborgs f < 10 then f + else f { factoryCyborgs = factoryCyborgs f - 10 + , factoryProduction = min 3 (factoryProduction f + 1) + }) + (gsFactories gs) + } + checkBalances gs + | all (\f -> factoryCyborgs f >= 0) (gsFactories gs) = gs + | otherwise = error "Cyborg count is negative!" + +produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) } + where + produce f + | factoryDelay f > 0 = f { factoryDelay = factoryDelay f - 1 } + | otherwise = f { factoryCyborgs = factoryCyborgs f + factoryProduction f } + +solveBattles gs = + gs { gsFactories = map solveFactory (gsFactories gs) + , gsTroops = troopsInTransit + } + where + (troopsArriving, troopsInTransit) = partition (\t -> troopTurnsLeft t <= 0) (gsTroops gs) + solveFactory f + | attacking > defending = f { factoryOwner = attackingPlayer + , factoryCyborgs = attacking - defending + } + | otherwise = f { factoryCyborgs = defending - attacking } + where + troopsArrivingHere = filter (\t -> troopTarget t == factoryId f) troopsArriving + defending = factoryCyborgs f + sum (map troopCyborgs $ + filter (\t -> troopOwner t == factoryOwner f) $ + troopsArrivingHere) + attacking = sum (map troopCyborgs $ + filter (\t -> troopOwner t /= factoryOwner f) $ + troopsArrivingHere) + attackingPlayer = if factoryOwner f == opponent + then thisPlayer + else opponent + +explodeBombs gs = + gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived + , gsBombs = bombsInTransit + } + where + (bombsArrived, bombsInTransit) = partition (\b -> bombDelay b <= 0) (gsBombs gs) + explodeBomb fs b = flip map fs $ \f -> + if factoryId f /= bombTarget b then f else + f { factoryCyborgs = max 0 (factoryCyborgs f - max 10 (factoryCyborgs f `div` 2)) + , factoryDelay = 5 + }