Problem:
Score : 400 points

Problem Statement

Takahashi has a maze, which is a grid of H \times W squares with H horizontal rows and W vertical columns.

The square at the i-th row from the top and the j-th column is a "wall" square if S_{ij} is #, and a "road" square if S_{ij} is ..

From a road square, you can move to a horizontally or vertically adjacent road square.

You cannot move out of the maze, move to a wall square, or move diagonally.

Takahashi will choose a starting square and a goal square, which can be any road squares, and give the maze to Aoki.

Aoki will then travel from the starting square to the goal square, in the minimum number of moves required.

In this situation, find the maximum possible number of moves Aoki has to make.

Constraints

1 \leq H,W \leq 20

S_{ij} is . or #.

S contains at least two occurrences of ..

Any road square can be reached from any road square in zero or more moves.

Input

Input is given from Standard Input in the following format:

H W
S_{11}...S_{1W}
:
S_{H1}...S_{HW}

Output

Print the maximum possible number of moves Aoki has to make.

Sample Input 1

3 3
...
...
...

Sample Output 1

4

If Takahashi chooses the top-left square as the starting square and the bottom-right square as the goal square, Aoki has to make four moves.

Sample Input 2

3 5
...#.
.#.#.
.#...

Sample Output 2

10

If Takahashi chooses the bottom-left square as the starting square and the top-right square as the goal square, Aoki has to make ten moves.

Solution in Haskell (GHC 7.10.3) (judge verdict: Accepted)

{-# LANGUAGE MultiWayIf #-}

module Main where
import           Prelude
import           Control.Monad
import           Data.Monoid
import qualified Data.Array                    as A
import qualified Data.Array.IO                 as AIO
import qualified Data.Array.Unboxed            as AU
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Char8         as BSC8
import           Data.Char
import           Data.List
import qualified Data.Map.Strict               as M
import           Data.Maybe
import           Data.Ord
import qualified Data.Set                      as S
import qualified Data.Vector                   as V
--import           Data.Vector.Algorithms.Search
import qualified Data.Vector.Mutable           as VM
import qualified Data.Vector.Unboxed           as VU
import qualified Data.Vector.Unboxed.Mutable   as VUM
import           Debug.Trace
--import qualified Data.Heap                     as H
main = do
  [iH, iW]   <- getIL
  vecS       <- V.fromList <$> replicateM iH getVUS
  maxMoveCnt <- mapM
    (\x@(sY, sX) -> scanMaze vecS sY sX iH iW)
    [ (sY, sX)
    | sY <- [0 .. iH - 1]
    , sX <- [0 .. iW - 1]
    , (vecS V.! sY VU.! sX == '.')
    ]

  print $maximum maxMoveCnt

scanMaze :: V.Vector (VU.Vector Char) -> Int -> Int -> Int -> Int -> IO Int
scanMaze vecS sY sX h w = do
  bfst <- VM.replicateM h (VUM.replicate w (h * w))
  bfs bfst vecS [(sY, sX)] h w 0


bfs
  :: VM.IOVector (VUM.IOVector Int)
  -> V.Vector (VU.Vector Char)
  -> [(Int, Int)]
  -> Int
  -> Int
  -> Int
  -> IO Int
bfs bfst vecS sYX h w cnt = do
  nextSYX <-
    concat
      <$> mapM
            (\(sY, sX) -> do
              bfsYX <- readTwoDimVec bfst sY sX
              if (bfsYX == (h * w))
                then do
                  writeTwoDimVec bfst sY sX cnt
                  foldM
                    (\acc (nY, nX) -> if vecS V.! nY VU.! nX == '.'
                      then return ((nY, nX) : acc)
                      else return acc
                    )
                    []
                    (aroundSquare sY sX h w)
                else return []
            )
            sYX
  if nextSYX == []
    then return (cnt - 1)
    else bfs bfst vecS nextSYX h w (cnt + 1)

readTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> IO Int
readTwoDimVec vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x
writeTwoDimVec :: VM.IOVector (VUM.IOVector Int) -> Int -> Int -> Int -> IO ()
writeTwoDimVec vec y x t = do
  vecY <- VM.read vec y
  VUM.write vecY x t

aroundSquare y x h w =
  [ aYX
  | aYX@(aY, aX) <- [(y - 1, x), (y, x - 1), (y + 1, x), (y, x + 1), (y, x)]
  , aY >= 0
  , aY <= (h - 1)
  , aX >= 0
  , aX <= (w - 1)
  ]

getVUI :: IO (VU.Vector Int)
getVUI = VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine

getRepVUI :: Int -> IO (VU.Vector Int)
getRepVUI n =
  VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace)
    .   BSC8.unlines
    <$> replicateM n BSC8.getLine

