{-# LANGUAGE ScopedTypeVariables, LambdaCase, UnicodeSyntax #-} import Control.Applicative import Control.Monad import Data.Array import Data.Either import Data.Function import Data.Functor.Identity import Data.IORef import Data.List import Data.Maybe import Debug.Trace import System.IO import qualified Data.Map as M type Team = Int type BusterId = Int type GhostId = Int type Position = (Int, Int) data Buster = Buster { busterId ∷ Int , busterPosition ∷ Position , busterTeam ∷ Team , busterGhostId ∷ Maybe Int , busterStunned ∷ Maybe Int } deriving (Show) data Ghost = Ghost { ghostId ∷ Int , ghostPosition ∷ Position , ghostBustersTied ∷ 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 { ghostId = entityId , ghostPosition = (x, y) , ghostBustersTied = value , ghostStamina = state } | otherwise = buster $ Buster { busterId = entityId , busterPosition = (x, y) , busterTeam = entityType , busterGhostId = if state == 1 then Just value else Nothing , busterStunned = if state == 2 then Just value else Nothing } 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 -- Send your busters out into the fog to trap ghosts and bring them home! -- Team 0 is top left, team 1 is bottom right. bustersPerPlayer ∷ Int ← readLn ghostCount ∷ Int ← readLn myTeamId ∷ Int ← readLn let theCenter = (8000, 4500) let myBase = case myTeamId of { 0 → (0, 0); 1 → (16000, 9000) } let theirBase = case myTeamId of { 1 → (1500, 1500); 0 → (14500, 7500) } 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) memory ← newIORef $ M.empty stunners ← newIORef [] ambusherId ← newIORef Nothing forM_ [1..] $ \currentStep → do numEntities ∷ Int ← readLn entities ← replicateM numEntities (readEntity Left Right <$> getLine) let myBusters = filter ((== myTeamId) . busterTeam) $ lefts entities let theirBusters = filter ((/= myTeamId) . busterTeam) $ lefts entities let theGhosts = rights entities let inView pos = any (\b → dist pos (busterPosition b) < 2000) myBusters 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) → (putStrLn . formatAction =<<) $ do canStun ← isNothing . lookup (busterId buster) <$> readIORef stunners modifyIORef' ambusherId (<|> Just (busterId buster)) theAmbusherId ← readIORef ambusherId let ambusher = bustersPerPlayer >= 3 && Just i == theAmbusherId let here = busterPosition buster let distTo = dist here 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 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 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