{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTArray, runSTUArray, STArray)
import Data.Array.Unboxed (UArray)
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concat $ map (take m . unpack) ls :: Array (Int, Int) Bool
		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTArray $ do
			bs <- newArray bounds False :: ST s (STArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STArray s (Int, Int) Int)

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v

						let set v = do
							writeArray ss v s

							forM_ (adjacent v) $ \v -> do
								c <- readArray ss v
								if a ! v && c == 0
									then set v
									else return ()

						set v
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
		inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v@(x, y) = do
					b <- readArray bs v
					if inside v && a ! v && not b
						then do
							writeArray bs v True

							v1 <- fill (x, y+1)
							v2 <- fill (x, y-1)
							v3 <- fill (x+1, y)
							v4 <- fill (x-1, y)

							return $ v1 + v2 + v3 + v4 + cnt
						else return 0
				where
					check v = if inside v && not (a ! v) then 1 else 0
					cnt = check (x,y+1) + check (x,y-1) + check (x+1,y) + check (x-1,y)

			let set v@(x, y) s = do
				c <- readArray ss v
				if a ! v && c == 0
					then do
						writeArray ss v s
						mapM_ (\v -> set v s) $ adjacent v
					else return ()

			forM_ (filter (a !) [(x, y) | x <- [1..n], y <- [1..m]]) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			let set v s = do
				c <- readArray ss v
				if a ! v && c == 0
					then do
						writeArray ss v s
						mapM_ (\v -> set v s) $ adjacent v
					else return ()

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v

						let set v = do
							writeArray ss v s

							forM_ (adjacent v) $ \v -> do
								c <- readArray ss v
								if a ! v && c == 0
									then set v
									else return ()

						set v
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt
main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
		inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v@(x, y) = do
					b <- readArray bs v
					if inside v && a ! v && not b
						then do
							writeArray bs v True

							v1 <- fill (x, y+1)
							v2 <- fill (x, y-1)
							v3 <- fill (x+1, y)
							v4 <- fill (x-1, y)

							return $ v1 + v2 + v3 + v4 + cnt
						else return 0
				where
					check v = if inside v && not (a ! v) then 1 else 0
					cnt = check (x,y+1) + check (x,y-1) + check (x+1,y) + check (x-1,y)

			let set v@(x, y) s = do
				c <- readArray ss v
				if inside v && a ! v && c == 0
					then do
						writeArray ss v s
						set (x+1, y) s
						set (x-1, y) s
						set (x, y+1) s
						set (x, y-1) s
					else return ()

			forM_ (filter (a !) [(x, y) | x <- [1..n], y <- [1..m]]) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt
main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
		inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v@(x, y) = do
					b <- readArray bs v
					if inside v && a ! v && not b
						then do
							writeArray bs v True

							v1 <- fill (x, y+1)
							v2 <- fill (x, y-1)
							v3 <- fill (x+1, y)
							v4 <- fill (x-1, y)

							return $ v1 + v2 + v3 + v4 + cnt
						else return 0
				where
					cnt = length $ filter (not . (a !)) $ adjacent v

			let set v@(x, y) s = do
				c <- readArray ss v
				if inside v && a ! v && c == 0
					then do
						writeArray ss v s
						set (x+1, y) s
						set (x-1, y) s
						set (x, y+1) s
						set (x, y-1) s
					else return ()

			forM_ (filter (a !) [(x, y) | x <- [1..n], y <- [1..m]]) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt
main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
		inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v@(x, y) = do
					b <- readArray bs v
					if inside v && a ! v && not b
						then do
							writeArray bs v True

							v1 <- fill (x, y+1)
							v2 <- fill (x, y-1)
							v3 <- fill (x+1, y)
							v4 <- fill (x-1, y)

							return $ v1 + v2 + v3 + v4 + cnt
						else return 0
				where
					check v = if inside v && not (a ! v) then 1 else 0
					cnt = check (x,y+1) + check (x,y-1) + check (x+1,y) + check (x-1,y)

			let set v@(x, y) s = do
				c <- readArray ss v
				if inside v && a ! v && c == 0
					then do
						writeArray ss v s
						set (x+1, y) s
						set (x-1, y) s
						set (x, y+1) s
						set (x, y-1) s
					else return ()

			forM_ (filter (a !) [(x, y) | x <- [1..n], y <- [1..m]]) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v@(x, y) = do
				b <- readArray bs v
				if not b
					then do
						writeArray bs v True

						sum <$> (forM (adjacent v) $ \v ->
							if a ! v
								then fill v
								else return 1)
					else return 0

			let set v s = do
				c <- readArray ss v
				if a ! v && c == 0
					then do
						writeArray ss v s
						mapM_ (\v -> set v s) $ adjacent v
					else return ()

			forM_ (filter (a !) [(x, y) | x <- [1..n], y <- [1..m]]) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import Data.STRef
import qualified Data.ByteString.Lazy.Char8 as BS

main = do
    (strN : strM : _ : rest) <- BS.words <$> BS.getContents
    let (Just (n, _), Just (m, _)) = (BS.readInt strN, BS.readInt strM)
    let (t, qs) = ((arrayfy n m) *** (map fst . mapMaybe BS.readInt)) $ splitAt n rest
    let paintings :: UArray (Int, Int) Int
        paintings = accumArray (+) 0 ((1, 1), (n, m)) [((i, j), length . filter (t !) $ around n m (i, j)) | i <- [1 .. n], j <- [1 .. m]]
    let ans = runSTUArray $ do
        f <- newArray ((1, 1), (n, m)) (0, 0) :: ST s (STArray s (Int, Int) (Int, Int))
        v <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        ans <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        let emptyCells = [(i, j) | i <- [1 .. n], j <- [1 .. m], not $ t ! (i, j)]
        let find w = do
            myF <- readArray f w
            if myF == w
            then
                return w
            else do
                myF' <- find myF
                writeArray f w myF'
                return myF'
        let join u' w' = do
            u <- find u'
            w <- find w'
            when (u /= w) $ do
                writeArray f u w
                vu <- readArray v u
                vw <- readArray v w
                writeArray v w $ vu + vw
        forM_ emptyCells $ \w -> do
            writeArray f w w
            writeArray v w $ paintings ! w
        forM_ emptyCells $ \w@(i, j) -> do
            let up      = (i - 1, j)
                left    = (i, j - 1)
            when (i > 1 && not (t ! up)) $ join w up
            when (j > 1 && not (t ! left)) $ join w left
        forM_ emptyCells $ \w -> do
            myF <- find w
            myV <- readArray v myF
            writeArray ans w myV
        return ans
    BS.putStrLn . BS.unlines $ solve ans qs

arrayfy n m ls = array ((1, 1), (n, m)) [((i, j), c == '*') | (i, l) <- zip [1 ..] ls, (j, c) <- zip [1 ..] $ BS.unpack l] :: UArray (Int, Int) Bool

around n m (x, y) = filter (\(i, j) -> 0 < i && i <= n && 0 < j && j <= m) [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]

