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