nybble
/
CodinGame
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Ghost in the Cell -- refactoring; separate AI from IO.

This commit is contained in:
Jesse D. McDonald 2017-03-01 13:58:50 -06:00
parent 175c641522
commit c0a611f1d4
1 changed files with 157 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

277
Contests/GhostInTheCell/GhostInTheCell.hs
View File

@ -35,10 +35,10 @@ data Troop = Troop { troopId :: EntityId
} deriving (Eq, Show) } deriving (Eq, Show)
data Bomb = Bomb { bombId :: EntityId data Bomb = Bomb { bombId :: EntityId
, bombSender :: PlayerId , bombOwner :: PlayerId
, bombOrigin :: FactoryId , bombOrigin :: FactoryId
, bombTarget :: FactoryId , bombTarget :: FactoryId
, bombDelay :: Int , bombTurnsLeft :: Int
} deriving (Eq, Show) } deriving (Eq, Show)
data Action = Move FactoryId FactoryId Int data Action = Move FactoryId FactoryId Int
@ -47,14 +47,41 @@ data Action = Move FactoryId FactoryId Int
| Wait | Wait
deriving (Eq, Show) 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 = data GameState =
GameState GameState
{ gsLinks :: M.Map (FactoryId, FactoryId) Int { gsLinks :: M.Map (FactoryId, FactoryId) Int
, gsFactories :: [Factory] , gsFactories :: [Factory]
, gsTroops :: [Troop] , gsTroops :: [Troop]
, gsBombs :: [Bomb] , gsBombs :: [Bomb]
, gsMyBombsLeft :: Int , gsBombsLeft :: Int
, gsNextEntity :: EntityId , gsNextEntity :: EntityId
, gsTurnCount :: Int
} deriving (Show) } deriving (Show)
actionString :: Action -> String actionString :: Action -> String
@ -72,21 +99,18 @@ main :: IO ()
main = do main = do
hSetBuffering stdout NoBuffering -- DO NOT REMOVE 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 linkCount <- readLn :: IO Int -- the number of links between factories
links <- fmap (M.fromList . concat) $ replicateM linkCount $ do links <- fmap (M.fromList . concat) $ replicateM linkCount $ do
[f1, f2, dist] <- map read . words <$> getLine [f1, f2, dist] <- map read . words <$> getLine
pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)]) pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)])
bombsLeftRef <- newIORef 2
turnCountRef <- newIORef 1 turnCountRef <- newIORef 1
bombsLeftRef <- newIORef 2
forever $ do forever $ do
turnCount <- readIORef turnCountRef entityCount <- readLn :: IO Int
bombsLeft <- readIORef bombsLeftRef
entityCount <- readLn :: IO Int -- the number of entities (e.g. factories and troops)
(partitionEithers -> (factoryList, partitionEithers -> (troopList, bombList))) <- replicateM entityCount $ do (partitionEithers -> (factoryList, partitionEithers -> (troopList, bombList))) <- replicateM entityCount $ do
((read -> entityId):entityType:(map read -> [a1,a2,a3,a4,a5])) <- words <$> getLine ((read -> entityId):entityType:(map read -> [a1,a2,a3,a4,a5])) <- words <$> getLine
pure $ case entityType of pure $ case entityType of
@ -94,104 +118,101 @@ main = do
"TROOP" -> Right . Left $ Troop entityId a1 a2 a3 a4 a5 "TROOP" -> Right . Left $ Troop entityId a1 a2 a3 a4 a5
"BOMB" -> Right . Right $ Bomb entityId a1 a2 a3 a4 "BOMB" -> Right . Right $ Bomb entityId a1 a2 a3 a4
let nextEntity = (+1) $ maximum $ 0 : map factoryId factoryList let nextEntity = (+1) $ maximum $ 0 : map entityId factoryList
++ map troopId troopList ++ map entityId troopList
++ map bombId bombList ++ map entityId bombList
let gs = GameState { gsLinks = links turnCount <- readIORef turnCountRef
bombsLeft <- readIORef bombsLeftRef
let chosenActions = chooseActions $
GameState { gsLinks = links
, gsFactories = factoryList , gsFactories = factoryList
, gsTroops = troopList , gsTroops = troopList
, gsBombs = bombList , gsBombs = bombList
, gsMyBombsLeft = bombsLeft
, gsNextEntity = nextEntity , gsNextEntity = nextEntity
, gsTurnCount = turnCount
, gsBombsLeft = bombsLeft
} }
let factories = M.fromList [ (factoryId f, f) | f <- factoryList ] case chosenActions of
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 [] -> putStrLn $ actionString Wait
xs -> putStrLn $ intercalate "; " $ map actionString xs xs -> putStrLn $ intercalate "; " $ map actionString xs
let isSendBomb act = case act of { SendBomb _ _ -> True; _ -> False } 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) 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 :: Ord a => Int -> [(a, b)] -> [(a, b)]
best n = take n . sortBy (flip compare `on` fst) 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) scoreGame gs = (fromIntegral myCyborgs + 10 * fromIntegral myProduction + 10 * fromIntegral myFactories)
/ (fromIntegral oppCyborgs + 10 * fromIntegral oppProduction + 10 * fromIntegral oppFactories + 1) / (fromIntegral oppCyborgs + 10 * fromIntegral oppProduction + 10 * fromIntegral oppFactories + 1)
where where
myFactories = length $ filter (\f -> factoryOwner f == thisPlayer) (gsFactories gs) myFactories = length $ filter (\f -> owner f == thisPlayer) (gsFactories gs)
oppFactories = length $ filter (\f -> factoryOwner f == opponent) (gsFactories gs) oppFactories = length $ filter (\f -> owner f == opponent) (gsFactories gs)
((Sum myCyborgs, Sum myProduction), ((Sum myCyborgs, Sum myProduction), (Sum oppCyborgs, Sum oppProduction)) = execWriter $ do
(Sum oppCyborgs, Sum oppProduction)) = execWriter $ do
forM_ (gsFactories gs) $ \f -> do forM_ (gsFactories gs) $ \f -> do
when (factoryOwner f == thisPlayer) $ when (owner f == thisPlayer) $ tell ((Sum (cyborgs f), Sum (factoryProduction f)), mempty)
tell ((Sum (factoryCyborgs f), Sum (factoryProduction f)), mempty) when (owner f == opponent) $ tell (mempty, (Sum (cyborgs f), Sum (factoryProduction f)))
when (factoryOwner f == opponent) $
tell (mempty, (Sum (factoryCyborgs f), Sum (factoryProduction f)))
forM_ (gsTroops gs) $ \t -> do forM_ (gsTroops gs) $ \t -> do
when (troopOwner t == thisPlayer) $ when (owner t == thisPlayer) $ tell ((Sum (cyborgs t), mempty), mempty)
tell ((Sum (troopCyborgs t), mempty), mempty) when (owner t == opponent) $ tell (mempty, (Sum (cyborgs t), mempty))
when (troopOwner t == opponent) $
tell (mempty, (Sum (troopCyborgs t), mempty))
moveTroops, moveBombs, produceCyborgs, moveTroops, moveBombs, produceCyborgs,
solveBattles, explodeBombs :: GameState -> GameState solveBattles, explodeBombs :: GameState -> GameState
moveTroops gs0 = gs0 { gsTroops = map moveTroop (gsTroops gs0) } moveTroops gs0 = gs0 { gsTroops = map (\t -> t { troopTurnsLeft = turnsLeft t - 1 }) (gsTroops gs0) }
where moveBombs gs0 = gs0 { gsBombs = map (\b -> b { bombTurnsLeft = turnsLeft b - 1 }) (gsBombs gs0) }
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 :: [(PlayerId, [Action])] -> GameState -> GameState
processOrders orders gs0 = foldl processOrder gs0 orders processOrders orders gs0 = foldl processOrder gs0 orders
@ -248,15 +259,15 @@ processOrders orders gs0 = foldl processOrder gs0 orders
Increase factory -> processIncrease p factory gs Increase factory -> processIncrease p factory gs
Wait -> gs Wait -> gs
processMove p from to amt gs = processMove p from to amt gs =
gs { gsFactories = map (\f -> if factoryId f /= from then f gs { gsFactories = map (\f -> if entityId f /= from then f
else f { factoryCyborgs = max 0 (factoryCyborgs f - amt) }) else f { factoryCyborgs = max 0 (cyborgs f - amt) })
(gsFactories gs) (gsFactories gs)
, gsTroops = gsTroops gs ++ , gsTroops = gsTroops gs ++
[Troop { troopId = gsNextEntity gs [Troop { troopId = gsNextEntity gs
, troopOwner = p , troopOwner = p
, troopOrigin = from , troopOrigin = from
, troopTarget = to , 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) , troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
}] }]
, gsNextEntity = gsNextEntity gs + 1 , gsNextEntity = gsNextEntity gs + 1
@ -264,61 +275,55 @@ processOrders orders gs0 = foldl processOrder gs0 orders
processBomb p from to gs = processBomb p from to gs =
gs { gsBombs = gsBombs gs ++ gs { gsBombs = gsBombs gs ++
[Bomb { bombId = gsNextEntity gs [Bomb { bombId = gsNextEntity gs
, bombSender = p , bombOwner = p
, bombOrigin = from , bombOrigin = from
, bombTarget = to , bombTarget = to
, bombDelay = fromJust $ M.lookup (from, to) (gsLinks gs) , bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
}] }]
, gsNextEntity = gsNextEntity gs + 1 , gsNextEntity = gsNextEntity gs + 1
} }
processIncrease p factory gs = processIncrease p factory gs =
gs { gsFactories = map (\f -> if factoryId f /= factory || factoryCyborgs f < 10 then f gs { gsFactories = map (\f -> if entityId f /= factory || cyborgs f < 10 then f else
else f { factoryCyborgs = factoryCyborgs f - 10 f { factoryCyborgs = cyborgs f - 10
, factoryProduction = min 3 (factoryProduction f + 1) , factoryProduction = min 3 (factoryProduction f + 1)
}) })
(gsFactories gs) (gsFactories gs)
} }
checkBalances 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!" | otherwise = error "Cyborg count is negative!"
produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) } produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) }
where where
produce f produce f
| factoryDelay f > 0 = f { factoryDelay = factoryDelay f - 1 } | factoryDelay f > 0 = f { factoryDelay = factoryDelay f - 1 }
| otherwise = f { factoryCyborgs = factoryCyborgs f + factoryProduction f } | otherwise = f { factoryCyborgs = cyborgs f + factoryProduction f }
solveBattles gs = solveBattles gs =
gs { gsFactories = map solveFactory (gsFactories gs) gs { gsFactories = map solveFactory (gsFactories gs)
, gsTroops = troopsInTransit , gsTroops = troopsInTransit
} }
where where
(troopsArriving, troopsInTransit) = partition (\t -> troopTurnsLeft t <= 0) (gsTroops gs) (troopsArriving, troopsInTransit) = partition (\t -> turnsLeft t <= 0) (gsTroops gs)
solveFactory f solveFactory f
| attacking > defending = f { factoryOwner = attackingPlayer | attacking > defending = f { factoryOwner = attackingPlayer
, factoryCyborgs = attacking - defending , factoryCyborgs = attacking - defending
} }
| otherwise = f { factoryCyborgs = defending - attacking } | otherwise = f { factoryCyborgs = defending - attacking }
where where
troopsArrivingHere = filter (\t -> troopTarget t == factoryId f) troopsArriving troopsArrivingHere = filter (\t -> target t == entityId f) troopsArriving
defending = factoryCyborgs f + sum (map troopCyborgs $ defending = cyborgs f + sum [ cyborgs t | t <- troopsArrivingHere, owner t == owner f ]
filter (\t -> troopOwner t == factoryOwner f) $ attacking = sum [ cyborgs t | t <- troopsArrivingHere, owner t /= owner f ]
troopsArrivingHere) attackingPlayer = if owner f == opponent then thisPlayer else opponent
attacking = sum (map troopCyborgs $
filter (\t -> troopOwner t /= factoryOwner f) $
troopsArrivingHere)
attackingPlayer = if factoryOwner f == opponent
then thisPlayer
else opponent
explodeBombs gs = explodeBombs gs =
gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived
, gsBombs = bombsInTransit , gsBombs = bombsInTransit
} }
where 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 -> explodeBomb fs b = flip map fs $ \f ->
if factoryId f /= bombTarget b then f else if entityId f /= target b then f else
f { factoryCyborgs = max 0 (factoryCyborgs f - max 10 (factoryCyborgs f `div` 2)) f { factoryCyborgs = max 0 (cyborgs f - max 10 (cyborgs f `div` 2))
, factoryDelay = 5 , factoryDelay = 5
} }