{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}
{-# LANGUAGE LambdaCase, TupleSections, ImplicitParams, ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances, OverlappingInstances, ExplicitForAll #-}
{-# LANGUAGE RankNTypes, TypeFamilies #-}

import Control.Applicative
import Control.Arrow (first, second)
import Control.DeepSeq
import Control.Monad
import Control.Monad.Writer
import Data.Array (Array,Ix,(//),(!))
import Data.Function
import Data.Functor.Identity
import Data.IORef
import Data.List
import Data.Map (Map,(\\))
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import Debug.Trace
import Prelude hiding (fst, snd)
import System.IO
import System.Random

import qualified Data.Array as A
import qualified Data.Map   as M
import qualified Data.Set   as S

data Cell = EmptyC | BoxC (Maybe ItemType) | WallC
    deriving (Eq,Show)

type Grid a = Array (Int, Int) a

type PlayerID = Int
type Position = (Int, Int)

data Player = Player { playerId    :: PlayerID
                     , playerPos   :: Position
                     , bombsLeft   :: Int
                     , playerRange :: Int
                     } deriving Show

playerPosL :: Lens' Player Position
playerPosL f p = (\pos' -> p { playerPos = pos' }) <$> f (playerPos p)

playerRangeL :: Lens' Player Int
playerRangeL f p = (\r' -> p { playerRange = r' }) <$> f (playerRange p)

bombsLeftL :: Lens' Player Int
bombsLeftL f p = (\b' -> p { bombsLeft = b' }) <$> f (bombsLeft p)

data Bomb = Bomb { bombOwner     :: PlayerID
                 , bombPos       :: Position
                 , bombCountdown :: Int
                 , bombRange     :: Int
                 } deriving Show

data ItemType = ExtraRange | ExtraBomb
    deriving (Eq,Ord,Enum,Bounded,Read,Show)

data Item = Item { itemPos  :: Position
                 , itemType :: ItemType
                 } deriving Show

data Entity = P Player | B Bomb | I Item deriving Show

data GameData = GameData { _gridWidth  :: Int
                         , _gridHeight :: Int
                         , _myId       :: PlayerID
                         } deriving Show

type HasGameData = (?gameData :: GameData)

data GameState = GameState { gameGrid    :: Grid Cell
                           , gamePlayers :: [Player]
                           , gameBombs   :: [Bomb]
                           , gameItems   :: [Item]
                           , gamePaths   :: Map Position [Position]
                           } deriving Show

gamePlayersL :: Lens' GameState [Player]
gamePlayersL f gs = (\ps' -> gs { gamePlayers = ps' }) <$> f (gamePlayers gs)

gameBombsL :: Lens' GameState [Bomb]
gameBombsL f gs = (\bs' -> gs { gameBombs = bs' }) <$> f (gameBombs gs)

gameItemsL :: Lens' GameState [Item]
gameItemsL f gs = (\is' -> gs { gameItems = is' }) <$> f (gameItems gs)

gamePathsL :: Lens' GameState (Map Position [Position])
gamePathsL f gs = (\ps' -> gs { gamePaths = ps' }) <$> f (gamePaths gs)

data Action = MOVE | BOMB deriving (Eq,Ord,Enum,Bounded,Read,Show)

gridWidth, gridHeight :: HasGameData => Int
gridWidth  = _gridWidth  ?gameData
gridHeight = _gridHeight ?gameData

myId :: HasGameData => PlayerID
myId = _myId ?gameData

main = do
    hSetBuffering stdout NoBuffering -- DO NOT REMOVE
    
    gameData <- (\[w,h,myId] -> GameData w h myId)
              . map read . words
              <$> getLine

    let ?gameData = gameData in loop

loop :: HasGameData => IO ()
loop = do
    target <- newIORef (0, 0)
    best   <- newIORef []
    forever $ do
        grid      <- getGrid
        nEntities <- readLn
        entities  <- replicateM nEntities getEntity

        let gs = GameState { gameGrid    = grid
                           , gamePlayers = [ p | P p <- entities ]
                           , gameBombs   = [ b | B b <- entities ]
                           , gameItems   = [ i | I i <- entities ]
                           , gamePaths   = pathsFrom gs myId
                           }

        chooseAction target best gs 0

