Colonel has n badges. He wants to give one badge to every of his n soldiers. Each badge has a coolness factor, which shows how much it's owner reached. Coolness factor can be increased by one for the cost of one coin. For every pair of soldiers one of them should get a badge with strictly higher factor than the second one. Exact values of their factors aren't important, they just need to have distinct factors. Colonel knows, which soldier is supposed to get which badge initially, but there is a problem. Some of badges may have the same factor of coolness. Help him and calculate how much money has to be paid for making all badges have different factors of coolness.

First line of input consists of one integer n (1 ≤ n ≤ 3000). Next line consists of n integers ai (1 ≤ ai ≤ n), which stand for coolness factor of each badge.

Output single integer — minimum amount of coins the colonel has to pay.

NoteIn first sample test we can increase factor of first badge by 1.In second sample test we can increase factors of the second and the third badge by 1.

-- http://codeforces.com/problemset/problem/546/B

import Data.List
import Data.Maybe
import qualified Data.Map.Strict as Map

createMap :: [[Int]] -> Map.Map Int Int
createMap [] = Map.empty
createMap (x:xs) = Map.insert (head x) (length x) $ createMap xs

main = do

	n <- fmap read getLine :: IO Int
	badges <- fmap sort $ fmap (map read) $ fmap words $ getLine :: IO [Int]

	let
		money_spent = giveBadges 0 badges

	putStrLn $ show money_spent

giveBadges :: Int -> [Int] -> Int
giveBadges _ [] = 0
giveBadges prev (x:xs) =
	let
		calc = if prev >= x then prev - x + 1 else 0
	in
		calc + giveBadges (max (prev + 1) x) xs

-- http://codeforces.com/problemset/problem/546/B

import Data.List

main = do

	n <- fmap read getLine :: IO Int
	badges <- fmap sort $ fmap (map read) $ fmap words $ getLine :: IO [Int]

	let
		money_spent = giveBadges 0 badges

	putStrLn $ show money_spent

giveBadges :: Int -> [Int] -> Int
giveBadges _ [] = 0
giveBadges prev (x:xs) =
	let
		calc = if prev >= x then prev - x + 1 else 0
	in
		calc + giveBadges (max (prev + 1) x) xs

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  xs <- getInts

  let
    f _ [] = 0
    f m (x:xs)
      | x > m = f (x+1) xs
      | otherwise = (m-x) + f (m+1) xs

  print $ f (minimum xs) $ sort xs

-- Codeforces 546B

import Data.List

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getLine >>= print . solve . sort . map read . words

-- note: only cdn increase the coolness value, can't decrease it, so need do sort.

solve :: [Int] -> Int
solve [] = 0
solve [_] = 0
solve (x:y:xs) = if (y <= x) then (x-y+1) + solve (x+1:xs) else solve (y:xs)

import Data.List
import Data.Map (Map)

main = do
    getLine
    input <- getLine
    let fs = sort $ map (read :: String -> Int) (words input)
    putStrLn $ show $ f fs

f :: [Int] -> Int
f [] = 0
f [_] = 0
f (x:y:xs) = if y <= x then x - y + 1 + f (x + 1:xs) else f (y:xs)

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

process::Int->Int->[Int]->Int
process n m [] | m==0 =n
               | otherwise = process (n+m) (m-1) []
process n m (x:xs) | x==0 && m>0 = process (n+m) (m-1) xs
                   | x==0 = process n m xs
                   | x==1 = process (n+m) m xs
                   | otherwise = process (n+m) (m+x-1) xs

main = do
  n <- read <$> getLine::IO Int
  d<-map read <$> words <$> getLine ::IO [Int]
  let x = accumArray (+) 0 (1,n) $ zip d (repeat 1)
  print $ process 0 0 (elems x)

import Data.List (sort)

main :: IO ()
main = print . solve . map read . tail . words =<< getContents

solve :: [Int] -> Int
solve xs = sum (scanl (\x y -> max (x + 1) y) 0 (sort xs)) - sum xs

import Data.List
main = interact $ show . solve 0 . sort . map read . tail . words
solve p (a:as) | a <= p = p-a+1 + solve (p+1) as
               | otherwise = solve a as
solve _ [] = 0

import Control.Applicative
import Control.Monad
import Data.Array

process [] x y = x + (div (y*(y+1)) 2)
process (a:as) x y	| a==0 = process as (x+y) (max (y-1) 0)
                 	| a==1 = process as (x+y) y
	                | otherwise = process as (x+y) (y+a-1)

