CodeBusters contest - Gold League, 234/1984, final version.
This commit is contained in:
parent
f86959d9b2
commit
021f5e7b47
|
|
@ -12,6 +12,8 @@ import Data.Maybe
|
|||
import Debug.Trace
|
||||
import System.IO
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
type Team = Int
|
||||
type BusterId = Int
|
||||
type GhostId = Int
|
||||
|
|
@ -30,6 +32,8 @@ data Ghost = Ghost { ghostId ∷ Int
|
|||
, ghostStamina ∷ Int
|
||||
} deriving (Show)
|
||||
|
||||
data Action = Release | Stun BusterId | Bust GhostId | MoveTo Position deriving (Eq, Ord, Show)
|
||||
|
||||
readEntity ∷ (Buster → a) → (Ghost → a) → String → a
|
||||
readEntity buster ghost str
|
||||
| entityType == -1 = ghost $ Ghost
|
||||
|
|
@ -47,6 +51,13 @@ readEntity buster ghost str
|
|||
}
|
||||
where [entityId, x, y, entityType, state, value] = map read (words str)
|
||||
|
||||
formatAction ∷ Action → String
|
||||
formatAction = \case
|
||||
Release → "RELEASE"
|
||||
Stun bId → "STUN " ++ show bId
|
||||
Bust gId → "BUST " ++ show gId
|
||||
MoveTo (x, y) → "MOVE " ++ show x ++ " " ++ show y
|
||||
|
||||
main ∷ IO ()
|
||||
main = do
|
||||
hSetBuffering stdout NoBuffering -- DO NOT REMOVE
|
||||
|
|
@ -61,11 +72,13 @@ main = do
|
|||
let myBase = case myTeamId of { 0 → (0, 0); 1 → (16000, 9000) }
|
||||
let theirBase = case myTeamId of { 1 → (1500, 1500); 0 → (14500, 7500) }
|
||||
|
||||
memory ← newIORef $ array ((0,0),(15,8)) [ ((x,y),(0,0)) | x ← [0..15], y ← [0..8] ]
|
||||
let ptCell (x, y) = (max 0 (min 15 (x `div` 1000)), max 0 (min 8 (y `div` 1000)))
|
||||
let cellCenter (x, y) = (1000 * x + 500, 1000 * y + 500)
|
||||
visited ← newIORef $ array ((0,0),(29,17)) [ ((x,y),-50) | x ← [0..29], y ← [0..17] ]
|
||||
let cellCenter (x, y) = (500 * x + 250, 500 * y + 250)
|
||||
|
||||
ambusherId <- newIORef 0
|
||||
memory ← newIORef $ M.empty
|
||||
|
||||
stunners ← newIORef []
|
||||
ambusherId ← newIORef Nothing
|
||||
|
||||
forM_ [1..] $ \currentStep → do
|
||||
numEntities ∷ Int ← readLn
|
||||
|
|
@ -74,85 +87,71 @@ main = do
|
|||
|
||||
let myBusters = filter ((== myTeamId) . busterTeam) $ lefts entities
|
||||
let theirBusters = filter ((/= myTeamId) . busterTeam) $ lefts entities
|
||||
let theGhosts' = rights entities
|
||||
let theGhosts = filter ((<= (10 + currentStep `div` 5)) . ghostStamina) theGhosts'
|
||||
let theGhosts = rights entities
|
||||
|
||||
let countGhosts cell =
|
||||
length $ flip filter theGhosts $ \g →
|
||||
ptCell (ghostPosition g) == cell
|
||||
let inView pos = any (\b → dist pos (busterPosition b) < 2000) myBusters
|
||||
|
||||
modifyIORef' memory $ \arr → runIdentity $ do
|
||||
let allCells = indices arr
|
||||
let coveredCells =
|
||||
flip filter allCells $ \c →
|
||||
flip any myBusters $ \b →
|
||||
dist (cellCenter c) (busterPosition b) < 1490
|
||||
let knownCells = [ (c, (currentStep, 0)) | c ← coveredCells ]
|
||||
return $! accum (\(t,n) m → (t, max n m)) (arr // knownCells) $
|
||||
map (\c → (c, countGhosts c)) allCells
|
||||
modifyIORef' visited $ \arr →
|
||||
let coveredCells = filter (inView . cellCenter) (indices arr) in
|
||||
arr // [ (c, currentStep) | c ← coveredCells ]
|
||||
|
||||
modifyIORef' memory $ \mem →
|
||||
let scrubbed = M.filter (not . inView . ghostPosition . snd) mem in
|
||||
foldl (\m g → M.insert (ghostId g) (currentStep, g) m) scrubbed theGhosts
|
||||
|
||||
modifyIORef' stunners $ filter ((> currentStep) . snd)
|
||||
|
||||
-- MOVE x y | BUST id | RELEASE
|
||||
forM_ (zip [0..] myBusters) $ \(i, buster) → do
|
||||
forM_ (zip [0..] myBusters) $ \(i, buster) → (putStrLn . formatAction =<<) $ do
|
||||
canStun ← isNothing . lookup (busterId buster) <$> readIORef stunners
|
||||
modifyIORef' ambusherId (<|> Just (busterId buster))
|
||||
theAmbusherId ← readIORef ambusherId
|
||||
let ambusher = bustersPerPlayer >= 3 && i == theAmbusherId
|
||||
let ambusher = bustersPerPlayer >= 3 && Just i == theAmbusherId
|
||||
let here = busterPosition buster
|
||||
let distTo = dist here
|
||||
if busterHasGhost buster && distTo myBase < 1590 then
|
||||
putStrLn "RELEASE"
|
||||
let threats = [ b | b ← theirBusters, distTo (busterPosition b) < 1760, isNothing (busterStunned b) ]
|
||||
let targets = [ b | b ← theirBusters, distTo (busterPosition b) < 1760, busterHasGhost b ]
|
||||
if isJust (busterStunned buster) then do
|
||||
when ambusher $ writeIORef ambusherId Nothing
|
||||
pure $ MoveTo myBase
|
||||
else if busterHasGhost buster && distTo myBase < 1590 then
|
||||
pure Release
|
||||
else if busterHasGhost buster && canStun && not (null threats) then do
|
||||
modifyIORef' stunners $ (:) (busterId buster, currentStep + 20)
|
||||
pure $ Stun $ busterId $ minimumBy (compare `on` distTo . busterPosition) threats
|
||||
else if busterHasGhost buster then do
|
||||
when (i == theAmbusherId) $ modifyIORef ambusherId ((`mod` bustersPerPlayer) . (+1))
|
||||
putStrLn $ unwords ["MOVE", show (fst myBase), show (snd myBase)]
|
||||
when ambusher $ writeIORef ambusherId Nothing
|
||||
pure $ MoveTo myBase
|
||||
else if canStun && not (null targets) then do
|
||||
modifyIORef' stunners $ (:) (busterId buster, currentStep + 20)
|
||||
pure $ Stun $ busterId $ head targets
|
||||
else do
|
||||
let isStunnable b = busterHasGhost b && distTo (busterPosition b) < 1760
|
||||
case filter isStunnable theirBusters of
|
||||
(b:_) → putStrLn $ unwords ["STUN", show (busterId b)]
|
||||
[] → do
|
||||
let nearGhosts' = filter ((< 1760) . distTo . ghostPosition) theGhosts
|
||||
let nearGhosts = if not ambusher then nearGhosts'
|
||||
else filter ((<= 2) . ghostStamina) nearGhosts'
|
||||
let eligible = filter ((> 900) . distTo . ghostPosition) nearGhosts
|
||||
if null nearGhosts then
|
||||
if ambusher then
|
||||
putStrLn $ unwords ["MOVE", show (fst theirBase), show (snd theirBase)]
|
||||
else if null theGhosts then do
|
||||
arr ← readIORef memory
|
||||
let ghostCells = filter (\c → snd (arr!c) > 0) (indices arr)
|
||||
if null ghostCells then do
|
||||
let sumAges c = sum $ [ fromIntegral age / fromIntegral (d + 500)
|
||||
| (c',(t,_)) ← assocs arr
|
||||
, let age = currentStep - t
|
||||
, let d = dist (cellCenter c) (cellCenter c')
|
||||
, d < 1490
|
||||
]
|
||||
let score c = sumAges c / fromIntegral (1000 + distTo (cellCenter c))
|
||||
let (x, y) = cellCenter $ maximumBy (compare `on` score) (indices arr)
|
||||
putStrLn $ unwords ["MOVE", show x, show y]
|
||||
else do
|
||||
let (x, y) = minimumBy (compare `on` distTo) $ map cellCenter ghostCells
|
||||
putStrLn $ unwords ["MOVE", show x, show y]
|
||||
-- let θ = atan2 (fromIntegral $ snd theCenter - snd here)
|
||||
-- (fromIntegral $ fst here - fst theCenter)
|
||||
-- let θ' = if even i then θ + (pi / 12) else θ - (pi / 12)
|
||||
-- let rStep = case bustersPerPlayer of { 2 → 4800; 3 → 2400; 4 → 1600; 5 → 1200 }
|
||||
-- let r' = 2200 + rStep * fromIntegral i
|
||||
-- let x' = max 1800 $ min (16000-1800) $ fst theCenter + round (r' * cos θ')
|
||||
-- let y' = max 1800 $ min (9000-1800) $ snd theCenter - round (r' * sin θ')
|
||||
-- putStrLn $ unwords ["MOVE", show x', show y']
|
||||
else do
|
||||
let closest = minimumBy (compare `on` (\g -> 800 * ghostStamina g + distTo (ghostPosition g))) theGhosts
|
||||
let there = ghostPosition closest
|
||||
if distTo there < 900 then
|
||||
putStrLn $ unwords ["MOVE", show (2 * fst here - fst there), show (2 * snd here - snd there)]
|
||||
else
|
||||
putStrLn $ unwords ["MOVE", show (fst there), show (snd there)]
|
||||
else if null eligible then do
|
||||
let farthest = maximumBy (compare `on` distTo . ghostPosition) nearGhosts
|
||||
let there = ghostPosition farthest
|
||||
putStrLn $ unwords ["MOVE", show (2 * fst here - fst there), show (2 * snd here - snd there)]
|
||||
else
|
||||
putStrLn $ unwords ["BUST", show (ghostId (head eligible))]
|
||||
visitArr ← readIORef visited
|
||||
let sumAges c = sum [ fromIntegral (min 100 $ currentStep - t) -- * (500 / fromIntegral (500 + d))
|
||||
| (c', t) ← assocs visitArr, let d = dist (cellCenter c) (cellCenter c'), d < 1000 ]
|
||||
let scoreCell c = 667 * (sumAges c / 1000) * (500 / fromIntegral (500 + distTo (cellCenter c)))
|
||||
let mapScores = [ (MoveTo $ cellCenter c, scoreCell c) | c ← indices visitArr ]
|
||||
let scoreGhost g = 800 * (5000 / fromIntegral (5000 + distTo (ghostPosition g))) * (4 / fromIntegral (4 + ghostStamina g))
|
||||
let adjust (x, y) = let (x0, y0) = here; (dx, dy) = (x0 - x, y0 - y); d = sqrt (fromIntegral (dx^2 + dy^2)) + 0.01 in
|
||||
let (dx', dy') = (1000 * (fromIntegral dx + 0.01) / d, 1000 * (fromIntegral dy + 0.01) / d) in
|
||||
(x + round dx', y + round dy')
|
||||
knownGhosts ← map snd . M.elems <$> readIORef memory
|
||||
let ghostScores = [ (MoveTo (adjust (ghostPosition g)), scoreGhost g) | g ← knownGhosts ]
|
||||
let followScores = [ (MoveTo (adjust (busterPosition b)), prio * (2000 / (2000 + fromIntegral d)))
|
||||
| b ← theirBusters, let d = distTo (busterPosition b), let prio = if busterHasGhost b then 850 else 200 ]
|
||||
let bustScores = [ (Bust (ghostId g), 1000 * 4 / (4 + fromIntegral (ghostStamina g)))
|
||||
| g ← knownGhosts, let d = distTo (ghostPosition g), d > 900, d < 1760 ]
|
||||
let ambushScores = if ambusher then [(MoveTo theirBase, 300)] else []
|
||||
traceM $ ("M: " ++) $ show $ take 3 $ sortBy (flip compare) $ map (round . snd) $ mapScores
|
||||
traceM $ ("G: " ++) $ show $ take 3 $ sortBy (flip compare) $ map (round . snd) $ ghostScores
|
||||
traceM $ ("F: " ++) $ show $ take 3 $ sortBy (flip compare) $ map (round . snd) $ followScores
|
||||
traceM $ ("B: " ++) $ show $ take 3 $ sortBy (flip compare) $ map (round . snd) $ bustScores
|
||||
pure $ fst $ maximumBy (compare `on` snd) $ concat [mapScores, ghostScores, bustScores, followScores, ambushScores ]
|
||||
|
||||
dist ∷ Position → Position → Int
|
||||
dist (x1, y1) (x2, y2) = round $ sqrt $ fromIntegral ((x2-x1)^2 + (y2-y1)^2)
|
||||
|
||||
busterHasGhost = isJust . busterGhostId
|
||||
|
||||
count ∷ (a → Bool) → [a] → Int
|
||||
count = (length .) . filter
|
||||
|
|
|
|||
Loading…
Reference in New Issue