chooseAction :: HasGameData => IORef Position
                            -> IORef [Position]
                            -> GameState
                            -> Int
                            -> IO ()
chooseAction target best gs = fix $ \redo retries -> do
    let Just me = find (\p -> playerId p == myId) (gamePlayers gs)
    let iSurvive = any (\p -> playerId p == myId) . gamePlayers

    targetPos <- readIORef target
    bestPos   <- readIORef best

    let score (act, trg, acts) = do
            guard $ act /= BOMB || bombsLeft me > 0
            path <- M.lookup trg (gamePaths gs)
            let (ptsMap, gs'') = simulate gs $ zip (act : acts ++ repeat MOVE) (tail path)
            guard $ iSurvive gs''
            let Just me' = find (\p -> playerId p == myId) (gamePlayers gs'')
            let boxes = getSum $ M.findWithDefault 0 myId ptsMap
            let kills = length (gamePlayers gs) - length (gamePlayers gs'')
            let total = getSum . execWriter $ do
                    tell . Sum $ (12 * boxes)^2
                    tell . Sum $  10 * kills
                    when (trg /= playerPos me) $ tell (Sum 20)
                    when (trg == targetPos)    $ tell (Sum 15)
                    tell . Sum $ 5 * playerRange me
                    tell . Sum $ 3 * bombsLeft   me
                    tell . Sum $ max 0 (5 - length path `div` 2)
            pure (total, (act, trg, path, gs''))

    targets <- fmap S.toList . execWriterT $ do
        tell $ S.singleton targetPos
        tell $ S.fromList bestPos
        tell $ S.fromList $ do
             let (x0,y0) = playerPos me
             x <- [x0-2..x0+2]
             guard $ 0 <= x && x < gridWidth
             y <- [y0-2..y0+2]
             guard $ 0 <= y && y < gridHeight
             pure (x,y)
        tell . S.fromList =<< liftIO (replicateM 25 $ randomTarget gs)

    actions' <- (fmap (,) [MOVE,BOMB] <*>) <$> shuffleIO targets
    actions  <- forM actions' $ \(act,trg) -> do
        delay <- randomRIO (0,8)
        pure (act, trg, replicate delay MOVE ++ [BOMB])
    let scores = sortBy (flip compare `on` fst) $ mapMaybe score actions

    -- forM_ scores $ \(sc, (act, trg, path, _)) -> do
    --     traceM $ fromWords "SCORE:" sc act path

    writeIORef best . map (snd . snd) . take 15 $ scores

    case scores of
        ((_, (action, trg, path, gs')):_) -> do
            when (trg /= targetPos) $ target .= pure trg
            let (myX, myY) = playerPos me
            let (nx, ny) = case path of { (_:(x,y):_) -> (x,y); _ -> (myX,myY) }
            putStrLn $ fromWords action nx ny
        _ -> do
            target .= randomTarget gs
            if retries < 5 then
                redo (retries + 1)
            else
                let (myX, myY) = playerPos me
                in trace "Stuck!" $ putStrLn $ fromWords MOVE myX myY

mwhen :: Monoid m => m -> Bool -> m
mwhen x False = mempty
mwhen x True  = x

shuffleIO :: [a] -> IO [a]
shuffleIO [] = pure []
shuffleIO xs = do
    n <- randomRIO (0, length xs - 1)
    let (as, x:bs) = splitAt n xs
    (x:) <$> shuffleIO (as ++ bs)

getGrid :: HasGameData => IO (Grid Cell)
getGrid = A.array ((0,0),(gridWidth-1,gridHeight-1))
        . concat . zipWith (\y -> map (\(x,v) -> ((x,y),v))) [0..]
        <$> replicateM gridHeight (zip [0..] . map readCell <$> getLine)

readCell '.' = EmptyC
readCell '0' = BoxC Nothing
readCell '1' = BoxC (Just ExtraRange)
readCell '2' = BoxC (Just ExtraBomb)
readCell 'X' = WallC

getEntity = flip fmap (map read . words <$> getLine) $
    \[entityType,owner,x,y,p1,p2] -> case entityType of
        0 -> P $ Player owner (x,y) p1 p2
        1 -> B $ Bomb   owner (x,y) p1 p2
        2 -> I $ Item         (x,y) (decodeItemType p1)

decodeItemType 1 = ExtraRange
decodeItemType 2 = ExtraBomb

randomTarget :: HasGameData => GameState -> IO Position
randomTarget gs = join $ maybe randomPosIO pure <$> randomItemIO (nubOrd targets)
  where
    randomPosIO = (,) <$> randomRIO (0, gridWidth  - 1)
                      <*> randomRIO (0, gridHeight - 1)
    targets = [ p' | (p, BoxC _) <- A.assocs (gameGrid gs)
                   , p' <- neighbours p
                   , (gameGrid gs)!p' == EmptyC
                   , not (any (\b -> bombPos b == p') (gameBombs gs))
              ] ++ map itemPos   (gameItems   gs)
                ++ map playerPos (gamePlayers gs)
    nubOrd = S.toList . S.fromList

neighbours :: HasGameData => Position -> [Position]
neighbours (x0,y0) =
    [ (x,y) | (x,y) <- [(x0-1,y0),(x0+1,y0),(x0,y0-1),(x0,y0+1)]
            , x >= 0, y >= 0, x < gridWidth, y < gridHeight ]

randomItemIO :: [a] -> IO (Maybe a)
randomItemIO xs
    | null xs   = pure Nothing
    | otherwise = Just . (xs!!) <$> randomRIO (0, length xs - 1)

gamePlayerById :: PlayerID -> GameState -> Maybe Player
gamePlayerById plId = find (\p -> playerId p == plId) . gamePlayers

pathsFrom :: HasGameData => GameState -> PlayerID -> Map Position [Position]
pathsFrom gs plId = go M.empty $ M.singleton plPos [plPos]
  where
    Just plPos = playerPos <$> gamePlayerById plId gs
    go visited fringe
        | M.null fringe' = visited'
        | otherwise = go visited' fringe'
      where
        visited' = visited <> fringe
        fringe' = M.fromList
                    [ (pos', path ++ [pos'])
                    | (pos@(x,y), path) <- M.toList fringe
                    , pos'@(nx, ny) <- [ (x-1,y),(x+1,y),(x,y-1),(x,y+1) ]
                    , nx >= 0, ny >= 0, nx < gridWidth, ny < gridHeight
                    , not (M.member pos' visited')
                    , not (blocked pos') || pos' == plPos
                    ]
        blocked p = (gameGrid gs)!p /= EmptyC || S.member p obstacles
        obstacles = S.fromList $ bombPos <$> gameBombs gs

simulate :: HasGameData => GameState -> [(Action, Position)] -> (Map PlayerID (Sum Int), GameState)
simulate gs0 path
    | null path && null (gameBombs gs0) = (M.empty, gs0)
    | otherwise = (ptsMap1 <> ptsMap2, gs3)
  where
    (ptsMap1, gs1) = step gs0
    maybeMe = find (\p -> playerId p == myId) (gamePlayers gs1)
    (gs2, path') = case path of
        ((act,pos):path') | (gameGrid gs0)!pos == EmptyC
                          , not (any (\b -> bombPos b == pos) $ gameBombs gs1)
            ->  let gs'  = over gamePlayersL (map (updatePlayer pos)) gs1
                    gs'' = set  gamePathsL   (pathsFrom gs' myId)     gs'
                in (,path') . ($ gs'') $ case act of
                    BOMB | Just me <- maybeMe, bombsLeft me > 0
                        -> over gameBombsL (newBomb me :)
                    _   -> id
        _ -> (gs1, [])
    (ptsMap2, gs3) = simulate gs2 path'
    updatePlayer pos p
        | playerId p == myId = set playerPosL pos p
        | otherwise          = p
    newBomb p = Bomb { bombOwner     = playerId p
                     , bombPos       = playerPos p
                     , bombCountdown = 8
                     , bombRange     = playerRange p
                     }

step :: HasGameData => GameState -> (Map PlayerID (Sum Int), GameState)
step gs = ptsMap `deepseq` newGrid `deepseq` (ptsMap, gs')
  where
    bombs      = map timeStep $ gameBombs gs
    timeStep b = b { bombCountdown = bombCountdown b - 1 }
    expired  b = bombCountdown b < 1
    (expiredBombs, remainingBombs0) = partition expired bombs
    (explodedBombs, remainingBombs) = explodeBombs gs expiredBombs remainingBombs0
    boxesDestroyed = [ ((pos, itm), (bombOwner b, Sum 1))
                     | (pos, BoxC itm) <- A.assocs (gameGrid gs)
                     , b <- explodedBombs
                     , bombInRange gs pos b
                     ]
    itemsCollected = M.fromListWith (<>)
                   $ [ (playerId p, [itemType i])
                     | p <- gamePlayers gs
                     , i <- gameItems   gs
                     , itemPos i == playerPos p
                     ]
    items'   = filter (not . \i -> any (bombInRange gs (itemPos i)) explodedBombs
                                || any (\p -> playerPos p == itemPos i) (gamePlayers gs))
                      (gameItems gs)
            ++ [ Item { itemPos = p, itemType = i } | ((p, Just i), _) <- boxesDestroyed ]
    players' = map (\p -> foldl' applyItem p $ M.findWithDefault [] (playerId p) itemsCollected)
             $ map (\p -> over bombsLeftL (+ countBombs (playerId p)) p)
             $ filter (not . \p -> any (bombInRange gs (playerPos p)) explodedBombs)
                      (gamePlayers gs)
    countBombs plId = length $ filter (\b -> bombOwner b == plId) explodedBombs
    applyItem = flip $ \case
        ExtraRange -> over playerRangeL (+1)
        ExtraBomb  -> over bombsLeftL   (+1)
    ptsMap   = M.map getSum $ M.fromListWith (<>) $ map snd boxesDestroyed
    newGrid  = gameGrid gs // [ (p, EmptyC) | ((p, _), _) <- boxesDestroyed ]
    gs' = gs { gameGrid    = newGrid
             , gamePlayers = players'
             , gameBombs   = remainingBombs
             , gameItems   = items'
             }

explodeBombs :: GameState -> [Bomb] -> [Bomb] -> ([Bomb], [Bomb])
explodeBombs gs triggered remaining
    | null triggered' = (triggered, remaining)
    | otherwise       = first (triggered++) $
                        explodeBombs gs triggered' remaining'
  where
    isTriggered b = any (bombInRange gs (bombPos b)) triggered
    (triggered', remaining') = partition isTriggered remaining

bombInRange :: GameState -> Position -> Bomb -> Bool
bombInRange gs (x,y) b
    =  (x == bx && y > (by - r) && y <= by && allEmpty [(x,y')|y'<-[y+1..by-1]])
    || (x == bx && y >= by && y < (by + r) && allEmpty [(x,y')|y'<-[by+1..y-1]])
    || (y == by && x > (bx - r) && x <= bx && allEmpty [(x',y)|x'<-[x+1..bx-1]])
    || (y == by && x >= bx && x < (bx + r) && allEmpty [(x',y)|x'<-[bx+1..x-1]])
  where
    allEmpty ps =
        and [ all (\p -> (gameGrid gs)!p == EmptyC) ps
            , all (\b -> not (bombPos b `elem` ps)) (gameBombs gs)
            , all (\i -> not (itemPos i `elem` ps)) (gameItems gs)
            ]
    (bx, by) = bombPos b
    r        = bombRange b

inGrid :: HasGameData => Position -> Bool
inGrid (x, y) = x >= 0 && y >= 0 && x < gridWidth && y < gridHeight

(.=) :: IORef a -> IO a -> IO ()
r .= m = m >>= writeIORef r
infixr 1 .=

(%=) :: IORef a -> (a -> IO a) -> IO ()
r %= f = readIORef r >>= f >>= writeIORef r
infixr 1 %=

instance NFData Cell where rnf x = x `seq` ()

class IsWord a where
    fromWord :: a -> String

instance IsWord String where
    fromWord = id
    {-# INLINABLE fromWord #-}

instance {-# OVERLAPPABLE #-} Show a => IsWord a where
    fromWord = show
    {-# INLINABLE fromWord #-}

class Words a r where
    fromWords' :: (String -> String) -> a -> r

instance (IsWord a, Words b r) => Words a ((->) b r) where
    fromWords' s a = fromWords' (s . (fromWord a ++) . (" " ++))
    {-# INLINABLE fromWords' #-}

instance IsWord a => Words a String where
    fromWords' s a = s (fromWord a)
    {-# INLINABLE fromWords' #-}

fromWords :: Words a r => a -> r
fromWords = fromWords' id

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Lens' s a = Lens s s a a

view :: Lens s t a b -> s -> a
view l = getConst . l Const

over :: Lens s t a b -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)

set :: Lens s t a b -> b -> s -> t
set l x = over l (const x)

fst :: Tuple1 s => s -> Elem1 s
fst = view _1

snd :: Tuple2 s => s -> Elem2 s
snd = view _2

class Tuple1 s where
    type Elem1 s
    type Repl1 s b
    _1 :: Lens s (Repl1 s b) (Elem1 s) b

class Tuple1 s => Tuple2 s where
    type Elem2 s
    type Repl2 s b
    _2 :: Lens s (Repl2 s b) (Elem2 s) b

class Tuple2 s => Tuple3 s where
    type Elem3 s
    type Repl3 s b
    _3 :: Lens s (Repl3 s b) (Elem3 s) b

class Tuple3 s => Tuple4 s where
    type Elem4 s
    type Repl4 s b
    _4 :: Lens s (Repl4 s b) (Elem4 s) b

instance Tuple1 (a,b) where
    type Elem1 (a,b)    = a
    type Repl1 (a,b) a' = (a',b)
    _1 f (a,b) = fmap (,b) (f a)
instance Tuple2 (a,b) where
    type Elem2 (a,b)    = b
    type Repl2 (a,b) b' = (a,b')
    _2 f (a,b) = fmap (a,) (f b)

instance Tuple1 (a,b,c) where
    type Elem1 (a,b,c)    = a
    type Repl1 (a,b,c) a' = (a',b,c)
    _1 f (a,b,c) = fmap (,b,c) (f a)
instance Tuple2 (a,b,c) where
    type Elem2 (a,b,c)    = b
    type Repl2 (a,b,c) b' = (a,b',c)
    _2 f (a,b,c) = fmap (a,,c) (f b)
instance Tuple3 (a,b,c) where
    type Elem3 (a,b,c)    = c
    type Repl3 (a,b,c) c' = (a,b,c')
    _3 f (a,b,c) = fmap (a,b,) (f c)

instance Tuple1 (a,b,c,d) where
    type Elem1 (a,b,c,d)    = a
    type Repl1 (a,b,c,d) a' = (a',b,c,d)
    _1 f (a,b,c,d) = fmap (,b,c,d) (f a)
instance Tuple2 (a,b,c,d) where
    type Elem2 (a,b,c,d)    = b
    type Repl2 (a,b,c,d) b' = (a,b',c,d)
    _2 f (a,b,c,d) = fmap (a,,c,d) (f b)
instance Tuple3 (a,b,c,d) where
    type Elem3 (a,b,c,d)    = c
    type Repl3 (a,b,c,d) c' = (a,b,c',d)
    _3 f (a,b,c,d) = fmap (a,b,,d) (f c)
instance Tuple4 (a,b,c,d) where
    type Elem4 (a,b,c,d)    = d
    type Repl4 (a,b,c,d) d' = (a,b,c,d')
    _4 f (a,b,c,d) = fmap (a,b,c,) (f d)

instance NFData a => NFData (Sum a) where rnf (Sum x) = rnf x

-- vim:set sw=4 et: