125 lines
4.6 KiB
Haskell
125 lines
4.6 KiB
Haskell
{-# LANGUAGE ScopedTypeVariables, LambdaCase, ViewPatterns, TupleSections #-}
|
|
|
|
import System.IO
|
|
import Control.Applicative
|
|
import Control.Arrow
|
|
import Control.Monad
|
|
import Data.Array
|
|
import Data.Function
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Data.IORef
|
|
import Data.STRef
|
|
import Debug.Trace
|
|
|
|
import qualified Data.Array.ST as STA
|
|
import qualified Data.Foldable as F
|
|
import qualified Data.Traversable as T
|
|
import qualified Data.Set as S
|
|
|
|
main :: IO ()
|
|
main = do
|
|
hSetBuffering stdout NoBuffering -- DO NOT REMOVE
|
|
opponentCount <- readLn
|
|
|
|
trailRef <- newIORef []
|
|
|
|
forever $ do
|
|
(gameRound :: Int) <- readLn
|
|
[read -> (myX :: Int), read -> (myY :: Int), (/= 0) . read -> myBackInTimeLeft]
|
|
<- words <$> getLine
|
|
|
|
opponents <- replicateM opponentCount $ do
|
|
[read -> (x :: Int), read -> (y :: Int), (/= 0) . read -> backInTimeLeft]
|
|
<- words <$> getLine
|
|
return ((x, y), backInTimeLeft)
|
|
|
|
-- '.' for empty, '0' for me, otherwise ID of opponent
|
|
grid <- fmap (array ((0,0),(34,19)) . concat) $ forM [0..19] $ \y ->
|
|
zipWith (\x c -> ((x,y),c)) [0..] <$> getLine
|
|
|
|
modifyIORef trailRef (((myX, myY):) . take 2)
|
|
trail <- readIORef trailRef
|
|
|
|
-- treat recent "collisions" as occupied spaces
|
|
let grid' = accum (\c _ -> if c == '.' then 'X' else c) grid $ map (,()) trail
|
|
|
|
-- action: "x y" to move or "BACK rounds" to go back in time
|
|
case findTarget (myX, myY) trail grid' opponents myBackInTimeLeft of
|
|
Left n -> putStrLn $ "BACK " ++ show n
|
|
Right (tx, ty) -> putStrLn $ unwords $ map show [tx, ty]
|
|
|
|
findTarget :: (Int, Int)
|
|
-> [(Int, Int)]
|
|
-> Array (Int, Int) Char
|
|
-> [((Int, Int), Bool)]
|
|
-> Bool
|
|
-> Either Int (Int, Int)
|
|
findTarget myPt@(myX,myY) trail grid opponents myBackInTimeLeft =
|
|
Right $ fromMaybe myPt $ fmap fst $ safeMaximumBy (compare `on` snd) scoredPts
|
|
where
|
|
scoredPts = map (\pt -> (pt, score pt)) . take 50
|
|
. map fst . sortBy (compare `on` snd)
|
|
. map (\(x,y) -> ((x,y), dist myPt (x,y) + fromIntegral (abs (myX-x) + abs (myY-y))))
|
|
. filter (\p -> inRange (bounds grid) p && grid!p == '.')
|
|
$ indices grid
|
|
baseScore = scoreGrid' myPt grid
|
|
score pt = (scoreGrid' pt (updateGrid grid myPt pt) - baseScore) / (dist myPt pt ** 2)
|
|
scoreGrid' pt grid = scoreGrid grid
|
|
+ 3 * sum (map (sqrt . dist pt . fst) opponents)
|
|
dist (x0,y0) (x1,y1) = fromIntegral (abs (x1-x0) + abs (y1-y0))
|
|
|
|
diagonals (x0,y0) i =
|
|
[ (x0+i, y0 )
|
|
, (x0+i, y0-i)
|
|
, (x0, y0-i)
|
|
, (x0-i, y0-i)
|
|
, (x0-i, y0 )
|
|
, (x0-i, y0+i)
|
|
, (x0, y0+i)
|
|
, (x0+i, y0+i)
|
|
]
|
|
|
|
scoreCells :: Array (Int, Int) Char -> Array (Int, Int) Int
|
|
scoreCells grid = STA.runSTArray $ do
|
|
scores <- STA.newArray (bounds grid) 100
|
|
doWhileM_ $ fmap getAny $ liftM F.fold $ T.forM (assocs grid) $ \(p,g) -> do
|
|
v <- STA.readArray scores p
|
|
nv <- mapM (STA.readArray scores) (neighbours p)
|
|
let v' | g == '0' = 400
|
|
| g /= '.' = 0
|
|
| isBorder p = 5
|
|
| otherwise = min v $ 5 + minimum nv
|
|
when (v' /= v) $ STA.writeArray scores p v'
|
|
return $ Any (v' /= v)
|
|
return scores
|
|
where
|
|
isBorder (x,y) = x == xMin || x == xMax || y == yMin || y == yMax
|
|
where ((xMin,yMin),(xMax,yMax)) = bounds grid
|
|
neighbours (x,y) = filter (inRange $ bounds grid) (diagonals (x,y) 1)
|
|
|
|
scoreGrid grid = sum $ map (sqrt . fromIntegral) $ elems $ scoreCells grid
|
|
|
|
findPath from@(fromX, fromY) to@(toX, toY)
|
|
| from == to = [to]
|
|
| fromX == toX = from : findPath (fromX, if fromY < toY then fromY+1 else fromY-1) to
|
|
| otherwise = from : findPath (if fromX < toX then fromX+1 else fromX-1, fromY) to
|
|
|
|
updateGrid :: Array (Int,Int) Char -> (Int, Int) -> (Int, Int) -> Array (Int,Int) Char
|
|
updateGrid grid from to = accum update grid $ map (,()) $ findPath from to
|
|
where update c _ = if c == '.' then '0' else c
|
|
|
|
safeMaximumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
|
|
safeMaximumBy _ [] = Nothing
|
|
safeMaximumBy f xs = Just $ maximumBy f xs
|
|
|
|
safeMinimumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
|
|
safeMinimumBy _ [] = Nothing
|
|
safeMinimumBy f xs = Just $ minimumBy f xs
|
|
|
|
whileM_ :: Monad m => m Bool -> m a -> m ()
|
|
whileM_ mc m = mc >>= \c -> when c (m >> whileM_ mc m)
|
|
|
|
doWhileM_ :: Monad m => m Bool -> m ()
|
|
doWhileM_ mc = mc >>= \c -> when c (doWhileM_ mc) |