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

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.Random
import System.Timeout

import qualified Data.Array.ST    as STA
import qualified Data.Foldable    as F
import qualified Data.Traversable as T

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering -- DO NOT REMOVE
    opponentCount <- readLn
    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
        
        let claim c pt grid = if grid!pt == '.' then grid // [(pt,c)] else grid

        startTime <- getCPUTime
        
        gen <- newStdGen
        let (action, nPts) = findTarget (myX, myY) (claim 'X' (myX,myY) grid) opponents myBackInTimeLeft gen
        
        -- 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 :: RandomGen g
           => (Int, Int)
           -> UArray (Int, Int) Char
           -> [((Int, Int), Bool)]
           -> Bool
           -> g
           -> (Either Int (Int, Int), Int)
findTarget myPt@(myX,myY) grid opponents myBackInTimeLeft gen =
        (Right $ fromMaybe myPt $ fmap fst $ safeMaximumBy (compare `on` snd) scoredPts, length scoredPts)
    where
        scoredPts = unsafeTimeoutList 90000
                  . map (\pt -> let rt = bestRoute grid myPt pt in (head rt,) $! score rt)
                  . map fst . sortBy (compare `on` snd)
                  . map (\(r, (x,y)) -> ((x,y), r + dist myPt (x,y)))
                  . zip (randomRs (0, 2.0::Double) gen)
                  . filter (\p -> inRange (bounds grid) p && grid!p == '.')
                  $ indices grid
        baseScore = scoreGrid' myPt grid
        score rt = (scoreGrid' (last rt) (updateGrid grid rt) - baseScore) / (fromIntegral (length rt) ** 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))

neighbours :: (Int,Int) -> Int -> [(Int,Int)]
neighbours (x0,y0) n =
    [0..2*n-1] >>= \i ->
        [ (x0-n+i,y0-n)
        , (x0+n,y0-n+i)
        , (x0+n-i,y0+n)
        , (x0-n,y0+n-i)
        ]

bestRoute :: UArray (Int,Int) Char -> (Int,Int) -> (Int,Int) -> [(Int,Int)]
bestRoute grid from@(x0,y0) to@(x1,y1) =
        if freeCells rt1 < freeCells rt2 then rt2 else rt1
    where
        freeCells = count (\p -> grid!p == '.')
        rt1 = map (,y0) (x0 `to` x1) ++ map (x1,) (y0 `to` y1)
        rt2 = map (x0,) (y0 `to` y1) ++ map (,y1) (x0 `to` x1)
        x `to` y | y >= x    = [x+1..y]
                 | otherwise = [x-1,x-2..y]

updateGrid :: UArray (Int,Int) Char -> [(Int, Int)] -> UArray (Int,Int) Char
updateGrid grid route = STA.runSTUArray $ do
    let valid = inRange (bounds grid)
    grid' <- STA.thaw grid
    forM_ route $ \p -> when (grid!p == '.') $ STA.writeArray grid' p '0'
    doWhileM_ . fmap getAny . flip foldMapA (indices grid) $ \p -> do
        g <- STA.readArray grid' p
        if g /= '.' then pure (Any False) else do
            gs <- mapM (\p' -> if valid p' then STA.readArray grid' p' else pure 'X')
                       (neighbours p 1)
            if any (not . (`elem` ['.','0'])) gs
                then Any True <$ STA.writeArray grid' p 'M'
                else pure (Any False)
    forM_ (indices grid) $ \p -> do
        g <- STA.readArray grid' p
        if g == '.' then STA.writeArray grid' p '0'
        else when (g == 'M') $ STA.writeArray grid' p '.'
    return grid'
        
filterA :: Applicative f => (a -> f Bool) -> [a] -> f [a]
filterA f []     = pure []
filterA f (x:xs) = (\c xs' -> if c then x:xs' else xs') <$> f x <*> filterA f xs

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 :: (a -> Bool) -> [a] -> Int
count f xs = go xs 0
    where
        go []     !n = n
        go (x:xs) !n = go xs $ if f x then n+1 else n

-- 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

scoreGrid :: UArray (Int, Int) Char -> Double
scoreGrid grid = sum $ map (sqrt . fromIntegral) $ elems $ scoreCells grid

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