getVS :: IO (V.Vector Char)
getVS = V.fromList <$> getLine

getVUS :: IO (VU.Vector Char)
getVUS = VU.fromList <$> getLine

readI :: BSC8.ByteString -> Int
readI = fst . fromJust . BSC8.readInt

readIL :: BSC8.ByteString -> [Int]
readIL = map readI . BSC8.words

readIT2 :: BSC8.ByteString -> (Int, Int)
readIT2 bs =
  let words = BSC8.words bs in (readI $ head words, readI $ last words)

getI :: IO Int
getI = readI <$> BSC8.getLine

getIL :: IO [Int]
getIL = readIL <$> BSC8.getLine

getIT2 :: IO (Int, Int)
getIT2 = readIT2 <$> BSC8.getLine

getIT2Order :: IO (Int, Int)
getIT2Order =
  getIL >>= \x@[xz, xo] -> if xz > xo then return (xo, xz) else return (xz, xo)

getNIS :: Int -> IO [(Int, BSC8.ByteString)]
getNIS 0 = return []
getNIS n = do
  [aFst, aSnd] <- BSC8.words <$> BSC8.getLine
  next         <- getNIS (n - 1)
  return ((readI aFst, aSnd) : next)

il2Words :: [Int] -> String
il2Words = unwords . map show

il2Lines :: [Int] -> String
il2Lines = unlines . map show

p :: Int -> Int
p x = x - 1

--modNum = 10 ^ 9 + 7
modulus = 1000000007

newtype MInt = M Int

instance Num MInt where
  (M a) + (M b) = M $ mod (a + b) modulus

  (M a) - (M b) = M (a - b)

  (M a) * (M b) = M $ mod (a * b) modulus

  fromInteger a = M $ mod (fromInteger a) modulus

  abs (M a) = M $ abs a

  signum (M a) = M $ signum a

instance Show MInt where
  show (M a) = show (mod a modulus)

int2MInt :: Int -> MInt
int2MInt a = M (mod a modulus)

mInt2Int :: MInt -> Int
mInt2Int (M a) = a

{-
factsMod :: V.Vector MInt
factsMod = V.scanl (\acc x -> M x * acc) 1 $ V.generate 2000000 (+ 1)

factMod :: Int -> MInt
factMod = (factsMod V.!)
-}

factMod :: Int -> MInt
factMod n | n == 0    = 1
          | n == 1    = 1
          | otherwise = M n * (factMod (n - 1))


factDivMod :: Int -> Int -> MInt
factDivMod n k | n == k    = M 1
               | otherwise = M n * (factDivMod (n - 1) k)

powMod :: MInt -> Int -> MInt
powMod n k | k == 0       = M 1
           | k == 1       = n
           | mod k 2 == 0 = powMod (n ^ 2) (div k 2)
           | otherwise    = n * powMod (n ^ 2) (div k 2)

invMod :: MInt -> MInt
invMod (M 0) = error "inverse of 0"
invMod x     = powMod x (modulus - 2)

{-
combiMod :: Int -> Int -> MInt
combiMod n k
  | n < 0 || k < 0 || k > n = 0
  | otherwise = factMod n * invMod (factMod (n - k)) * invMod (factMod k)
-}
combiMod :: Int -> Int -> MInt
combiMod n k | n < 0 || k < 0 || k > n = 0
             | k > n - k = factDivMod n k * invMod (factMod (n - k))
             | otherwise = factDivMod n (n - k) * invMod (factMod k)



combi :: Int -> Int -> Int
combi n k | n < 0 || k < 0 || k > n = 0
          | k == n                  = 1
          | otherwise               = div (div (fact n) (fact (n - k))) (fact k)

primes :: V.Vector MInt
primes = V.scanl (\acc x -> M x * acc) 1 $ V.generate 200000 (+ 1)

fact :: Int -> Int
fact 0         = 1
fact n | n > 0 = n * fact (n - 1)

knappsack :: Int -> [(Int, Int)] -> VU.Vector Int
knappsack maxW [] = VU.replicate (maxW + 1) 0
knappsack maxW ((w, v) : xs) =
  let tailDP = knappsack maxW xs
  in  VU.generate (maxW + 1) $ \i -> if w <= i
        then max (tailDP VU.! i) (tailDP VU.! (i - w) + v)
        else tailDP VU.! i

knappsackMaxVal
  :: AIO.IOArray (Int, Int) Int
  -> VU.Vector Int
  -> VU.Vector Int
  -> Int
  -> IO Int