main= do
	n<-read <$> getLine::IO Int
	s<- map read .words <$> getLine ::IO [Int]
	let a= accumArray (+) 0 (1,3000) [(i,1)|i<-s]
	print $ process (elems a) 0 0

import Data.List (sort)

main :: IO ()
main = print . solve . (map read . words . (!! 1) . lines) =<< getContents

solve :: [Int] -> Int
solve = fst . foldl step (0, 0) . sort
        where step (sum, m) a = let b = max (m + 1) a
                                    d = max 0 (b - a)
                                in (sum + d, b)

-- http://codeforces.com/problemset/problem/546/B

import Data.List
import Data.Maybe
import qualified Data.Map.Strict as Map

createMap :: [[Int]] -> Map.Map Int Int
createMap [] = Map.empty
createMap (x:xs) = Map.insert (head x) (length x) $ createMap xs

main = do

	n <- fmap read getLine :: IO Int
	badges <- fmap group $ fmap sort $ fmap (map read) $ fmap words $ getLine :: IO [[Int]]

	let
		badges_list = map head $ badges
		descriptor = createMap badges
		money_spent = giveBadges badges_list descriptor

	putStrLn $ show money_spent

giveBadges :: [Int] -> Map.Map Int Int -> Int
giveBadges [] _ = 0
giveBadges badges@(b:bs) map
	| total_of_badge > 1 = 1 + (giveBadges badges $ updateMap b (b+1) map)
	| otherwise = giveBadges bs map
	where
		total_of_badge = fromJust $ Map.lookup b map

		updateMap :: Int -> Int -> Map.Map Int Int -> Map.Map Int Int
		updateMap a b map =
			let
				mapA = case Map.lookup a map of
					Nothing -> Map.insert a 1 map
					Just 1 -> Map.delete a map
					Just _ -> Map.adjust (+(-1)) a map
				mapB = case Map.lookup b mapA of
					Nothing -> Map.insert b 1 mapA
					Just _ -> Map.adjust (+1) b mapA
			in
				mapB

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  xs <- getInts

  let
    f _ [] = 0
    f (x:xs) ys = abs (x-m) + f xs (ys \\ [m])
      where
        m = minimumBy (comparing (\v -> abs $ v - x)) ys

  print $ f xs [1..n]

-- Codeforces 546B

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getLine >>= print . solve . map read . words

solve :: [Int] -> Int
solve xs = (m * (m+1) `div` 2) - sum xs where m = maximum xs

import Data.List
import Data.Map (Map)

main = do
    getLine
    input <- getLine
    let fs = reverse . sort $ map (read :: String -> Int) (words input)
    putStrLn $ show $ f (length fs) fs

f :: Int -> [Int] -> Int
f _ [] = 0
f max (x:xs) = (max - x) + f (max - 1) xs

import Data.List
import Data.Map (Map)

main = do
    getLine
    input <- getLine
    let fs = reverse . sort $ map (read :: String -> Int) (words input)
    putStrLn $ show $ f (length fs + minimum fs - 1) fs

f :: Int -> [Int] -> Int
f _ [] = 0
f max (x:xs) = (max - x) + f (max - 1) xs

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

process::Int->Int->[Int]->Int
process n m [] | m==0 =n
               | otherwise = process (n+m) (m-1) []
process n m (x:xs) | x==0 && m>0 = process (n+m) (m-1) xs
                   | x==0 = process n m xs
                   | x==1 = process (n+m) m xs
                   | otherwise = process n (m+x-1) xs

main = do
  n <- read <$> getLine::IO Int
  d<-map read <$> words <$> getLine ::IO [Int]
  let x = accumArray (+) 0 (1,n) $ zip d (repeat 1)
  print $ process 0 0 (elems x)

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))
import Data.List (sort)

main :: IO ()
main = print =<< solve <$> readLn <*> (map read <$> words <$> getLine)

solve :: Int -> [Int] -> Int
solve n xs = sum ys - n * min 0 (minimum ys)
  where ys = zipWith (-) (enumFrom (minimum xs)) (sort xs)

import Data.List (sort)

main :: IO ()
main = print . solve . map read . tail . words =<< getContents

solve :: [Int] -> Int
solve = sum . zipWith (-) [1..] . sort

import Control.Arrow ((&&&))
import Data.List (sort)

main :: IO ()
main = print . solve . map read . tail . words =<< getContents