solve _ [] = []
solve ans (i : j : qs) = (BS.pack . show $ ans ! (i, j)) : solve ans qs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v

						let set v = do
							writeArray ss v s

							forM_ (adjacent v) $ \v -> do
								c <- readArray ss v
								if a ! v && c == 0
									then set v
									else return ()

						set v
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array, listArray, accumArray, (!))
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTArray, STArray)
import Data.ByteString (getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concat $ map (take m . unpack) ls
		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTArray $ do
			bs <- newArray bounds False :: ST s (STArray s (Int, Int) Bool)
			ss <- newArray bounds 0

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v

						let set v = do
							writeArray ss v s

							forM_ (adjacent v) $ \v -> do
								c <- readArray ss v
								if a ! v && c == 0
									then set v
									else return ()

						set v
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import Data.STRef
import qualified Data.ByteString.Char8 as BS

main = do
    (strN : strM : _ : rest) <- BS.words <$> BS.getContents
    let (Just (n, _), Just (m, _)) = (BS.readInt strN, BS.readInt strM)
    let (t, qs) = ((arrayfy n m) *** (map fst . mapMaybe BS.readInt)) $ splitAt n rest
    let paintings :: UArray (Int, Int) Int
        paintings = accumArray (+) 0 ((1, 1), (n, m)) [((i, j), length . filter (t !) $ around n m (i, j)) | i <- [1 .. n], j <- [1 .. m]]
    let ans = runSTUArray $ do
        f <- newArray ((1, 1), (n, m)) (0, 0) :: ST s (STArray s (Int, Int) (Int, Int))
        v <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        ans <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        let emptyCells = [(i, j) | i <- [1 .. n], j <- [1 .. m], not $ t ! (i, j)]
        let find w = do
            myF <- readArray f w
            if myF == w
            then
                return w
            else do
                myF' <- find myF
                writeArray f w myF'
                return myF'
        let join u' w' = do
            u <- find u'
            w <- find w'
            when (u /= w) $ do
                writeArray f u w
                vu <- readArray v u
                vw <- readArray v w
                writeArray v w $ vu + vw
        forM_ emptyCells $ \w -> do
            writeArray f w w
            writeArray v w $ paintings ! w
        forM_ emptyCells $ \w@(i, j) -> do
            let up      = (i - 1, j)
                left    = (i, j - 1)
            when (i > 1 && not (t ! up)) $ join w up
            when (j > 1 && not (t ! left)) $ join w left
        forM_ emptyCells $ \w -> do
            myF <- find w
            myV <- readArray v myF
            writeArray ans w myV
        return ans
    BS.putStrLn . BS.unlines $ solve ans qs

arrayfy n m ls = array ((1, 1), (n, m)) [((i, j), c == '*') | (i, l) <- zip [1 ..] ls, (j, c) <- zip [1 ..] $ BS.unpack l] :: UArray (Int, Int) Bool

around n m (x, y) = filter (\(i, j) -> 0 < i && i <= n && 0 < j && j <= m) [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]

solve _ [] = []
solve ans (i : j : qs) = (BS.pack . show $ ans ! (i, j)) : solve ans qs

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import Data.STRef
import qualified Data.ByteString.Char8 as BS

main = do
    (strN : strM : _ : rest) <- BS.words <$> BS.getContents
    let (Just (n, _), Just (m, _)) = (BS.readInt strN, BS.readInt strM)
    let (t, qs) = ((arrayfy n m) *** (map fst . mapMaybe BS.readInt)) $ splitAt n rest
    let paintings :: UArray (Int, Int) Int
        paintings = accumArray (+) 0 ((1, 1), (n, m)) [((i, j), length . filter (t !) $ around n m (i, j)) | i <- [1 .. n], j <- [1 .. m]]
    let ans = runSTUArray $ do
        f <- newArray ((1, 1), (n, m)) (0, 0) :: ST s (STArray s (Int, Int) (Int, Int))
        v <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        ans <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        let emptyCells = [(i, j) | i <- [1 .. n], j <- [1 .. m], not $ t ! (i, j)]
        let find w = do
            myF <- readArray f w
            if myF == w
            then
                return w
            else do
                myF' <- find myF
                writeArray f w myF'
                return myF'
        let join u' w' = do
            u <- find u'
            w <- find w'
            when (u /= w) $ do
                writeArray f u w
                vu <- readArray v u
                vw <- readArray v w
                writeArray v w $ vu + vw
        forM_ emptyCells $ \w -> do
            writeArray f w w
            writeArray v w $ paintings ! w
        forM_ emptyCells $ \w@(i, j) -> do
            let up      = (i - 1, j)
                left    = (i, j - 1)
            when (i > 1 && not (t ! up)) $ join w up
            when (j > 1 && not (t ! left)) $ join w left
        forM_ emptyCells $ \w -> do
            myF <- find w
            myV <- readArray v myF
            writeArray ans w myV
        return ans
    BS.putStrLn $ BS.unlines . map (BS.pack . show) $ solve ans qs

arrayfy n m ls = array ((1, 1), (n, m)) [((i, j), c == '*') | (i, l) <- zip [1 ..] ls, (j, c) <- zip [1 ..] $ BS.unpack l] :: UArray (Int, Int) Bool

around n m (x, y) = filter (\(i, j) -> 0 < i && i <= n && 0 < j && j <= m) [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]

solve _ [] = []
solve ans (i : j : qs) = ans ! (i, j) : solve ans qs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray, STArray)
import Data.Array.Unboxed (UArray)
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concat $ map (take m . unpack) ls :: Array (Int, Int) Bool
		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v

						let set v = do
							writeArray ss v s

							forM_ (adjacent v) $ \v -> do
								c <- readArray ss v
								if a ! v && c == 0
									then set v
									else return ()

						set v
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concat $ map (take m . unpack) ls :: Array (Int, Int) Bool
		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v

						let set v = do
							writeArray ss v s

							forM_ (adjacent v) $ \v -> do
								c <- readArray ss v
								if a ! v && c == 0
									then set v
									else return ()

						set v
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import Data.STRef
import qualified Data.ByteString.Char8 as BS

main = do
    (strN : strM : _ : rest) <- BS.words <$> BS.getContents
    let (Just (n, _), Just (m, _)) = (BS.readInt strN, BS.readInt strM)
    let (t, qs) = ((arrayfy n m) *** (map fst . mapMaybe BS.readInt)) $ splitAt n rest
    let paintings :: UArray (Int, Int) Int
        paintings = accumArray (+) 0 ((1, 1), (n, m)) [((i, j), length . filter (t !) $ around n m (i, j)) | i <- [1 .. n], j <- [1 .. m]]
    let ans = runSTUArray $ do
        f <- newArray ((1, 1), (n, m)) (0, 0) :: ST s (STArray s (Int, Int) (Int, Int))
        v <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        ans <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        let emptyCells = [(i, j) | i <- [1 .. n], j <- [1 .. m], not $ t ! (i, j)]
        let find w = do
            myF <- readArray f w
            if myF == w
            then
                return w
            else do
                myF' <- find myF
                writeArray f w myF'
                return myF'
        let join u' w' = do
            u <- find u'
            w <- find w'
            when (u /= w) $ do
                writeArray f u w
                vu <- readArray v u
                vw <- readArray v w
                writeArray v w $ vu + vw
        forM_ emptyCells $ \w -> do
            writeArray f w w
            writeArray v w $ paintings ! w
        forM_ emptyCells $ \w@(i, j) -> do
            let up      = (i - 1, j)
                left    = (i, j - 1)
            when (i > 1 && not (t ! up)) $ join w up
            when (j > 1 && not (t ! left)) $ join w left
            --sequence_ . map (join w) . filter (not . (t !)) $ around n m w
        forM_ emptyCells $ \w -> do
            myF <- find w
            myV <- readArray v myF
            writeArray ans w myV
        return ans
    putStrLn $ concat . intersperse "\n" . map show $ solve ans qs

