diff --git a/Contests/CodeBusters/CodeBusters.hs b/Contests/CodeBusters/CodeBusters.hs index c0a0e07..1c32713 100644 --- a/Contests/CodeBusters/CodeBusters.hs +++ b/Contests/CodeBusters/CodeBusters.hs @@ -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