knappsackMaxVal dp volumeVec valueVec dpSize = do
  mapM_
    (\i -> mapM_
      (\v -> do
        let volume = volumeVec VU.! i
            value  = valueVec VU.! i
        newdp <- if v < volume
          then AIO.readArray dp (i, v)
          else do
            dpIVm <- AIO.readArray dp (i, v - volume)
            dpIV  <- AIO.readArray dp (i, v)
            return (max (dpIVm + value) dpIV)
        AIO.writeArray dp (i + 1, v) newdp
      )
      [0 .. dpSize]
    )
    [0 .. VU.length volumeVec - 1]
  AIO.readArray dp (VU.length volumeVec, dpSize)

knappsackMinVol
  :: AIO.IOArray (Int, Int) Int
  -> VU.Vector Int
  -> VU.Vector Int
  -> Int
  -> Int
  -> IO Int
knappsackMinVol dp volumeVec valueVec dpSize maxVolume = do
  mapM_
    (\i -> mapM_
      (\v -> do
        let volume = volumeVec VU.! i
            value  = valueVec VU.! i
        newdp <- if (v + value) > dpSize
          then AIO.readArray dp (i, v)
          else do
            dpIVm <- AIO.readArray dp (i, v + value)
            dpIV  <- AIO.readArray dp (i, v)
            return (min (dpIVm - volume) dpIV)
        AIO.writeArray dp (i + 1, v) newdp
      )
      (reverse [0 .. dpSize])
    )
    [0 .. VU.length valueVec - 1]
  foldM
    (\acc x -> do
      num <- AIO.readArray dp (VU.length volumeVec, x)
      return $ if num <= maxVolume then x else acc
    )
    0
    [0 .. dpSize]


lcsTable :: BS.ByteString -> BS.ByteString -> V.Vector (VU.Vector Int)
lcsTable xs ys = V.scanl step (VU.replicate (m + 1) 0) xs'
 where
  n   = BS.length xs
  m   = BS.length ys
  xs' = V.generate n $ BSC8.index xs :: V.Vector Char
  ys' = VU.generate m $ BSC8.index ys :: VU.Vector Char
  step :: VU.Vector Int -> Char -> VU.Vector Int
  step v x = VU.scanl innerStep 0 (VU.zip3 v (VU.tail v) ys')
   where
    innerStep :: Int -> (Int, Int, Char) -> Int
    innerStep a (b, c, y) | x == y    = 1 + b
                          | otherwise = max a c
{-
main = do
xs <- BS.getLine
ys <- BS.getLine
print $ VU.last $ V.last $ lcsTable xs ys
-}
{-
hMaxPoint :: Int
hMaxPoint = 100
hMaximum :: H.Heap Int -> Int
hMaximum h = hMaxPoint - (H.minimum h)
hInsertMax :: Int -> H.Heap Int -> H.Heap Int
hInsertMax x = H.insert (hMaxPoint - x)
hDeleteMax :: H.Heap Int -> H.Heap Int
hDeleteMax = H.deleteMin
-}

myFilter :: (a -> Bool) -> [a] -> ([a], [a])
myFilter _pred [] = ([], [])
myFilter pred (x : xs)
  | pred x    = let (l, r) = myFilter pred xs in (x : l, r)
  | otherwise = let (l, r) = myFilter pred xs in (l, x : r)

--UnionFindデータ構造
type UF = (VUM.IOVector Int, VUM.IOVector Int)
uf_makeSet :: Int -> IO UF
uf_makeSet n = do
  parent <- VU.thaw $ VU.generate n id
  rank   <- VUM.replicate n 0
  return (parent, rank)
uf_union :: UF -> Int -> Int -> IO ()
uf_union unionFind@(parents, ranks) x y = do
  xRoot     <- uf_find unionFind x
  yRoot     <- uf_find unionFind y
  xRootRank <- VUM.read ranks x
  yRootRank <- VUM.read ranks y
  if
    | xRootRank > yRootRank -> VUM.write parents yRoot xRoot
    | xRootRank < yRootRank -> VUM.write parents yRoot xRoot
    | xRoot /= yRoot -> do
      VUM.write parents yRoot xRoot
      VUM.write ranks xRoot (xRootRank + 1)
    | otherwise -> return ()
uf_find :: UF -> Int -> IO Int
uf_find unionFind@(parents, ranks) x = do
  xParent <- VUM.read parents x
  if xParent == x
    then return x
    else do
      xRootParent <- uf_find unionFind xParent
      VUM.write parents x xRootParent
      return xRootParent

--UnDirectedGraph(無向グラフ)データ構造
type UDG = M.Map Int [Int]
list2UDG :: [(Int, Int)] -> M.Map Int [Int]
list2UDG = foldl
  (\acc x ->
    let lr = M.insertWith (++) (fst x) [snd x] acc
    in  M.insertWith (++) (snd x) [fst x] lr
  )
  M.empty