diff --git a/Contests/CodeBusters/CodeBusters.hs b/Contests/CodeBusters/CodeBusters.hs new file mode 100644 index 0000000..c0a0e07 --- /dev/null +++ b/Contests/CodeBusters/CodeBusters.hs @@ -0,0 +1,158 @@ +{-# 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 + +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) + +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) + +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) } + + 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) + + ambusherId <- newIORef 0 + + 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 theGhosts = filter ((<= (10 + currentStep `div` 5)) . ghostStamina) theGhosts' + + let countGhosts cell = + length $ flip filter theGhosts $ \g → + ptCell (ghostPosition g) == cell + + 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 + + -- MOVE x y | BUST id | RELEASE + forM_ (zip [0..] myBusters) $ \(i, buster) → do + theAmbusherId ← readIORef ambusherId + let ambusher = bustersPerPlayer >= 3 && i == theAmbusherId + let here = busterPosition buster + let distTo = dist here + if busterHasGhost buster && distTo myBase < 1590 then + putStrLn "RELEASE" + else if busterHasGhost buster then do + when (i == theAmbusherId) $ modifyIORef ambusherId ((`mod` bustersPerPlayer) . (+1)) + putStrLn $ unwords ["MOVE", show (fst myBase), show (snd myBase)] + 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))] + +dist ∷ Position → Position → Int +dist (x1, y1) (x2, y2) = round $ sqrt $ fromIntegral ((x2-x1)^2 + (y2-y1)^2) + +busterHasGhost = isJust . busterGhostId