Problem:
Score : 300 points

Problem Statement

There is a grid with H rows and W columns, where each square is painted black or white.

You are given H strings S_1, S_2, ..., S_H, each of length W.
If the square at the i-th row from the top and the j-th column from the left is painted black, the j-th character in the string S_i is #; if that square is painted white, the j-th character in the string S_i is ..

Find the number of pairs of a black square c_1 and a white square c_2 that satisfy the following condition:

There is a path from the square c_1 to the square c_2 where we repeatedly move to a vertically or horizontally adjacent square through an alternating sequence of black and white squares: black, white, black, white...

Constraints

1 \leq H, W \leq 400

|S_i| = W (1 \leq i \leq H)

For each i (1 \leq i \leq H), the string S_i consists of characters # and ..

Input

Input is given from Standard Input in the following format:

H W
S_1
S_2
:
S_H

Output

Print the answer.

Sample Input 1

3 3
.#.
..#
#..

Sample Output 1

10

Some of the pairs satisfying the condition are ((1, 2), (3, 3)) and ((3, 1), (3, 2)), where (i, j) denotes the square at the i-th row from the top and the j-th column from the left.

Sample Input 2

2 4
....
....

Sample Output 2

0

Sample Input 3

4 3
###
###
...
###

Sample Output 3

6

Solution in Haskell (GHC 7.10.3) (judge verdict: Time Limit Exceeded)


import Data.Array
import Control.Monad
import Debug.Trace
import Data.List
import Data.Maybe
--import qualified Data.Map as Map
import qualified Data.Set as Set

main = do
    [nX, nY] <- map read . words <$> getLine :: IO [Int]
    -- ms <- map (map read . words) <$> replicateM nX getLine :: IO [String]
    ms <- replicateM nX getLine :: IO [String]
    -- print $ ms
    let arr = listArray ((1,1),(nX,nY)) $ join ms
    -- print $ arr
    let black = [(x,y,nX,nY,[]) | x<-[1..nX], y<-[1..nY], arr ! (x,y) == '#']
    -- print $ black
    -- print $ sum $ map (\x -> search x arr) black
    let ans = filter isJust . map (\x -> search x arr) $ black
    -- print $ ans
    if ans == [] then print 0 else print . sum . map (\x -> Set.size $ Set.fromList (fromJust x)) $ ans -- nub means Essence

search :: (Int,Int,Int,Int,[(Int,Int)]) -> Array (Int, Int) Char -> Maybe [(Int,Int)]
-- search (a,b,nX,nY,path) ms = trace ("(a,b,l,r,u,d) (" ++ show a ++ "," ++ show b ++ "," ++ show l ++ "," ++ show r ++ "," ++ show u ++ "," ++ show d ++ ")") $ mconcat [l_cell,r_cell,u_cell,d_cell]
search (a,b,nX,nY,path) ms = mconcat [l_cell,r_cell,u_cell,d_cell]
    where 
        mark = ms ! (a,b)
        l = if b-1 /= 0 && not ((a, b-1) `elem` path) then ms ! (a, b-1) else 'O'
        r = if b+1 <= nY && not ((a, b+1) `elem` path) then ms ! (a, b+1) else 'O'
        u = if a-1 /= 0 && not ((a-1, b) `elem` path) then ms ! (a-1, b) else 'O'
        d = if a+1 <= nX && not ((a+1, b) `elem` path) then ms ! (a+1, b) else 'O'
        -- trace ("(a,b,l,r,u,d) (" ++ show a ++ "," ++ show b ++ "," ++ show l ++ "," ++ show r ++ "," ++ show u ++ "," ++ show d ++ ")") # ダメ
        l_cell = if l /= 'O' &&  l == change mark then search (a, b-1, nX, nY, (a, b) : path) ms else Nothing `mappend` canAdd mark (a,b)
        r_cell = if r /= 'O' &&  r == change mark then search (a, b+1, nX, nY, (a, b) : path) ms else Nothing `mappend` canAdd mark (a,b)
        u_cell = if u /= 'O' &&  u == change mark then search (a-1, b, nX, nY, (a, b) : path) ms else Nothing `mappend` canAdd mark (a,b)
        d_cell = if d /= 'O' &&  d == change mark then search (a+1, b, nX, nY, (a, b) : path) ms else Nothing `mappend` canAdd mark (a,b)

canAdd :: Char -> (Int,Int) -> Maybe [(Int,Int)]
canAdd x (a,b) = if x == '.' then Just [(a,b)] else Nothing

change :: Char -> Char
change x = if x == '#' then '.' else '#'