Problem:
Property Distribution

タナカ氏が HW アールの果樹園を残して亡くなりました。果樹園は東西南北方向に H × W の区画に分けられ、区画ごとにリンゴ、カキ、ミカンが植えられています。タナカ氏はこんな遺言を残していました。

果樹園は区画単位でできるだけ多くの血縁者に分けること。ただし、ある区画の東西南北どれかの方向にとなりあう区画に同じ種類の果物が植えられていた場合は、区画の境界が分からないのでそれらは 1 つの大きな区画として扱うこと。

例えば次のような 3 × 10 の区画であれば ('リ'はリンゴ、'カ'はカキ、'ミ'はミカンを表す)

同じ樹がある区画の間の境界を消すと次のようになり、

結局 10 個の区画、つまり 10 人で分けられることになります。

雪が降って区画の境界が見えなくなる前に分配を終えなくてはなりません。あなたの仕事は果樹園の地図をもとに分配する区画の数を決めることです。

果樹園の地図を読み込み、分配を受けられる血縁者の人数を出力するプログラムを作成してください。

Input

複数のデータセットが与えられます。各データセットは空白で区切られた H, W (H, W ≤ 100) を含む行から始まり、続いて H × W の文字からなる H 行の文字列が与えられます。この文字列には、リンゴを表す '@'、カキを表す '#'、ミカンを表す '*'、の 3 文字しか現れません。

入力はゼロが２つの行で終わります。データセットの数は 20 を超えません。

Output

各データセットごとに、分配を受ける人数を１行に出力してください。

Sample Input

10 10
####*****@
@#@@@@#*#*
@##***@@@*
#****#*@**
##@*#@@*##
*@@@@*@@@#
***#@*@##*
*@@@*@@##@
*@*#*@##**
@****#@@#@
0 0

Output for the Sample Input

33

Solution in Haskell (judge verdict: Time Limit Exceeded)

import Control.Applicative
import Control.Monad
import Data.Array.IArray
import Data.Array.IO
import Debug.Trace

main = do
  [h,w] <- map read.words <$> getLine
  unless (h == 0 && w == 0) $ do
    field <- readField (h,w)
    num <- countPD field
    print num
    main

readField :: (Int,Int) -> IO (Array (Int,Int) Char)
readField (h,w) = do
  cs <- concat <$> replicateM h getLine
  return $ listArray ((1,1),(h,w)) cs

countPD :: Array (Int,Int) Char -> IO Int
countPD arr = do
  let bs = bounds arr
      ixList = indices arr
  ioarr <- newArray bs False
  foldl (>>=) (return 0) $ map (countPDs arr ioarr) ixList

countPDs :: Array (Int, Int) Char -> IOArray (Int, Int) Bool -> (Int, Int) -> Int -> IO Int
countPDs arr ioarr ix num = do
  checkedIx <- readArray ioarr ix
  let numIx = if checkedIx then 0 else 1
  checkProperty arr ioarr ix checkedIx
--  print (ix,num + numIx)
  return $ num + numIx

printField :: IOArray (Int, Int) Bool -> IO ()
printField ioarr = do
  ((hmin,wmin),(hmax,wmax)) <- getBounds ioarr
  forM_ [hmin..hmax] $ \i -> do
    forM_ [wmin..wmax] $ \j -> do
      b <- readArray ioarr (i,j)
      if b then putStr "T" else putStr "F"
    putStrLn ""

checkProperty :: Array (Int, Int) Char -> IOArray (Int, Int) Bool -> (Int, Int) -> Bool -> IO ()
checkProperty arr ioarr ix checkedIx = do
  if checkedIx
     then return ()
     else do
       let (h,w) = ix
       writeArray ioarr ix True
       updateField arr ioarr ix

updateField :: Array (Int, Int) Char -> IOArray (Int, Int) Bool -> (Int, Int) -> IO ()
updateField arr ioarr (h,w) = do --traceShow (h,w) $ do
  rightUpdate arr ioarr (h,w)
  underUpdate arr ioarr (h,w)

rightUpdate :: Array (Int, Int) Char -> IOArray (Int, Int) Bool -> (Int, Int) -> IO ()
rightUpdate arr ioarr (h,w) = do --trace ("right" ++ show (h,w)) $ do
  let ((hmin,wmin),(hmax,wmax)) = bounds arr
  case (hmax == h, wmax == w) of
       (_, True) -> return ()
       (True, False) -> bottomAction
       (False, False) -> normalAction
  where
    updateAction = do
      let originProp = arr ! (h,w)
          rightProp = arr ! (h,w+1)
      if originProp == rightProp
         then writeArray ioarr (h,w+1) True >> return True
         else return False
    bottomAction = do
      continue <- updateAction
      if continue then rightUpdate arr ioarr (h,w+1)
                  else return ()
    normalAction = do
      continue <- updateAction
      if continue then rightUpdate arr ioarr (h,w+1) >> underUpdate arr ioarr (h,w+1)
                  else return ()

leftUpdate arr ioarr (h,w) = do --trace ("left " ++ show (h,w)) $ do
  let ((hmin,wmin),(hmax,wmax)) = bounds arr
  case (hmax == h, wmin == w) of
       (_, True) -> return ()
       (True, False) -> bottomAction
       (False, False) -> normalAction
  where
    updateAction = do
      checked <- readArray ioarr (h,w-1)
      if checked then return False
                 else do
                    let originProp = arr ! (h,w)
                        leftProp = arr ! (h,w-1)
                    if originProp == leftProp
                       then writeArray ioarr (h,w-1) True >> return True
                       else return False
    bottomAction = do
      continue <- updateAction
      if continue then leftUpdate arr ioarr (h,w-1)
                  else return ()
    normalAction = do
      continue <- updateAction
      if continue then leftUpdate arr ioarr (h,w-1) >> underUpdate arr ioarr (h,w-1)
                  else return ()

underUpdate arr ioarr (h,w) = do --trace ("under" ++ show (h,w)) $ do
  let ((hmin,wmin),(hmax,wmax)) = bounds arr
  case (hmax == h, wmax == w, wmin == w) of
       (True, _, _) -> return ()
       (False, True, False) -> rightEdgeAction
       (False, False, True) -> leftEdgeAction
       (False, False, False) -> normalAction
  where
    updateAction = do
      let originProp = arr ! (h,w)
          rightProp = arr ! (h+1,w)
      if originProp == rightProp
         then writeArray ioarr (h+1,w) True >> return True
         else return False
    rightEdgeAction = do
      continue <- updateAction
      if continue then underUpdate arr ioarr (h+1,w) >> leftUpdate arr ioarr (h+1,w)
                  else return ()
    leftEdgeAction = do
      continue <- updateAction
      if continue then underUpdate arr ioarr (h+1,w) >> rightUpdate arr ioarr (h+1,w)
                  else return ()
    normalAction = do
      continue <- updateAction
      if continue then rightUpdate arr ioarr ((h+1,w)) >> leftUpdate arr ioarr (h+1,w) >> underUpdate arr ioarr ((h+1,w))
                  else return ()