{-# LANGUAGE FlexibleContexts, RecordWildCards, TupleSections #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Arrow (first, second, (&&&))
import Control.DeepSeq
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray ((!), (//))
import Data.Either
import Data.Function
import Data.Functor.Identity
import Data.List
import Data.Maybe
import Data.Monoid
import Debug.Trace
import System.IO
import Text.Parsec hiding (many, (<|>))

import qualified Data.Array.IArray as A

type Point  = (Int, Int)

data Orient = H | V deriving (Eq, Ord, Enum, Bounded, Read, Show)
data Dir    = LEFT | RIGHT | UP | DOWN deriving (Eq, Ord, Enum, Bounded, Read, Show)
data Player = Player { plID :: Int, plPt :: Point, plWalls :: Int } deriving (Eq, Show)
data Wall   = Wall { wallPt :: Point, wallOrient :: Orient } deriving (Eq, Show)

data Env = Env { boardWidth   :: Int
               , boardHeight  :: Int
               , playerCount  :: Int
               , myID         :: Int
               , walls        :: [Wall]
               , neighborGrid :: A.Array Point [Point]
               , grids        :: [A.Array Point (Maybe Double)]
               } deriving (Show)

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering -- DO NOT REMOVE

    (boardWidth, boardHeight, playerCount, myID) <-
        parseE ((,,,) <$> intP <*> intP <*> intP <*> intP) "environment" <$> getLine

    repeatM $ do
        players <- forM [0..playerCount-1] $ \i -> parseE (playerP i) "player" <$> getLine
        wallCount <- parseE intP "wallCount" <$> getLine -- number of walls on the board
        walls <- replicateM wallCount $ parseE wallP "wall" <$> getLine
        let env = updateGrid Env { neighborGrid = undefined, grids = [], .. } walls

        -- action: LEFT, RIGHT, UP, DOWN or "putX putY putOrientation" to place a wall
        putStrLn $ showMove $ fst $ maximumBy (compare `on` snd) $ findMoves players env

findMoves :: [Player] -> Env -> [(Either Dir Wall, Double)]
findMoves players env = dirMoves ++ wallMoves
    where
        dirMoves = do
            pt <- neighbors env $ plPt me
            let players' = map (\p -> if p == me then p { plPt = pt } else p) players
            let costs = zipWith (\grid pt -> if pt >= (0,0) then grid!pt else Just 0) (grids env) $ map plPt players'
            let dir = dirFromPoints (plPt me) pt
            return $ {-traceShowId-} (Left dir, 3 + score (map fromJust costs))
        wallMoves = if plWalls me == 0 then [] else do
            wall <- nub $ do
                pl <- players
                guard $ plPt pl >= (0,0)
                pt <- (plPt pl) : (neighborGrid env ! (plPt pl))
                adjacentWalls env $ pt
            guard $ not $ any (doWallsCross wall) (walls env)
            let env' = updateGrid env (wall : walls env)
            let costs = zipWith (\grid pt -> if pt >= (0,0) then grid!pt else Just 0) (grids env') $ map plPt players
            guard $ all isJust costs
            return $ {-traceShowId-} (Right wall, score (map fromJust costs))
        score costs = myScore myCost - sum (map oppScore oppCosts)
            where (myCost, oppCosts) = removeAt (myID env) costs
        oppScore cost = 80 / (max 2 cost - 1)
        myScore  cost = negate $ cost^2
        me = players !! myID env

floodFill :: Env -> Int -> A.Array Point (Maybe Double)
floodFill env@Env{..} plID = go initGrid
    where
        go :: A.Array Point (Maybe Double) -> A.Array Point (Maybe Double)
        go grid = let grid' = force $ A.array (A.bounds grid) $ map (kernel grid) $ A.indices grid
                  in if grid' == grid then grid' else go grid'
        kernel grid pt = (pt,) . minimumBy cmpCost . ((grid!pt):) . map (fmap (1+) . (grid!)) $ neighborGrid!pt
        initGrid :: A.Array Point (Maybe Double)
        initGrid = A.array (A.bounds neighborGrid) (map (,Nothing) (A.indices neighborGrid)) //
            case plID of
                0 -> [ ((boardWidth-1,y),Just 1)  | y <- [0..boardHeight-1] ] -- right edge
                1 -> [ ((0,y),Just 1)             | y <- [0..boardHeight-1] ] -- left edge
                2 -> [ ((x,boardHeight-1),Just 1) | x <- [0..boardWidth-1]  ] -- bottom edge
                3 -> [ ((x,0),Just 1)             | x <- [0..boardWidth-1]  ] -- top edge

updateGrid :: Env -> [Wall] -> Env
updateGrid env walls = env'
    where env' = env { walls = walls, neighborGrid = neighborGrid, grids = grids }
          neighborGrid = A.array gridIx $ map (id &&& neighbors env') $ A.range gridIx
          grids = map (floodFill env') [0..(playerCount env)-1]
          gridIx = ((0,0), ((boardWidth env)-1,(boardHeight env)-1))

neighbors :: Env -> Point -> [Point]
neighbors Env{..} (myX, myY) = do
    (nx, ny) <- [ (myX-1, myY), (myX+1, myY), (myX, myY-1), (myX, myY+1) ]
    guard $ (nx >= 0) && (ny >= 0) && (nx < boardWidth) && (ny < boardHeight)
    let wallBetween (Wall (wx, wy) hv) =
            (hv == H && (nx `elem` [wx, wx+1]) && sort [ny, myY] == [wy-1, wy]) ||
            (hv == V && (ny `elem` [wy, wy+1]) && sort [nx, myX] == [wx-1, wx])
    guard $ not $ any wallBetween walls
    return (nx, ny)

adjacentWalls :: Env -> Point -> [Wall]
adjacentWalls env@Env{..} (x, y) = do
    (x', y') <- neighborGrid ! (x, y)
    if y' == y then do
        top <- [ y - 1, y ]
        guard $ top >= 0 && top < boardHeight - 1
        return $ Wall (max x x', top) V
    else do
        left <- [ x - 1, x ]
        guard $ left >= 0 && left < boardWidth - 1
        return $ Wall (left, max y y') H

doWallsCross :: Wall -> Wall -> Bool
doWallsCross (Wall (x1, y1) d1) (Wall (x2, y2) d2) =
    case (d1, d2) of
        (H, H) -> (y1 == y2) && (x1 == x2 || x1 == x2 + 1 || x2 == x1 + 1)
        (V, V) -> (x1 == x2) && (y1 == y2 || y1 == y2 + 1 || y2 == y1 + 1)
        (V, H) -> (x1 == x2 + 1) && (y2 == y1 + 1)
        (H, V) -> (x2 == x1 + 1) && (y1 == y2 + 1)

cmpCost :: Maybe Double -> Maybe Double -> Ordering
Nothing `cmpCost` Nothing = EQ
Nothing `cmpCost` _       = GT
_       `cmpCost` Nothing = LT
Just x  `cmpCost` Just y  = x `compare` y

dirFromPoints :: Point -> Point -> Dir
dirFromPoints from@(x0,y0) to@(x1,y1)
    | x1 < x0 = LEFT
    | x1 > x0 = RIGHT
    | y1 < y0 = UP
    | True    = DOWN

intP :: Stream s m Char => ParsecT s u m Int
intP = spaces *> (read <$> ((++) <$> (string "-" <|> pure "") <*> some digit))

tok s   = spaces *> string s
pointP  = (,) <$> intP <*> intP
orientP = (H <$ try (tok "H")) <|> (V <$ tok "V")

wallP   = Wall <$> ((,) <$> intP <*> intP) <*> orientP
playerP = \plID -> Player plID <$> pointP <*> intP

parseE :: Stream s Identity t => Parsec s () a -> SourceName -> s -> a
parseE p src s = either (error . show) id $ parse p src s

repeatM :: Monad m => m a -> m b
repeatM m = m >> repeatM m

removeAt :: Int -> [a] -> (a, [a])
removeAt ix xs = let (as, b:cs) = splitAt ix xs in (b, as ++ cs)

showMove :: Either Dir Wall -> String
showMove (Left  dir)             = show dir
showMove (Right (Wall (x, y) o)) = unwords [ show x, show y, show o ]

showGrid :: A.Array Point (Maybe Double) -> String
showGrid grid = unlines . map (unwords . map (maybe "X" (show . truncate))) $
                flip map [y0..yN] $ \y -> flip map [x0..xN] $ \x -> (grid!(x,y))
    where ((x0,y0),(xN,yN)) = A.bounds grid