{-# LANGUAGE ScopedTypeVariables, LambdaCase, ViewPatterns, TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.Array.Unboxed
import Data.Function
import Data.List
import Data.Maybe
import Data.Monoid
import Data.IORef
import Data.STRef
import Debug.Trace
import System.CPUTime
import System.IO
import System.IO.Unsafe
import System.Timeout

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 []
    nPointsRef <- newIORef 10

    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

        startTime <- getCPUTime
        
        let (action, nPts) = findTarget (myX, myY) trail grid' opponents myBackInTimeLeft
        
        -- action: "x y" to move or "BACK rounds" to go back in time
        case action of
            Left  n        -> putStrLn $ "BACK " ++ show n
            Right (tx, ty) -> putStrLn $ unwords $ map show [tx, ty]
        
        stopTime <- getCPUTime
        let diff = stopTime - startTime
        
        hPutStrLn stderr $ show (diff `div` 1000000000) ++ " " ++ show nPts

findTarget :: (Int, Int)
           -> [(Int, Int)]
           -> UArray (Int, Int) Char
           -> [((Int, Int), Bool)]
           -> Bool
           -> (Either Int (Int, Int), Int)
findTarget myPt@(myX,myY) trail grid opponents myBackInTimeLeft =
        (Right $ fromMaybe myPt $ fmap fst $ safeMaximumBy (compare `on` snd) scoredPts, length scoredPts)
    where
        scoredPts = unsafeTimeoutList 90000
                  . map (\pt -> (pt,) $! score pt)
                  . map fst . sortBy (compare `on` snd)
                  . map (\(x,y) -> ((x,y), dist myPt (x,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 :: UArray (Int, Int) Char -> UArray (Int, Int) Int
scoreCells grid = STA.runSTUArray $ do
    scores  <- STA.newArray (bounds grid) 80
    doWhileM_ $ do
        fmap getAny $ flip foldMapA (assocs grid) $ \(p,g) -> do
            v  <- STA.readArray scores p
            nv <- mapM (STA.readArray scores) (neighbours p)
            let outside = 8 - length (neighbours p)
            let free    = count ((=='.') . (grid!)) $ neighbours p
            let mine    = count ((=='0') . (grid!)) $ neighbours p
            let other   = 8 - (outside + mine + free)
            let v' | g == '0'   = 100 + 10*mine + 35*(min 1 $ outside + other) + 10*free
                   | g /= '.'   = 0
                   | isBorder p = 0
                   | otherwise  = min v $ minimum nv + (max 0 $ 2*mine - other) + 1
            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 :: UArray (Int,Int) Char -> (Int, Int) -> (Int, Int) -> UArray (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)

count :: F.Foldable f => (a -> Bool) -> f a -> Int
count f xs = getSum $ F.foldMap (\x -> if f x then Sum 1 else Sum 0) xs

-- Compute elements of the list to WHNF for `t` microseconds.
-- After `t` microseconds, abandon the calculation and terminate
-- the list. Note that this causes the length of the result to depend
-- on timing and system load. Marked "unsafe" for a reason!
unsafeTimeoutList :: Integer -> [a] -> [a]
unsafeTimeoutList t xs = unsafePerformIO $ do
    start <- getCPUTime
    return $ evalUntil (start + (1000000 * t)) xs
    where
        evalUntil end xs = unsafePerformIO $ do
            now <- getCPUTime
            r <- timeout (fromIntegral $ max 0 (end - now) `div` 1000000) $ return $! case xs of
                []     -> []
                (a:as) -> a `seq` (a:as)
            return $ case r of
                Nothing     -> []
                Just []     -> []
                Just (a:as) -> (a : evalUntil end as)

foldMapA :: (Applicative f, F.Foldable t, Monoid v) => (a -> f v) -> t a -> f v
foldMapA f t = F.foldr (\x v -> mappend <$> v <*> f x) (pure mempty) t