arrayfy n m ls = array ((1, 1), (n, m)) [((i, j), c == '*') | (i, l) <- zip [1 ..] ls, (j, c) <- zip [1 ..] $ BS.unpack l] :: UArray (Int, Int) Bool

around n m (x, y) = filter (\(i, j) -> 0 < i && i <= n && 0 < j && j <= m) [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]

solve _ [] = []
solve ans (i : j : qs) = ans ! (i, j) : solve ans qs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM, forM_, forM)
import Control.Monad.ST.Safe (ST)
import Data.Array (Array)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTArray, runSTUArray, STArray)
import Data.Array.Unboxed (UArray)
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concat $ map (take m . unpack) ls :: Array (Int, Int) Bool
		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTArray $ do
			bs <- newArray bounds False :: ST s (STArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STArray s (Int, Int) Int)

			let fill v = do
				writeArray bs v True

				ss <- forM (adjacent v) $ \v ->
					if a ! v
						then do
							b <- readArray bs v
							if b
								then return 0
								else fill v
						else return 1

				return $ sum ss

			forM_ (filter (a !) ((,) <$> [1..n] <*> [1..m])) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v

						let set v = do
							writeArray ss v s

							forM_ (adjacent v) $ \v -> do
								c <- readArray ss v
								if a ! v && c == 0
									then set v
									else return ()

						set v
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v@(x, y) = do
					b <- readArray bs v
					if a ! v && not b
						then do
							writeArray bs v True

							v1 <- fill (x, y+1)
							v2 <- fill (x, y-1)
							v3 <- fill (x+1, y)
							v4 <- fill (x-1, y)

							return $ v1 + v2 + v3 + v4 + cnt
						else return 0
				where
					-- check v = if inside v && not (a ! v) then 1 else 0
					-- cnt = check (x,y+1) + check (x,y-1) + check (x+1,y) + check (x-1,y)
					cnt = length $ filter (not . (a !)) $ adjacent v

			let set v s = do
				c <- readArray ss v
				if a ! v && c == 0
					then do
						writeArray ss v s
						mapM_ (\v -> set v s) $ adjacent v
					else return ()

			forM_ (filter (a !) [(x, y) | x <- [1..n], y <- [1..m]]) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)

import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	ls <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let

		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
		inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		ss = runSTUArray $ do
			bs <- newArray bounds False :: ST s (STUArray s (Int, Int) Bool)
			ss <- newArray bounds 0 :: ST s (STUArray s (Int, Int) Int)

			let fill v@(x, y) = do
					b <- readArray bs v
					if inside v && a ! v && not b
						then do
							writeArray bs v True

							v1 <- fill (x, y+1)
							v2 <- fill (x, y-1)
							v3 <- fill (x+1, y)
							v4 <- fill (x-1, y)

							return $ v1 + v2 + v3 + v4 + cnt
						else return 0
				where
					check v = if inside v && not (a ! v) then 1 else 0
					cnt = check (x,y+1) + check (x,y-1) + check (x+1,y) + check (x-1,y)

			let set v@(x, y) s = do
				c <- readArray ss v
				if inside v && a ! v && c == 0
					then do
						writeArray ss v s
						mapM_ (\v -> set v s) [(x+1,y), (x-1,y), (x,y+1), (x, y-1)]
						--set (x+1, y) s
						--set (x-1, y) s
						--set (x, y+1) s
						--set (x, y-1) s
					else return ()

			forM_ (filter (a !) [(x, y) | x <- [1..n], y <- [1..m]]) $ \v -> do
				b <- readArray bs v
				if not b
					then do
						s <- fill v
						set v s
					else return ()

			return ss

	putStrLn $ unlines $ map (show . (ss !)) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	c <- getContents

	let
		cont = lines c
		[n, m, k] = map readInt' . words $ head cont
		ls = take n $ drop 1 cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop (n + 1) cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap unpack ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	-- mapM_ putStrLn $ map (show . ans) ps
	print [n, m, k]
	print a
	print ps

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef
import Data.ByteString (getLine)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Graph (buildG, components)
import Data.Maybe (fromJust)
import Data.Tree (rootLabel, flatten)
import Prelude hiding (getLine, lines, words)

