diff --git a/Contests/GhostInTheCell/GhostInTheCell.hs b/Contests/GhostInTheCell/GhostInTheCell.hs index ebd3493..2201edb 100644 --- a/Contests/GhostInTheCell/GhostInTheCell.hs +++ b/Contests/GhostInTheCell/GhostInTheCell.hs @@ -35,10 +35,10 @@ data Troop = Troop { troopId :: EntityId } deriving (Eq, Show) data Bomb = Bomb { bombId :: EntityId - , bombSender :: PlayerId + , bombOwner :: PlayerId , bombOrigin :: FactoryId , bombTarget :: FactoryId - , bombDelay :: Int + , bombTurnsLeft :: Int } deriving (Eq, Show) data Action = Move FactoryId FactoryId Int @@ -47,14 +47,41 @@ data Action = Move FactoryId FactoryId Int | Wait 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 = GameState - { gsLinks :: M.Map (FactoryId, FactoryId) Int - , gsFactories :: [Factory] - , gsTroops :: [Troop] - , gsBombs :: [Bomb] - , gsMyBombsLeft :: Int - , gsNextEntity :: EntityId + { gsLinks :: M.Map (FactoryId, FactoryId) Int + , gsFactories :: [Factory] + , gsTroops :: [Troop] + , gsBombs :: [Bomb] + , gsBombsLeft :: Int + , gsNextEntity :: EntityId + , gsTurnCount :: Int } deriving (Show) actionString :: Action -> String @@ -72,21 +99,18 @@ main :: IO () main = do hSetBuffering stdout NoBuffering -- DO NOT REMOVE - factoryCount <- readLn :: IO Int -- the number of factories + factoryCount <- readLn :: IO Int -- the number of factories (not used) 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 turnCountRef <- newIORef 1 + bombsLeftRef <- newIORef 2 forever $ do - turnCount <- readIORef turnCountRef - bombsLeft <- readIORef bombsLeftRef - entityCount <- readLn :: IO Int -- the number of entities (e.g. factories and troops) - + entityCount <- readLn :: IO Int (partitionEithers -> (factoryList, partitionEithers -> (troopList, bombList))) <- replicateM entityCount $ do ((read -> entityId):entityType:(map read -> [a1,a2,a3,a4,a5])) <- words <$> getLine pure $ case entityType of @@ -94,104 +118,101 @@ main = do "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 nextEntity = (+1) $ maximum $ 0 : map entityId factoryList + ++ map entityId troopList + ++ map entityId bombList - let gs = GameState { gsLinks = links - , gsFactories = factoryList - , gsTroops = troopList - , gsBombs = bombList - , gsMyBombsLeft = bombsLeft - , gsNextEntity = nextEntity - } + turnCount <- readIORef turnCountRef + bombsLeft <- readIORef bombsLeftRef - 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 chosenActions = chooseActions $ + GameState { gsLinks = links + , gsFactories = factoryList + , gsTroops = troopList + , gsBombs = bombList + , gsNextEntity = nextEntity + , gsTurnCount = turnCount + , gsBombsLeft = bombsLeft + } - 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 + 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 bombsLeftRef (subtract $ length $ filter isSendBomb chosenActions) modifyIORef turnCountRef (+1) +awareness, foresight :: Int +awareness = 10 -- number of actions to consider +foresight = 30 -- number of moves to look ahead + +chooseActions :: GameState -> [Action] +chooseActions gs = loop [] (scoreGame (simulate [] foresight gs)) (allFactoryActions ++ bombActions) + where + scoreActions as = scoreGame $ simulate [(thisPlayer, as)] foresight gs + 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 + + myFactories = filter (\f -> owner f == thisPlayer) (gsFactories gs) + + transitMap = M.fromList + [ (to, (mine, theirs)) + | let (myTroops, theirTroops) = partition (\t -> owner t == thisPlayer) (gsTroops gs) + , to <- map entityId (gsFactories gs) + , let mine = sum [ cyborgs t | t <- myTroops, target t == to ] + , let theirs = sum [ cyborgs t | t <- theirTroops, target t == to ] + ] + inTransitTo dst = fromMaybe (0, 0) $ M.lookup dst transitMap + + distributeScores src = do + dst <- myFactories + guard $ entityId dst /= entityId src + let (srcDefending, srcAttacking) = inTransitTo (entityId src) + let (dstDefending, dstAttacking) = inTransitTo (entityId dst) + let srcTotal = cyborgs src - srcAttacking + let dstTotal = cyborgs dst + dstDefending - dstAttacking + let amount = (cyborgs src + 1) `div` 3 + 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 + dst <- filter (\f -> owner f /= thisPlayer) (gsFactories gs) + dist <- toList $ M.lookup (entityId src, entityId dst) (gsLinks gs) + let (mineDefending, theirsAttacking) = inTransitTo (entityId src) + let (mineAttacking, theirsDefending) = inTransitTo (entityId dst) + let myTotal = cyborgs src - theirsAttacking + let theirTotal = cyborgs dst + theirsDefending - mineAttacking + let theirEstimate + | owner dst == neutralPlayer = theirTotal + | otherwise = theirTotal + factoryProduction dst * (1 + dist) + let amount = theirEstimate + 1 + guard $ amount > 0 && amount <= cyborgs src + pure $ Move (entityId src) (entityId dst) amount + + increaseScores src = do + guard $ factoryProduction src < 3 + guard $ cyborgs src >= 10 + pure $ Increase (entityId src) + + factoryActions src = foldr mplus mempty $ map ($ src) $ + [ distributeScores, attackScores, increaseScores ] + + allFactoryActions = concatMap factoryActions myFactories + + bombActions = do + guard $ (gsBombsLeft gs) > 0 && not (null myFactories) + guard $ (gsBombsLeft gs) > 1 || (gsTurnCount gs) > 50 + dst <- filter (\f -> owner f == opponent) (gsFactories gs) + --guard $ cyborgs dst >= 50 + 50 * (2 - (gsBombsLeft gs)) + let src = snd $ minimumBy (compare `on` fst) $ + [ (dist, s) | s <- myFactories + , dist <- toList $ M.lookup (entityId s, entityId dst) (gsLinks gs) + ] + pure $ SendBomb (entityId src) (entityId dst) + best :: Ord a => Int -> [(a, b)] -> [(a, b)] best n = take n . sortBy (flip compare `on` fst) @@ -212,31 +233,21 @@ 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 + 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 (factoryOwner f == thisPlayer) $ - tell ((Sum (factoryCyborgs f), Sum (factoryProduction f)), mempty) - when (factoryOwner f == opponent) $ - tell (mempty, (Sum (factoryCyborgs f), Sum (factoryProduction f))) + 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 (troopOwner t == thisPlayer) $ - tell ((Sum (troopCyborgs t), mempty), mempty) - when (troopOwner t == opponent) $ - tell (mempty, (Sum (troopCyborgs t), mempty)) + 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 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 } +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 orders gs0 = foldl processOrder gs0 orders @@ -248,77 +259,71 @@ processOrders orders gs0 = foldl processOrder gs0 orders 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) }) + gs { gsFactories = map (\f -> if entityId f /= from then f + else f { factoryCyborgs = max 0 (cyborgs 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)) + , troopCyborgs = min amt (sum $ map (\f -> if entityId f == from then cyborgs 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) + [Bomb { bombId = gsNextEntity gs + , bombOwner = p + , bombOrigin = from + , bombTarget = to + , bombTurnsLeft = 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) - }) + gs { gsFactories = map (\f -> if entityId f /= factory || cyborgs f < 10 then f else + f { factoryCyborgs = cyborgs f - 10 + , factoryProduction = min 3 (factoryProduction f + 1) + }) (gsFactories gs) } checkBalances gs - | all (\f -> factoryCyborgs f >= 0) (gsFactories gs) = gs + | all (\f -> cyborgs 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 } + | otherwise = f { factoryCyborgs = cyborgs f + factoryProduction f } solveBattles gs = gs { gsFactories = map solveFactory (gsFactories gs) , gsTroops = troopsInTransit } where - (troopsArriving, troopsInTransit) = partition (\t -> troopTurnsLeft t <= 0) (gsTroops gs) + (troopsArriving, troopsInTransit) = partition (\t -> turnsLeft 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 + troopsArrivingHere = filter (\t -> target t == entityId f) troopsArriving + defending = cyborgs f + sum [ cyborgs t | t <- troopsArrivingHere, owner t == owner f ] + attacking = sum [ cyborgs t | t <- troopsArrivingHere, owner t /= owner f ] + attackingPlayer = if owner 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) + (bombsArrived, bombsInTransit) = partition (\b -> turnsLeft 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 - } + if entityId f /= target b then f else + f { factoryCyborgs = max 0 (cyborgs f - max 10 (cyborgs f `div` 2)) + , factoryDelay = 5 + }