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: Wrong Answer)

{-# LANGUAGE BangPatterns #-}
import Control.Arrow
import Control.Monad.Fix
import Data.Foldable
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VM
import qualified Data.ByteString.Char8 as B
import System.IO.Unsafe
import Data.Graph
import Debug.Trace

newtype UnionFind = UnionFind (VM.IOVector Int, VM.IOVector Int)

findUF :: UnionFind -> Int -> Int
findUF (UnionFind (elems, _)) k = fix
  ( \f (elems, k, path) -> case unsafePerformIO (VM.read elems k) of
    n | n == k -> unsafePerformIO (forM_ path $ \p -> VM.write elems p n)
      `seq` n
    n -> f (elems, n, n : path)
  )
  (elems, k, [k])

sizeUF :: UnionFind -> Int -> Int
sizeUF (UnionFind (_, sizes)) i = unsafePerformIO (VM.read sizes i)

unionUF :: UnionFind -> Int -> Int -> UnionFind
unionUF uf@(UnionFind (elems, sizes)) i j =
  let pi  = findUF uf i
      pj  = findUF uf j
      si  = sizeUF uf pi
      sj  = sizeUF uf pj
      sij = si + sj
  in  if pi == pj
        then uf
        else
          let elems' =
                unsafePerformIO
                  $  ( if si < sj
                       then VM.write elems pi pj
                       else VM.write elems pj pi
                     )
                  >> return elems
              sizes' =
                unsafePerformIO
                  $  ( if si < sj
                       then VM.write sizes pj sij >> VM.write sizes pi 0
                       else VM.write sizes pi sij >> VM.write sizes pj 0
                     )
                  >> return sizes
          in  UnionFind (elems', sizes')

newUF :: Int -> UnionFind
newUF m = UnionFind (elems, sizes)
 where
  elems = unsafePerformIO $ VU.thaw $ VU.enumFromN 0 m
  sizes = unsafePerformIO $ VU.thaw $ VU.replicate m 0

solve :: Int -> Int -> V.Vector B.ByteString -> Int
solve h w ss =
  VU.foldl' (\acc (b, w) -> acc + b * w) 0
    $ unsafePerformIO
    $ VU.freeze
    $ VU.foldl'
        ( \acc (i, k) ->
          unsafePerformIO
            $  ( VM.modify
                 acc
                 (if ss !+ toIndex i == '#' then first (+ 1) else second (+ 1))
                 k
               )
            >> return acc
        )
        (unsafePerformIO $ VU.thaw $ VU.replicate (w * h) (0 :: Int, 0 :: Int))
    $ VU.indexed
    $ unsafePerformIO
    $ VU.freeze area
 where
  UnionFind (!area, !sizes) = foldl'
    ( \uf i ->
      foldl' (\uf' xy -> unionUF uf' i (fromIndex xy)) uf $ neighbors $ toIndex
        i
    )
    (newUF (w * h))
    [0 .. w * h - 1]

  toIndex :: Int -> (Int, Int)
  toIndex n = (n `mod` w, n `div` w)

  fromIndex :: (Int, Int) -> Int
  fromIndex (x, y) = y * w + x

  (!+) :: V.Vector B.ByteString -> (Int, Int) -> Char
  vec !+ (x, y) = (vec V.! y) `B.index` x

  neighbors (x, y) =
    [ (x', y')
    | (ix, iy) <- [(0, 1), (0, -1), (1, 0), (-1, 0)]
    , let x' = x + ix
    , let y' = y + iy
    , 0 <= x' && x' < w
    , 0 <= y' && y' < h
    , ss !+ (x', y') /= ss !+ (x, y)
    ]

main = do
  let readInt = fmap (second B.tail) . B.readInt

  hw <- V.unfoldrN 2 readInt <$> B.getLine
  ss <- V.replicateM (hw V.! 0) B.getLine
  print $ solve (hw V.! 0) (hw V.! 1) ss