solve :: [Int] -> Int
solve = sum . uncurry (zipWith (-)) . (enumFrom . minimum &&& sort)

import Data.List (sort)

main :: IO ()
main = print . solve . (map read . words . (!! 1) . lines) =<< getContents

solve :: [Int] -> Int
solve a = length . filter id $ zipWith (>) [1..n] (sort a)
          where n = length a


A traveler is planning a water hike along the river. He noted the suitable rest points for the night and wrote out their distances from the starting point. Each of these locations is further characterized by its picturesqueness, so for the i-th rest point the distance from the start equals xi, and its picturesqueness equals bi. The traveler will move down the river in one direction, we can assume that he will start from point 0 on the coordinate axis and rest points are points with coordinates xi.Every day the traveler wants to cover the distance l. In practice, it turns out that this is not always possible, because he needs to end each day at one of the resting points. In addition, the traveler is choosing between two desires: cover distance l every day and visit the most picturesque places.Let's assume that if the traveler covers distance rj in a day, then he feels frustration , and his total frustration over the hike is calculated as the total frustration on all days.Help him plan the route so as to minimize the relative total frustration: the total frustration divided by the total picturesqueness of all the rest points he used.The traveler's path must end in the farthest rest point.

The first line of the input contains integers n, l (1 ≤ n ≤ 1000, 1 ≤ l ≤ 105) — the number of rest points and the optimal length of one day path. Then n lines follow, each line describes one rest point as a pair of integers xi, bi (1 ≤ xi, bi ≤ 106). No two rest points have the same xi, the lines are given in the order of strictly increasing xi.

Print the traveler's path as a sequence of the numbers of the resting points he used in the order he used them. Number the points from 1 to n in the order of increasing xi. The last printed number must be equal to n.

NoteIn the sample test the minimum value of relative total frustration approximately equals 0.097549. This value can be calculated as .

path :: [Int] -> Int -> [Int]
path [_] _ = []
path (x : xs) 0 = pos : path xs (pos - x - 1)
    where pos = length xs
path (x : xs) n = path xs (n - 1)

frust :: Double -> Double -> Double
frust x l = sqrt . abs $ x - l