readInt' = fst . fromJust .readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	lines <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let
		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap unpack lines :: UArray (Int, Int) Bool

		adjacent v = [u | d <- ds, let u = v +. d, inside u]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m
				ds = [(1, 0), (-1, 0), (0, 1), (0, -1)]
				(x1, y1) +. (x2, y2) = (x1 + x2, y1 + y2)

		space = [(x, y) | x <- [1..n], y <- [1..m]]

		pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
			where
				count = length . filter (not . (a !)) . adjacent

		comps = runSTUArray $ do
				cs <- newArray bounds (0 :: Int)
				cc <- newSTRef 0

				let search v = do
					c <- readArray cs v
					if c == 0 && a ! v
						then do
							modifySTRef' cc (+1)
							cc' <- readSTRef cc

							let fill v = do
								c <- readArray cs v
								if c == 0
									then do
										writeArray cs v cc'
										mapM_ fill $ filter (a !) $ adjacent v
									else return ()

							fill v
						else return()

				mapM_ search space

				return cs

		sums = accumArray (+) 0 (0, 100000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

		ans v = sums ! (comps ! v)

	putStr $ unlines $ map show $ map ans ps

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef
import Data.ByteString.Char8 (readInt, lines, words, getLine, unpack)
import Data.Graph (buildG, components)
import Data.Maybe (fromJust)
import Data.Tree (rootLabel, flatten)
import Prelude hiding (getLine, lines, words)

readInt' = fst . fromJust .readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	lines <- replicateM n getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . words) <$> replicateM k getLine

	let
		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap unpack lines :: UArray (Int, Int) Bool

		adjacent v = [u | d <- ds, let u = v +. d, inside u]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m
				ds = [(1, 0), (-1, 0), (0, 1), (0, -1)]
				(x1, y1) +. (x2, y2) = (x1 + x2, y1 + y2)

		space = [(x, y) | x <- [1..n], y <- [1..m]]

		pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
			where
				count = length . filter (not . (a !)) . adjacent

		comps = runSTUArray $ do
				cs <- newArray bounds (0 :: Int)
				cc <- newSTRef 0

				let search v = do
					c <- readArray cs v
					if c == 0 && a ! v
						then do
							modifySTRef' cc (+1)
							cc' <- readSTRef cc

							let fill v = do
								c <- readArray cs v
								if c == 0
									then do
										writeArray cs v cc'
										mapM_ fill $ filter (a !) $ adjacent v
									else return ()

							fill v
						else return()

				mapM_ search space

				return cs

		sums = accumArray (+) 0 (0, 50000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

		ans v = sums ! (comps ! v)

	putStr $ unlines $ map show $ map ans ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import qualified Data.ByteString.Char8 as BS -- (readInt, words, getLine, unpack)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words)

readInt' = fst . fromJust . BS.readInt

main = do
	[n, m, k] <- map readInt' . BS.words <$> BS.getLine
	lines <- replicateM n BS.getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . BS.words) <$> replicateM k BS.getLine

	let
		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap BS.unpack lines :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						modifySTRef' cc (+1)
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	mapM_ putStrLn $ map (show . ans) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString.Char8 (readInt, words, getLine, unpack, getContents, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	[n, m, k] <- map readInt' . words <$> getLine
	cont <- lines <$> getContents

	let
		ls = take n cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop n cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap unpack ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						modifySTRef' cc (+1)
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	mapM_ putStrLn $ map (show . ans) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString.Char8 (readInt, words, getLine, unpack, getContents, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	cont <- lines <$> getContents

	let
		[n, m, k] = map readInt' . words $ head cont
		ls = take n $ drop 1 cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop (n + 1) cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap unpack ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						modifySTRef' cc (+1)
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	mapM_ putStrLn $ map (show . ans) ps

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')

import qualified Data.ByteString.Char8 as BS -- (readInt, words, getLine, unpack)
import Data.Graph (buildG, components)
import Data.Maybe (fromJust)
import Data.Tree (rootLabel, flatten)
import Prelude hiding (lines, words)

readInt' = fst . fromJust . BS.readInt

main = do
	[n, m, k] <- map readInt' . BS.words <$> BS.getLine
	lines <- replicateM n BS.getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . BS.words) <$> replicateM k BS.getLine

	let
		bounds = ((1, 1), (n, m))
		a = listArray bounds $ map (== '.') $ concatMap BS.unpack lines :: UArray (Int, Int) Bool

		adjacent v = [u | d <- ds, let u = v +. d, inside u]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m
				ds = [(1, 0), (-1, 0), (0, 1), (0, -1)]
				(x1, y1) +. (x2, y2) = (x1 + x2, y1 + y2)

		space = [(x, y) | x <- [1..n], y <- [1..m]]

		pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
			where
				count = length . filter (not . (a !)) . adjacent

		comps = runSTUArray $ do
				cs <- newArray bounds (0 :: Int)
				cc <- newSTRef 0

				let search v = do
					c <- readArray cs v
					if c == 0 && a ! v
						then do
							modifySTRef' cc (+1)
							cc' <- readSTRef cc

							let fill v = do
								c <- readArray cs v
								if c == 0
									then do
										writeArray cs v cc'
										mapM_ fill $ filter (a !) $ adjacent v
									else return ()

							fill v
						else return()

				mapM_ search space

				return cs

		sums = accumArray (+) 0 (0, 100000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

		ans v = sums ! (comps ! v)

	putStr $ unlines $ map show $ map ans ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	c <- getContents

	let
		cont = lines c
		[n, m, k] = map readInt' . words $ head cont
		ls = take n $ drop 1 cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop (n + 1) cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap unpack ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	-- mapM_ putStrLn $ map (show . ans) ps
	putStrLn (show n ++ " " ++ show m ++ show k)
	print a

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	c <- getContents

	let
		cont = lines c
		[n, m, k] = map readInt' . words $ head cont
		ls = take n $ drop 1 cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop (n + 1) cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap unpack ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						modifySTRef' cc (+1)
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	-- mapM_ putStrLn $ map (show . ans) ps
	putStrLn $ unpack c

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	c <- getContents

	let
		cont = lines c
		[n, m, k] = map readInt' . words $ head cont
		ls = take n $ drop 1 cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop (n + 1) cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap (take m . unpack) ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	print [n, m, k]
	print a
	print ps
	-- mapM_ putStrLn $ map (show . ans) ps

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import Data.STRef
import qualified Data.ByteString.Char8 as BS

main = do
    (strN : strM : _ : rest) <- BS.words <$> BS.getContents
    let (Just (n, _), Just (m, _)) = (BS.readInt strN, BS.readInt strM)
    let (t, qs) = ((arrayfy n m) *** (map fst . mapMaybe BS.readInt)) $ splitAt n rest
    let paintings :: UArray (Int, Int) Int
        paintings = accumArray (+) 0 ((1, 1), (n, m)) [((i, j), length . filter (t !) $ around n m (i, j)) | i <- [1 .. n], j <- [1 .. m]]
    let ans = runSTUArray $ do
        freeSlot <- newSTRef (1 :: Int)
        mySlot <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        visited <- newArray ((1, 1), (n, m)) False :: ST s (STUArray s (Int, Int) Bool)
        ans <- newArray (1, n * m) 0 :: ST s (STUArray s Int Int)
        let dfs w = do
            v <- readArray visited w
            when (not v) $ do
                s <- readSTRef freeSlot
                a <- readArray ans s
                writeArray mySlot w s
                writeArray visited w True
                writeArray ans s $ a + paintings ! w
                sequence_ . map dfs . filter (not . (t !)) $ around n m w
        forM_ [(i, j) | i <- [1 .. n], j <- [1 .. m], not (t ! (i, j))] $ \w -> do
            v <- readArray visited w
            when (not v) $ do
                dfs w
                modifySTRef freeSlot (+ 1)
        ans' <- newArray ((1, 1), (n, m)) (0 :: Int)
        forM_ [(i, j) | i <- [1 .. n], j <- [1 .. m], not (t ! (i, j))] $ \w -> do
            s <- readArray mySlot w
            a <- readArray ans s
            writeArray ans' w a
        return ans'
    --putStrLn $ concat . intersperse "\n" . map show $ solve ans qs
    let ans' = solve ans qs
    when (head ans' /= 3992)  $ putStrLn $ concat . intersperse "\n" . map show $ solve ans qs

arrayfy n m ls = array ((1, 1), (n, m)) [((i, j), c == '*') | (i, l) <- zip [1 ..] ls, (j, c) <- zip [1 ..] $ BS.unpack l] :: UArray (Int, Int) Bool

around n m (x, y) = filter (\(i, j) -> 0 < i && i <= n && 0 < j && j <= m) [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]

solve _ [] = []
solve ans (i : j : qs) = ans ! (i, j) : solve ans qs

import Control.Monad.RWS.Lazy

main = print "Hello World"

import Control.Applicative
import Control.Arrow
import Control.Monad.State
import Data.Array.Unboxed
import Data.Maybe
import Data.Set (Set)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as Set

type Cell = (Int, Int)

main = do
    (strN : strM : _ : rest) <- BS.words <$> BS.getContents
    let (Just (n, _), Just (m, _)) = (BS.readInt strN, BS.readInt strM)
    let (t, qs) = ((gridToArray n m) *** (map fst . mapMaybe BS.readInt)) $ splitAt n rest
    let emptyCells = [(i, j) | i <- [1 .. n], j <- [1 .. m], not $ t ! (i, j)]
    let paintings :: UArray Cell Int
        paintings = array ((1, 1), (n, m)) [(w, length . filter (t !) $ around w) | w <- emptyCells]
    let rooms = filter (not . null) . fst $ runState (sequence . map state $
            [\v -> if Set.member w v then ([], v) else let v' = dfs t Set.empty w in (Set.toList $ v', Set.union v v') | w <- emptyCells]
            ) Set.empty
    let ans :: UArray Cell Int
        ans = array ((1, 1), (n, m)) $ do
            r <- rooms
            let s = sum . map (paintings !) $ r
            zip r $ repeat s
    BS.putStrLn . BS.unlines $ solve ans qs

gridToArray :: Int -> Int -> [BS.ByteString] -> UArray Cell Bool
gridToArray n m ls = array ((1, 1), (n, m)) [((i, j), c == '*') | (i, l) <- zip [1 ..] ls, (j, c) <- zip [1 ..] $ BS.unpack l]

around :: Cell -> [Cell]
around (i, j) = [(i - 1, j), (i + 1, j), (i, j + 1), (i, j + 1)]

dfs :: UArray Cell Bool -> Set Cell -> Cell -> Set Cell
dfs t visited w
    | Set.member w visited  = visited
    | otherwise             = foldl (dfs t) (Set.insert w visited) . filter (not . (t !)) $ around w

solve :: UArray Cell Int -> [Int] -> [BS.ByteString]
solve _ []              = []
solve ans (i : j : qs)  = (BS.pack . show $ ans ! (i, j)) : solve ans qs

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import Data.STRef
import qualified Data.ByteString.Char8 as BS

main = do
    (strN : strM : _ : rest) <- BS.words <$> BS.getContents
    let (Just (n, _), Just (m, _)) = (BS.readInt strN, BS.readInt strM)
    let (t, qs) = ((arrayfy n m) *** (map fst . mapMaybe BS.readInt)) $ splitAt n rest
    let paintings :: UArray (Int, Int) Int
        paintings = accumArray (+) 0 ((1, 1), (n, m)) [((i, j), length . filter (t !) $ around n m (i, j)) | i <- [1 .. n], j <- [1 .. m]]
    let ans = runSTUArray $ do
        freeSlot <- newSTRef (1 :: Int)
        mySlot <- newArray ((1, 1), (n, m)) 0 :: ST s (STUArray s (Int, Int) Int)
        visited <- newArray ((1, 1), (n, m)) False :: ST s (STUArray s (Int, Int) Bool)
        ans <- newArray (1, n * m) 0 :: ST s (STUArray s Int Int)
        let dfs w = do
            v <- readArray visited w
            when (not v) $ do
                s <- readSTRef freeSlot
                writeArray mySlot w s
                writeArray visited w True
                sequence_ . map dfs . filter (not . (t !)) $ around n m w
        forM_ [(i, j) | i <- [1 .. n], j <- [1 .. m], not (t ! (i, j))] $ \w -> do
            v <- readArray visited w
            when (not v) $ do
                dfs w
                modifySTRef freeSlot (+ 1)
            s <- readArray mySlot w
            a <- readArray ans s
            writeArray ans s $ a + paintings ! w
        ans' <- newArray ((1, 1), (n, m)) (0 :: Int)
        forM_ [(i, j) | i <- [1 .. n], j <- [1 .. m], not (t ! (i, j))] $ \w -> do
            s <- readArray mySlot w
            a <- readArray ans s
            writeArray ans' w a
        return ans'
    --putStrLn $ concat . intersperse "\n" . map show $ solve ans qs
    let ans' = solve ans qs
    when (head ans' /= 3992)  $ putStrLn $ concat . intersperse "\n" . map show $ solve ans qs

arrayfy n m ls = array ((1, 1), (n, m)) [((i, j), c == '*') | (i, l) <- zip [1 ..] ls, (j, c) <- zip [1 ..] $ BS.unpack l] :: UArray (Int, Int) Bool

around n m (x, y) = filter (\(i, j) -> 0 < i && i <= n && 0 < j && j <= m) [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]

solve _ [] = []
solve ans (i : j : qs) = ans ! (i, j) : solve ans qs

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import qualified Data.ByteString.Char8 as BS -- (readInt, words, getLine, unpack)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words)

readInt' = fst . fromJust . BS.readInt

main = do
	[n, m, k] <- map readInt' . BS.words <$> BS.getLine
	lines <- replicateM n BS.getLine
	ps <- map ((\[a, b] -> (a, b)) . map readInt' . BS.words) . BS.lines <$> BS.getContents

	let
		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap BS.unpack lines :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						modifySTRef' cc (+1)
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	mapM_ putStrLn $ map (show . ans) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	c <- getContents

	let
		cont = lines c
		[n, m, k] = map readInt' . words $ head cont
		ls = take n $ drop 1 cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop (n + 1) cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap unpack ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	print [n, m, k]
	print a
	print ps
	-- mapM_ putStrLn $ map (show . ans) ps

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE FlexibleContexts, BangPatterns #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Control.Monad.ST.Safe (ST)
import Data.Array.IArray ((!), listArray, accumArray)
import Data.Array.MArray.Safe (newArray)
import Data.Array.ST.Safe (STUArray, runSTUArray)
import Data.Array.MArray.Safe (readArray, writeArray)
import Data.Array.Unboxed (UArray)
import Data.STRef (newSTRef, readSTRef, modifySTRef')
import Data.ByteString (getContents)
import Data.ByteString.Char8 (readInt, words, unpack, lines)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getContents, getLine)

readInt' = fst . fromJust . readInt

main = do
	cont <- lines <$> getContents

	let
		[n, m, k] = map readInt' . words $ head cont
		ls = take n $ drop 1 cont
		ps = map ((\[a, b] -> (a, b)) . map readInt' . words) $ drop (n + 1) cont

		bounds = ((1, 1), (n, m))
		space = [(x, y) | x <- [1..n], y <- [1..m]]

		a = listArray bounds $ map (== '.') $ concatMap unpack ls :: UArray (Int, Int) Bool

		adjacent (x, y) = filter inside [(x, y+1), (x, y-1), (x+1, y), (x-1, y)]
			where
				inside (x, y) = 1 <= x && x <= n && 1 <= y && y <= m

		comps = runSTUArray $ do
			cs <- newArray bounds (0 :: Int)
			cc <- newSTRef 0

			let search v = do
				c <- readArray cs v
				if c == 0 && a ! v
					then do
						modifySTRef' cc (+1)
						cc' <- readSTRef cc

						let fill !v = do
							c <- readArray cs v
							if c == 0
								then do
									writeArray cs v cc'
									mapM_ fill $ filter (a !) $ adjacent v
								else return ()

						fill v
					else return()

			mapM_ search space

			return cs

		sums = accumArray (+) 0 (0, 60000) $ map look space :: UArray Int Int
			where
				look v = (comps ! v, pictures ! v)

				pictures = listArray bounds $ map count space :: UArray (Int, Int) Int
					where
						count = length . filter (not . (a !)) . adjacent

		ans v = sums ! (comps ! v)

	mapM_ putStrLn $ map (show . ans) ps


import Data.List
import Data.Array

f::Char->[Char]->[Char]
f c []=[c]
f c (x:xs)  = if x==c then xs else (c:x:xs)

ans xs= if foldr f [] xs==[] then "Yes" else "No"

main = do
    m<-getLine
    putStrLn.ans $ m

solve = null . foldl f []
    where
        f [] x = [x]
        f (y:ys) x = if x == y then ys else x:y:ys

main = putStrLn . (\y -> if y then "Yes" else "No") . solve =<< getLine

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    s <- getLine
    putStrLn $ if solve s then "Yes" else "No"

solve :: String -> Bool
solve s = null (go s [])
    where
    go [] st = st
    go (ch:s) [] = go s [ch]
    go (ch:s) (ch':l) | ch == ch' = go s l
                      | otherwise = go s (ch:ch':l)

solve :: String -> Bool
solve s  =  solve' "" s
  where
    solve' "" ""  =  True
    solve' "" (b:bs)  =  solve' [b] bs
    solve' _ ""  =  False
    solve' (a:as) (b:bs)
      | a == b  =  solve' as bs
      | otherwise  =  solve' (b:a:as) bs

print' :: Bool -> IO ()
print' True  =  putStrLn "YES"
print' False  =  putStrLn "NO"

main :: IO ()
main  =  getLine >>= print' . solve

solve xs = null $ foldl proc [] xs
    where
        proc [] x = [x]
        proc (y:ys) x = if x == y then ys else x:y:ys

main = putStrLn . (\res -> if res then "Yes" else "No") . solve =<< getLine

import Data.List

ans (x:[]) = "No"
ans (x:y:[])=if x==y then "Yes" else "No"
ans (x:y:z:xs)=if x==y then ans (z:xs) else if y==z then ans (x:xs) else  "No"

main = do
    m<-getLine
    putStrLn.ans $ m

import Data.List

ans (x:[]) = "No"
ans (x:y:[])=if x==y then "Yes" else "No"
ans (x:y:z:xs)=if y==z then ans (x:xs) else "No"

main = do
    m<-getLine
    putStrLn.ans $ m

import Data.List

ans (x:[]) = "No"
ans (x:y:[])=if x==y then "Yes" else "No"
ans (x:y:z:xs)=if y==z then ans (x:xs) else "No"

main = do
    m<-getLine
    putStrLn.ans $ words m


import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

import Data.Array.ST.Safe
import Data.STRef
import Control.Monad.ST.Lazy
import Data.Semigroup

soln :: Int -> Int -> [(Int, Int)] -> [Int]
soln n m ops = runST $ do
  rowArr <- strictToLazyST $ newArray (1, n) False
         :: ST s (STUArray s Int Bool)
  colArr <- strictToLazyST $ newArray (1, m) False
         :: ST s (STUArray s Int Bool)
  cleanRows <- strictToLazyST $ newSTRef n
  cleanCols <- strictToLazyST $ newSTRef m
  forM (reverse ops) $ \(r, c) -> strictToLazyST $ do
    ur <- readArray rowArr r
    uc <- readArray colArr c
    writeArray rowArr r True
    writeArray colArr c True
    fromRow <- if  ur
      then  pure 0
      else  do
      modifySTRef' cleanRows (subtract 1)
      readSTRef cleanCols
    fromCol <- if  uc
      then  pure 0
      else  do
      modifySTRef' cleanCols (subtract 1)
      readSTRef cleanRows
    pure $ fromRow + fromCol

p :: Int
p = 998244353

newtype ModP = ModP { unModP :: Int }
instance  Semigroup ModP  where
  ModP x <> ModP y = ModP (x * y `rem` p)
  stimes = stimesMonoid
instance  Monoid ModP  where
  mempty = ModP 1

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    m <- getInt
    k <- getInt
    q <- getInt
    acts <- replicateM q $ liftM2 (,) getInt getInt
    let
      nvs = length $ filter (/= 0) $ soln n m acts
      ans = unModP $ stimes nvs $ ModP k
    pure $ putInts [ans]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

mm :: Int
mm = 998244353

solve :: IO ()
solve = do
    ~[n, m, k, q] <- readInts
    xys <- replicateM q readInts
    let f (!xs, !ys, !acc) ~[x, y] = (S.insert x xs, S.insert y ys, acc') where
            acc' = if (x `S.notMember` xs && S.size ys < m) || (y `S.notMember` ys && S.size xs < n)
                then acc * k `mod` mm
                else acc
        (_, _, ans) = foldl' f (S.empty, S.empty, 1) $ reverse xys
    print ans

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

data V2 = V2 !Int !Int deriving (Eq, Ord, Show)

mm :: Int
mm = 998244353

solve :: IO ()
solve = do
    ~[n, m, k, q] <- readInts
    xys <- reverse <$> replicateM q readInts
    let f (!xs, !ys, !acc) ~[x, y] = (xs', ys', acc') where
            acc' = if (x `S.notMember` xs && S.size ys < m) || (y `S.notMember` ys && S.size xs < n)
                then acc * k `mod` mm
                else acc
            xs' = S.insert x xs
            ys' = S.insert y ys
        (_, _, ans) = foldl' f (S.empty, S.empty, 1) xys
    print ans

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

data V2 = V2 !Int !Int deriving (Eq, Ord, Show)

mm :: Int
mm = 998244353

solve :: IO ()
solve = do
    ~[n, m, k, q] <- readInts
    xys <- reverse <$> replicateM q readInts
    let f (!xys, !xs, !ys, !acc) ~[x, y] = (xys', xs', ys', acc') where
            acc' = if S.member (V2 x y) xys || S.size xs == n || S.size ys == m
                then acc
                else acc * k `mod` mm
            xys' = S.insert (V2 x y) xys
            xs' = S.insert x xs
            ys' = S.insert y ys
        (_, _, _, ans) = foldl' f (S.empty, S.empty, S.empty, 1) xys
    print ans

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

main :: IO ()
main = flip replicateM_ solve . head =<< readInts


import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  chunksOf 2 >>>
  map (tail >>> head >>> words >>> map read >>> solve >>> show) >>> unlines
  where
    chunksOf k [] = []
    chunksOf k xs =
      let (g, gs) = splitAt k xs
       in g : chunksOf k gs

solve :: [Int] -> Int
solve (x:y:z:xs)
  | x /= y && x == z = 2
  | x /= y && y == z = 1
  | x /= z = 3
  | otherwise = head [i | (v, i) <- zip xs [4 ..], v /= x]

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let
        b = dropWhile (==head a) a
        c = takeWhile (==head b) b
        nb = n - length b
        nc = length c
    print $ if nc == 1 then nb + 1 else nb

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Data.List
import Data.Maybe
import Control.Monad

finddiff :: [Int] -> Int
finddiff lst =
  if (== 1) $ length $ head grouped
  then head $ head grouped
  else head $ last grouped
  where
    grouped = group $ sort lst

solve str =
  (1 +) $ fromJust $ (`elemIndex` intList) $ finddiff intList
  where intList = map read $ words str

main = do
  n <- read <$> getLine
  replicateM_  n (getLine >> solve <$> getLine >>= print)

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L

main = do
	t <- getLine >>= return . read :: IO Int
	let loop t = if t==0 then return () else do
		n <- getLine >>= return . read :: IO Int
		l <- getLine >>= return  . (fmap read) . words :: IO [Int]
		let a
			| l!!0 == l!!1 = l !! 0
			| l!!0 == l!!2 = l !! 0
			| l!!1 == l!!2 = l !! 1
		print $ [i+1 | (i, x) <- zip [0..] l, x /= a] !! 0
		loop $ t - 1
	loop t

{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM_)
main :: IO ()
main = do
    i <- read @Int <$> getLine
    replicateM_ i solve

solve :: IO ()
solve = do
    i <- read @Int <$> getLine
    xs <- (read @Int <$>) . words <$> getLine
    print $ solveIter Nothing Nothing (zip [1..] xs)

solveIter :: Maybe (Int, Int) -> Maybe (Int, Int) -> [(Int, Int)] -> Int
solveIter Nothing Nothing (x@(i, v):xs) = solveIter (Just x) Nothing xs

solveIter (Just y@(iy, vy)) Nothing (x@(ix, vx):xs)
  | vx == vy = fst . head . dropWhile ((== vx) . snd) $ xs
  | otherwise = solveIter (Just y) (Just x) xs

solveIter (Just y@(iy, vy)) (Just (iz, vz)) ((x@(ix, vx):xs))
  | vx == vy = iz
  | otherwise = iy

solveIter a b c = error $ show a ++ show b ++ show c

{-# LANGUAGE BlockArguments #-}

module Main where

import System.IO
import Data.Traversable
import Data.Foldable
import Data.Maybe
import Data.List
import Data.Monoid
import Data.Semigroup

main :: IO ()
main = do
  contents <- getContents
  let inputs :: [[Int]]
      inputs = map (map read . words) . filterEvens . tail . lines $ contents
  traverse_ (print . f) inputs

f :: [Int] -> Int
f (a:b:c:rest) = case commonElement (a, b, c) of
  Left n -> n
  Right n -> (+4) . fromMaybe (error "no spy detected") $ findIndex (/= n) rest
f _ = error "input less than 3 elements"

commonElement :: (Int, Int, Int) -> Either Int Int
commonElement (a, b, c)
  | a == b && b == c = Right a
  | a == b = Left 3
  | b == c = Left 1
  | a == c = Left 2

filterEvens :: [a] -> [a]
filterEvens (a : b : rest) = b : filterEvens rest
filterEvens _ = []

import Control.Monad
import Data.List (sort, group, elemIndex)
import Data.Maybe

readInts str = map (read :: String -> Int) (words str)

solve = do
  n <- readLn :: IO Int
  input <- getLine

  let a = map (read :: String -> Int) (words input)
  let x = head $ head $ filter (\x -> length x == 1) (group $ sort a)

  let ans = (fromJust $ elemIndex x a) + 1

  print ans

main = do
  t <- readLn :: IO Int

  replicateM_ t solve

import Control.Monad
import Data.List (sort, group, elemIndex)
import Data.Maybe

readInts str = map (read :: String -> Int) (words str)

solve = do
  n <- readLn :: IO Int
  input <- getLine

  let a = map (read :: String -> Int) (words input)
  let x = head $ head $ filter (\x -> length x == 1) (group $ sort a)

  let ans = fromJust $ elemIndex x a

  print (ans + 1)

main = do
  t <- readLn :: IO Int

  replicateM_ t solve

module Main where
   import Data.List

   solve :: IO ()
   solve = do
       n <- getLine
       s <- getLine
       let a = map (\x -> read x :: Integer) $ words s
           b = sort a
       print $ head [i + 1 | i <- [0..(read n :: Int) - 1], a !! i /= b !! 1]

   iter :: Integer -> IO ()
   iter 1 = solve
   iter x = do
       solve
       iter $ x - 1

   main :: IO ()
   main = do
       q <- getLine
       iter (read q :: Integer)

{-# LANGUAGE BlockArguments #-}

module Main where

import System.IO
import Data.Traversable
import Data.Foldable
import Data.Maybe
import Data.List
import Data.Monoid
import Data.Semigroup

main :: IO ()
main = do
  contents <- getContents
  let inputs :: [[Int]]
      inputs = map (map read . words) . filterEvens . tail . lines $ contents
  print inputs
  traverse_ (print . f) inputs

f :: [Int] -> Int
f (a:b:c:rest) = case commonElement (a, b, c) of
  Left n -> n
  Right n -> (+4) . fromMaybe (error "no spy detected") $ findIndex (/= n) rest
f _ = error "input less than 3 elements"

commonElement :: (Int, Int, Int) -> Either Int Int
commonElement (a, b, c)
  | a == b && b == c = Right a
  | a == b = Left 3
  | b == c = Left 1
  | a == c = Left 2

filterEvens :: [a] -> [a]
filterEvens (a : b : rest) = b : filterEvens rest
filterEvens _ = []

{-# LANGUAGE BlockArguments #-}

module Main where

import System.IO
import Data.Traversable
import Data.Foldable
import Data.Maybe
import Data.List
import Data.Monoid
import Data.Semigroup

main :: IO ()
main = do
  contents <- getContents
  let inputs :: [[Int]]
      inputs = map (map read . words) . filterEvens . tail . lines $ contents
  traverse_ (print . f) inputs

f :: [Int] -> Int
f (a:b:c:rest) = case commonElement (a, b, c) of
  Left n -> n
  Right n -> fromMaybe (error "no spy detected") $ find (== n) rest
f _ = error "input less than 3 elements"

commonElement :: (Int, Int, Int) -> Either Int Int
commonElement (a, b, c)
  | a == b && b == c = Right a
  | a == b = Left c
  | b == c = Left a
  | a == c = Left b

filterEvens :: [a] -> [a]
filterEvens (a : b : rest) = b : filterEvens rest
filterEvens _ = []

module Main where
   import Data.List

   solve :: IO ()
   solve = do
       n <- getLine
       s <- getLine
       let a = map (\x -> read x :: Integer) $ words s
           b = sort a
       print $ length [i + 1 | i <- [0..(read n :: Int) - 1], a !! i /= b !! 1]

   iter :: Integer -> IO ()
   iter 1 = solve
   iter x = do
       solve
       iter $ x - 1

   main :: IO ()
   main = do
       q <- getLine
       iter (read q :: Integer)


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, range, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

type IntMod = Int64

infixl 6 +%

modulus :: IntMod
modulus = 1000000007

(+%) :: IntMod -> IntMod -> IntMod
x +% y = case x + y of xy -> if xy < modulus then xy else xy - modulus
{-# INLINE (+%) #-}

main :: IO ()
main = do
  [_,k] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve k xs

lim :: Int
lim = 100000

solve :: Int -> [Int] -> [IntMod]
solve k xs = map (`mod` modulus) $ go xs
   where
     go (a:b:rest) = query a b : go rest
     go _ = []
     query a b
       | a<b = unsafeAt res b - unsafeAt res (a-1)
       | otherwise = unsafeAt dp a
     res :: UArray Int IntMod
     !res = listArray (0,lim) .scanl1(+%)$map (unsafeAt dp)[0..lim]
     !dp = runSTUArray $ do
       dp <- newArray_ (0,lim) :: ST s (STUArray s Int Int64)
       unsafeWrite dp 0 1
       for 1 (<=lim) (1+) $ \i -> do
         if k<=i then do
           (+%) <$> unsafeRead dp (i-1) <*> unsafeRead dp (i-k) >>= unsafeWrite dp i
         else do
           unsafeRead dp (i-1) >>= unsafeWrite dp i
       return dp

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = (pr!b - pr!(a-1)) `mod` m
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl1 (+!) r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b

import Data.Array.ST.Safe
import Control.Monad.ST
import Control.Monad
main = do
  [t,k] <- map read . words <$> getLine
  replicateM_ t $ do
    [a,b] <- map read . words <$> getLine
    print (solve k a b)
m = 10^9 + 7
solve k a b = runST $ do
  dp <- newArray (0,b) 0 :: ST s (STUArray s Int Int)
  writeArray dp 0 1
  forM_ [1..b] $ \i -> do
    white <- if i >= k then readArray dp (i-k) else pure 0
    red <- readArray dp (i-1)
    writeArray dp i (red + white)
  sum <$> mapM (readArray dp) [a..b]

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = pr!b - pr!(a-1)
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl1 (+) r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = pr!b - pr!(a-1)
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl (+) 0 r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = pr!b - pr!(a-1)
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl1 (+!) r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b


--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[_n],as,bs] <- replicateM 3 ri
        return (as,bs)
    mapM_ (putStrLn.show.solve) tcs

solve (as,bs) = min numDiff (1+numChg)
  where
    numDiff = length . filter (uncurry (/=)) $ zip as bs
    cnt1A = length . filter (==1) $ as
    cnt1B = length . filter (==1) $ bs
    numChg = abs (cnt1A - cnt1B)

import Control.Monad (forM_)

readInts :: IO [Int]
readInts = do
  s <- getLine
  return $ map read $ words s

diff :: [Int] -> [Int] -> Int
diff a b = sum $ zipWith (\x y -> if x /= y then 1 else 0) a b

count :: (a -> Bool) -> [a] -> Int
count p = length . filter p

countOnes :: [Int] -> Int
countOnes = count $ \x -> x == 1

solve :: IO ()
solve = do
  _ <- readInts
  a <- readInts
  b <- readInts
  let ca = countOnes a
  let cb = countOnes b
  let ans = if a == b then 0
            else (1 + abs (ca - cb)) `min` (diff a b)
  print ans

main :: IO ()
main = do
  [cnt] <- readInts
  forM_ (replicate cnt 0) $ \_ -> solve

import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    [t] <- getInts
    replicateM_ t $ do
        _ <- getInts
        as <- getInts
        bs <- getInts
        let diff xs ys = sum $ map fromEnum $ zipWith (/=) xs ys
        print $ min (diff as bs) (diff (sort as) (sort bs) + 1)

getInts :: IO [Int]
getInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine


-- pragmas.hs  {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad            (replicateM_)
import           Data.Array               (Array, (!))
import           Data.Bool                (bool)
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as C
import qualified Data.ByteString.Internal as BSI
import qualified Data.IntMap              as IntMap
import           Data.Ix                  (Ix)
import           Debug.Trace              (trace)

solve :: String -> Bool
solve str = firstCondition && all (uncurry (==)) (zip alpha str)
  where
  first = head str
  alpha = dropWhile (/=first) (cycle "Yes")
  firstCondition = first == 'Y' || first == 'e' || first == 's'

doCase :: IO ()
doCase = do
  str <- getLine
  putStrLn $ bool "No" "Yes" $ solve str

main :: IO ()
main = getInt >>= flip replicateM_ doCase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts str = readInt <$> BS.split (BSI.c2w ' ') str

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

getInts :: IO [Int]
getInts = readInts <$> C.getLine

import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Maybe
import Control.Monad

dfa :: String -> Bool
dfa = (/= '?') . foldl' f '$' where
  f '$' 'Y' = 'Y'
  f '$' 'e' = 'e'
  f '$' 's' = 's'
  f 'Y' 'e' = 'e'
  f 'e' 's' = 's'
  f 's' 'Y' = 'Y'
  f  _   _  = '?'

main = do
  [n] <- readInts
  replicateM_ n $ getLine >>= putStrLn . (["NO","YES"] !!) . fromEnum . dfa

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine


import Data.Int

readCases :: [String] -> [[Int64]]
readCases [] = []
readCases (x:xs) = map read a : readCases rs
  where (a, rs) = splitAt (read x) xs

solveCase :: [Int64] -> Int64
solveCase a = g * (n-1) - s
  where n = fromIntegral $ length a
        s = sum a
        m = (s+n-2) `div` (n-1)
        g = maximum (m : a)

solve :: String -> String
solve = unlines . map show . map solveCase . readCases . tail . words

main = interact solve


module Main where

    solve :: IO ()
    solve = do
        s <- getLine
        let n = read s :: Integer
        putStrLn $ concat $ map (\x -> show x ++ " ") [1..n]

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        s <- getLine
        iter (read s :: Integer)

prettier :: [Int] -> String
prettier [] = ""
prettier (x:xs) = (show x) ++ " " ++ (prettier xs)

readInt :: IO Int
readInt = do
    line <- getLine
    return $ read line

main :: IO ()
main = do
    t <- readInt
    for t where
        for 0 = return ()
        for i = do
            n <- readInt
            putStrLn $ prettier $ [n,(n-1)..1]
            for (i-1)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  putStrLn $ unwords $ map show [1 .. n]

readInt x = read x :: Int

mPrint [] = putStrLn ""
mPrint (x:xs) = do
  putStr (show x)
  putStr " "
  mPrint xs

task = do
  kL <- getLine
  let k = readInt kL
  mPrint (take k [1..])

allTasks 0 = putStrLn ""
allTasks n = do
  task
  allTasks (n - 1)

main = do
  nL <- getLine
  let n = readInt nL
  allTasks n

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

onecase = do
		x<- read <$> getLine ::IO Int
		putStrLn $ intercalate " " $ map show [1..x]
main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

solve :: Int -> [Int]
solve = enumFromTo 1

main :: IO ()
main = interact (unlines . map (unwords . map show . solve . read) . tail . words)

import Control.Monad
import Control.Applicative
import Data.List

readInts :: IO [Int]
readInts = map read . words <$> getLine

f :: Int -> [String]
f cnt = if cnt == 0 then [] else f (cnt - 1) ++ [show cnt]

main :: IO ()
main = do
    t <- readLn
    a <- replicateM t $ readLn
    let b = (map f a)
    putStrLn $ unwords (map unwords b)

import Control.Monad
import Control.Applicative
import Data.List

readInts :: IO [Int]
readInts = map read . words <$> getLine

f :: Int -> [String]
f cnt = if cnt == 0 then ["\n"] else f (cnt - 1) ++ [show cnt]

main :: IO ()
main = do
    t <- readLn
    a <- replicateM t $ readLn
    let b = (map f a)
    putStrLn $ unwords (map unwords b)