findMin :: Double -> Double -> [(Double, Double)] -> [(Double, Int)] -> (Double, Int)
findMin x l [] [_] = (frust x l, 0)
findMin x l (x' : xs) (y : ys)
    | at < rel = (at, n)
    | otherwise = (rel, pos)
    where (rel, pos) = findMin x l xs ys
          at = fst y + frust (x - fst x') l
          n = length ys

dynamic :: [(Double, Double)] -> Double -> [(Double, Int)]
dynamic [] _ = [(0.0, -1)]
dynamic (x : xs) l = let next = dynamic xs l
                         best = findMin (fst x) l xs next
                      in (fst best - snd x, snd best) : next

solve :: Double -> [(Double, Double)] -> Double -> (Double, [Int])
solve p v l = let v' = reverse . map (\(x, y) -> (x, p * y)) $ v
                  sol = dynamic v' l
               in (fst . head $ sol, reverse $ path (map snd sol) 0)

binarySearch :: Double -> Double -> Int -> [(Double, Double)] -> Double -> [Int]
binarySearch lower upper 0 v l = snd $ solve lower v l
binarySearch lower upper step v l
    | rel < 0.0 = binarySearch lower mid (step - 1) v l
    | otherwise = binarySearch mid upper (step - 1) v l
    where mid = (lower + upper) / 2.0
          (rel, _) = solve mid v l

paraSearch :: [(Double, Double)] -> Double -> [Int]
paraSearch v l = let lowerBound = 0.0
                     upperBound = 1000000.0
                     step = 50
                  in binarySearch lowerBound upperBound step v l

makePair :: [String] -> (Double, Double)
makePair [x, y] = (read x, read y)

main = do
    [_, l] <- getLine >>= (return . map (read :: String -> Double) . words)
    p <- getContents >>= (return . map (makePair . words) . lines)
    putStrLn $ unwords $ map show $ paraSearch p l

path :: [Int] -> Int -> [Int]
path [_] _ = []
path (x : xs) 0 = pos : path xs (pos - x - 1)
    where pos = length xs
path (x : xs) n = path xs (n - 1)

frust :: Double -> Double -> Double
frust x l = sqrt . abs $ x - l

findMin :: Double -> Double -> [(Double, Double)] -> [(Double, Int)] -> (Double, Int)
findMin x l [] [_] = (frust x l, 0)
findMin x l (x' : xs) (y : ys)
    | at < rel = (at, n)
    | otherwise = (rel, pos)
    where (rel, pos) = findMin x l xs ys
          at = fst y + frust (x - fst x') l - snd x'
          n = length ys

dynamic :: [(Double, Double)] -> Double -> [(Double, Int)]
dynamic [] _ = [(0.0, -1)]
dynamic (x : xs) l = let next = dynamic xs l
                         best = findMin (fst x) l xs next
                      in (fst best - snd x, snd best) : next

solve :: Double -> [(Double, Double)] -> Double -> (Double, [Int])
solve p v l = let v' = reverse . map (\(x, y) -> (x, p * y)) $ v
                  sol = dynamic v' l
               in (fst . head $ sol, reverse $ path (map snd sol) 0)

binarySearch :: Double -> Double -> Int -> [(Double, Double)] -> Double -> [Int]
binarySearch lower upper 0 v l = snd $ solve lower v l
binarySearch lower upper step v l
    | rel < 0.0 = binarySearch lower mid (step - 1) v l
    | otherwise = binarySearch mid upper (step - 1) v l
    where mid = (lower + upper) / 2.0
          (rel, _) = solve mid v l

paraSearch :: [(Double, Double)] -> Double -> [Int]
paraSearch v l = let lowerBound = 0.0
                     upperBound = 1000000.0
                     step = 50
                  in binarySearch lowerBound upperBound step v l

makePair :: [String] -> (Double, Double)
makePair [x, y] = (read x, read y)

main = do
    [_, l] <- getLine >>= (return . map (read :: String -> Double) . words)
    p <- getContents >>= (return . map (makePair . words) . lines)
    putStrLn $ unwords $ map show $ paraSearch p l


SmallR is an archer. SmallR is taking a match of archer with Zanoes. They try to shoot in the target in turns, and SmallR shoots first. The probability of shooting the target each time is  for SmallR while  for Zanoes. The one who shoots in the target first should be the winner.Output the probability that SmallR will win the match.

Print a single real number, the probability that SmallR will win the match. The answer will be considered correct if the absolute or relative error doesn't exceed 10 - 6.

import Control.Applicative
import Control.Monad
import Data.List
import Text.Printf

main = do
	[ a, b, c, d ] <- map read . words <$> getLine
	printf "%.8f\n" $ solve 0 ( a / b ) ( c / d )

solve :: Int -> Double -> Double -> Double
solve 100000 _ _ = 0
solve depth prob1 prob2 = ( ( 1 - prob1 ) * ( 1 - prob2 ) ) ^ depth * prob1 + ( solve ( depth + 1 ) prob1 prob2 )

module Main where

import System.Environment
import System.Exit

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

parseList :: Read a => String -> [a]
parseList = map read . words

solve :: [Double] -> Double
solve (a:b:c:d:_) = sum $ takeWhile (>= 10**(-9)) probability
  where
    probability :: [Double]
    probability = map (*p) . zipWith (flip (^)) [0..] $ repeat q

    -- The first is the winner
    p :: Double
    p = a / b

    -- No one is winner
    q :: Double
    q = (1 - p) * (1 - c / d)

solve _           = undefined

module Main where

import System.Environment
import System.Exit

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

parseList :: Read a => String -> [a]
parseList = map read . words

-- solve :: [Double] -> Double
-- solve (a:b:c:d:_) = sum $ takeWhile (>= 10**(-9)) probability
--   where
--     probability :: [Double]
--     probability = map (*p) . zipWith (flip (^)) [0..] $ repeat q
--
--     -- The first is the winner
--     p :: Double
--     p = a / b
--
--      -- No one is winner
--     q :: Double
--     q = (1 - p) * (1 - c / d)
--
-- solve _           = undefined

solve :: [Double] -> Double
solve (a:b:c:d:_) = p / (1 - q)
  where
    -- The first is the winner
    p :: Double
    p = a / b

    -- No one is winner
    q :: Double
    q = (1 - p) * (1 - c / d)

solve :: Double -> Double -> Double -> Double -> Double
solve a b c d =
    p1 * (sum $ takeWhile (> 10**(-6)) $ iterate (* k) 1)
  where
    p1 = a / b
    k = (1 - p1) * (1 - c / d)

main = do
  [a, b, c, d] <- (map read . words) `fmap` getLine
  print $ solve a b c d

import Control.Monad (liftM)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

data Player  =  S | Z
  deriving Eq

solve :: [Int] -> Double
solve as  =  solve' S 1.0
  where
    eps  =  1e-09
    [a, b, c, d]  =  map fromIntegral as
    solve' player p
      | p <= eps  =  0
      | player == S  =  p * a / b + solve' Z (p * (1 - a / b))
      | player == Z  =  solve' S (p * (1 - c / d))

main :: IO ()
main  =  reads >>= print . solve

main = interact $ show . getAnswer . map read . words
    where getAnswer [a, b, c, d] = (a * d) / (a * d + b * c - a * c)

readInts :: String -> [Double]
readInts str = map read (words str)

main :: IO ()
main = do
  [a,b,c,d] <- fmap readInts getLine
  --print $ (b*b/d)/(a*b*c+a*a*b-a*a*c)
  let p = a/b
  let _p = 1-p
  let _q = 1-c/d
  print $ p/(1-_p*_q)

main = do
    l <- getLine
    let a = (map read (words l)) :: [Double]
    let b = (a!!0 * a!!3 / (a!!0*a!!3 + a!!1*a!!2 - a!!0*a!!2)) :: Double
    putStrLn(show(b))

import Control.Applicative
import Control.Monad
import Data.List
import Text.Printf

main = do
	[ a, b, c, d ] <- map read . words <$> getLine
	printf "%.7f\n" $ solve 0 ( a / b ) ( c / d )

solve :: Int -> Double -> Double -> Double
solve 1000 _ _ = 0
solve depth prob1 prob2 = ( ( 1 - prob1 ) * ( 1 - prob2 ) ) ^ depth * prob1 + ( solve ( depth + 1 ) prob1 prob2 )

module Main where

import System.Environment
import System.Exit

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

parseList :: Read a => String -> [a]
parseList = map read . words

solve :: [Double] -> Double
solve (a:b:c:d:_) = sum $ takeWhile (>= 10**(-7)) probability
  where
    probability :: [Double]
    probability = map (*p) . zipWith (flip (^)) [0..] $ repeat q

    -- The first is the winner
    p :: Double
    p = a / b

    -- No one is winner
    q :: Double
    q = (1 - p) * (1 - c / d)

solve _           = undefined

module Main where

import System.Environment
import System.Exit

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

parseList :: Read a => String -> [a]
parseList = map read . words

solve :: [Double] -> Double
solve (a:b:c:d:_) = sum $ takeWhile (>= 10**(-6)) probability
  where
    probability :: [Double]
    probability = map (*p) . zipWith (flip (^)) [0..] $ repeat q

    -- The first is the winner
    p :: Double
    p = a / b

    -- No one is winner
    q :: Double
    q = (1 - p) * (1 - c / d)

solve _           = undefined

readInts :: String -> [Double]
readInts str = map read (words str)

main :: IO ()
main = do
  [a,b,c,d] <- fmap readInts getLine
  print $ (b*b/d)/(a*b*c+a*a*b-a*a*c)

main = do
    l <- getLine
    let a = (map read (words l)) :: [Double]
    let b = (a!!0 * a!!3 / (a!!1*a!!3 - a!!0*a!!2)) :: Double
    putStrLn(show(b))


Igor is in the museum and he wants to see as many pictures as possible.Museum can be represented as a rectangular field of n × m cells. Each cell is either empty or impassable. Empty cells are marked with '.', impassable cells are marked with '*'. Every two adjacent cells of different types (one empty and one impassable) are divided by a wall containing one picture.At the beginning Igor is in some empty cell. At every moment he can move to any empty cell that share a side with the current one.For several starting positions you should calculate the maximum number of pictures that Igor can see. Igor is able to see the picture only if he is in the cell adjacent to the wall with this picture. Igor have a lot of time, so he will examine every picture he can see.

First line of the input contains three integers n, m and k (3 ≤ n, m ≤ 1000, 1 ≤ k ≤ min(n·m, 100 000)) — the museum dimensions and the number of starting positions to process. Each of the next n lines contains m symbols '.', '*' — the description of the museum. It is guaranteed that all border cells are impassable, so Igor can't go out from the museum. Each of the last k lines contains two integers x and y (1 ≤ x ≤ n, 1 ≤ y ≤ m) — the row and the column of one of Igor's starting positions respectively. Rows are numbered from top to bottom, columns — from left to right. It is guaranteed that all starting positions are empty cells.

Print k integers — the maximum number of pictures, that Igor can see if he starts in corresponding position.

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

{-# 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, 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

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

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

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

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

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

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