Problem:
Score : 400 points

Problem Statement

A maze is composed of a grid of H \times W squares - H vertical, W horizontal.

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

There is a magician in (C_h,C_w). He can do the following two kinds of moves:

Move A: Walk to a road square that is vertically or horizontally adjacent to the square he is currently in.

Move B: Use magic to warp himself to a road square in the 5\times 5 area centered at the square he is currently in.

In either case, he cannot go out of the maze.

At least how many times does he need to use the magic to reach (D_h, D_w)?

Constraints

1 \leq H,W \leq 10^3

1 \leq C_h,D_h \leq H

1 \leq C_w,D_w \leq W

S_{ij} is # or ..

S_{C_h C_w} and S_{D_h D_w} are ..

(C_h,C_w) \neq (D_h,D_w)

Input

Input is given from Standard Input in the following format:

H W
C_h C_w
D_h D_w
S_{11}\ldots S_{1W}
\vdots
S_{H1}\ldots S_{HW}

Output

Print the minimum number of times the magician needs to use the magic. If he cannot reach (D_h,D_w), print -1 instead.

Sample Input 1

4 4
1 1
4 4
..#.
..#.
.#..
.#..

Sample Output 1

1

For example, by walking to (2,2) and then using the magic to travel to (4,4), just one use of magic is enough.

Note that he cannot walk diagonally.

Sample Input 2

4 4
1 4
4 1
.##.
####
####
.##.

Sample Output 2

-1

He cannot move from there.

Sample Input 3

4 4
2 2
3 3
....
....
....
....

Sample Output 3

0

No use of magic is needed.

Sample Input 4

4 5
1 2
2 5
#.###
####.
#..##
#..##

Sample Output 4

2

Solution in Haskell (GHC 8.8.3) (judge verdict: Wrong Answer)

{-# LANGUAGE MultiWayIf #-}

module Main where

import           Control.Monad
import           Control.Monad.Extra
import qualified Data.Array as A
import qualified Data.Array.IO as AIO
import qualified Data.Array.Unboxed as AU
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC8
import           Data.Char
import           Data.Function
import qualified Data.Graph.Inductive.Graph as G
import qualified Data.Graph.Inductive.PatriciaTree as G
import qualified Data.Heap as H
import           Data.Int
import           Data.List
import qualified Data.Map.Strict as M
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import qualified Data.Sequence as SQ
import qualified Data.Set as S
import           Data.Tuple
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

m = 10 ^ 3

main = do
  --aN       <- getI
  --[aA, aB] <- getIL
  --aS       <- getLine
  [aH, aW] <- getIL
  [aCh, aCw] <- getIL
  [aDh, aDw] <- getIL
  aS <- V.replicateM aH $ getVUC
  table <- VM.replicateM aH $ VUM.replicate aW (m)
    :: IO (VM.IOVector (VUM.IOVector Int))
  tableY <- VM.read table (pred aCh)
  VUM.write tableY (pred aCw) 0
  ans
    <- scan table aS aH aW aCh aCw aDh aDw (SQ.singleton (aCh, aCw, 0 :: Int))
  print ans
  mapM_ (\y -> VM.read table y >>= VU.freeze >>= print) [0 .. aH - 1]
  return ()

scan :: VM.IOVector (VUM.IOVector Int)
     -> V.Vector (VU.Vector Char)
     -> Int
     -> Int
     -> Int
     -> Int
     -> Int
     -> Int
     -> SQ.Seq (Int, Int, Int)
     -> IO Int
scan table s h w cH cW dH dW seq = do
  contiS <- bfs table s h w cH cW seq seq
  tableY <- VM.read table $ pred dH
  tableYX <- VUM.read tableY $ pred dW
  if (tableYX /= m)
    then return (tableYX)
    else do
      warpS <- foldM
        (\acc x -> do
           warpS <- warp table s h w cH cW x
           return $ warpS SQ.>< acc)
        SQ.empty
        contiS
      if warpS == SQ.empty
        then return (-1)
        else scan table s h w cH cW dH dW warpS

bfs table s h w cH cW SQ.Empty hist = return hist
bfs table s h w cH cW ((y, x, wc) SQ.:<| aseq) hist = do
  let as = aroundSquareWWC y x h w wc
  let roadAS = road s as
  nextAS <- modi roadAS table
  bfs
    table
    s
    h
    w
    cH
    cW
    ((SQ.fromList nextAS) SQ.>< aseq)
    (SQ.fromList nextAS SQ.>< hist)

warp table s h w cH cW (y, x, wc) = do
  let ws = warpSquareWWC y x h w wc
  let roadWS = road s ws
  nextWS <- modi roadWS table
  return $ SQ.fromList nextWS

road s square =
  filter (\(asY, asX, asWC) -> s V.! (pred asY) VU.! (pred asX) == '.') square

scanHist hist fil = foldl
  (\acc@(accS, accHist) (a, b, wc)
   -> if histMember (a, b, wc) hist
      then acc
      else ((a, b, wc):accS, S.insert (a, b, wc) accHist))
  ([], hist)
  fil

modi fil table = foldM
  (\acc square@(aY, aX, asWC) -> do
     tableY <- VM.read table (pred aY)
     tableYX <- VUM.read tableY (pred aX)
     if (tableYX > asWC)
       then do
         VUM.write tableY (pred aX) asWC
         return (square:acc)
       else return acc)
  []
  fil

histMember (a, b, wc) hist = any (== True)
  $ map (\x -> S.member (a, b, x) hist) [0 .. wc]

aroundSquareWWC y x h w wc =
  [aYX
  | aYX@(aY, aX, aWC) <- [(y + a, x + b, wc)
                         | a <- [-1 .. 1]
                         , b <- [-1 .. 1]
                         , abs a + abs b == 1]
  , aY >= 1
  , aY <= h
  , aX >= 1
  , aX <= w]

warpSquareWWC y x h w wc =
  [aYX
  | aYX@(aY, aX, aWC) <- [(y + a, x + b, wc + 1)
                         | a <- [-2 .. 2]
                         , b <- [-2 .. 2]
                         , abs a + abs b >= 2]
  , aY >= 1
  , aY <= h
  , aX >= 1
  , aX <= w]

--雑多系
t :: Int -> (Int, Int)
t x = (x, 1)

i def f t = bool t def $ f t

--周りのマス
aroundSquare y x h w =
  [aYX
  | aYX@(aY, aX)
      <- [(y + a, x + b) | a <- [-1 .. 1], b <- [-1 .. 1], abs a + abs b == 1]
  , aY >= 1
  , aY <= h
  , aX >= 1
  , aX <= w]

--入力系
splitReadBSC8 :: BSC8.ByteString -> [Int]
splitReadBSC8 bs = let (bs1, newBs) = BSC8.splitAt 1 bs
                   in if newBs == BSC8.empty
                      then [test $ BSC8.readInt bs1]
                      else test (BSC8.readInt bs1):splitReadBSC8 newBs
  where
    test (Just (i, _)) = i

read2DimChar :: VM.IOVector (VUM.IOVector Char) -> Int -> Int -> IO Char
read2DimChar vec y x = do
  vecY <- VM.read vec y
  VUM.read vecY x

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

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

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

getVUC :: IO (VU.Vector Char)
getVUC = 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

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

newtype MInt = M Int

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

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

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

  fromInteger a = M $ mod (fromInteger a) modulus

  abs (M a) = undefined

  signum (M a) = undefined

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 -> MInt -> MInt
powMod n mK@(M k)
  | k == 0 = M 1
  | k == 1 = n
  | mod k 2 == 0 = powMod (n ^ 2) (M (div k 2))
  | otherwise = n * powMod (n ^ 2) (M (div k 2))

invMod :: MInt -> MInt
invMod (M 0) = error "inverse of 0"
invMod x = powMod x (M (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)

{-w
primes :: Integral a => [a]
primes = map fromIntegral $ [2, 3] ++ primes'
 where
  primes' = [5] ++ f 1 7 primes'
  f m s (p : ps) = [ n | n <- ns, gcd m n == 1 ] ++ f (m * p) (p * p) ps
    where ns = [ x + y | x <- [s, s + 6 .. p * p - 2], y <- [0, 4] ]

prime n = primes !! n
primes = sieve [2 ..]
sieve (p : xs) = p : sieve [ x | x <- xs, x `mod` p /= 0 ]
-}
fact :: Int -> Int
fact 0 = 1
fact n
  | n > 0 = n * fact (n - 1)

knappsackWDP :: Int -> [(Int, Int)] -> VU.Vector Int
knappsackWDP maxW [] = VU.replicate (maxW + 1) 0
knappsackWDP maxW ((w, v):xs) =
  let tailDP = knappsackWDP 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

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

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
-}
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_PARENT = VUM.IOVector Int

type UF_RANK = VUM.IOVector Int

type UF = (UF_PARENT, UF_RANK)

ufMakeSet :: Int -> IO UF
ufMakeSet n = do
  parent <- VU.thaw $ VU.generate n id
  rank <- VUM.replicate n 0
  return (parent, rank)

ufUnion :: UF -> Int -> Int -> IO ()
ufUnion unionFind@(parents, ranks) x y = do
  xRoot <- ufFind unionFind x
  yRoot <- ufFind unionFind y
  xRootRank <- VUM.read ranks xRoot
  yRootRank <- VUM.read ranks yRoot
  if
    | xRootRank > yRootRank -> VUM.write parents yRoot xRoot
    | xRootRank < yRootRank -> VUM.write parents xRoot yRoot
    | xRoot /= yRoot -> do
      VUM.write parents yRoot xRoot
      VUM.write ranks xRoot (xRootRank + 1)
    | otherwise -> return ()

ufFind :: UF -> Int -> IO Int
ufFind unionFind@(parents, ranks) x = do
  xParent <- VUM.read parents x
  if xParent == x
    then return x
    else do
      xRootParent <- ufFind 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

--OSA-K法テーブル準備(お酒？)
osaKMethod m = do
  table <- VUM.replicate (m + 1) (0 :: Int) :: IO (VUM.IOVector Int)
  modi table m 1 2
  loopModi table m 3
  VU.freeze table
  where
    loopModi table m x
      | x ^ 2 > m = return ()
      | otherwise = do
        modi table m 1 x
        loopModi table m (x + 1)

    modi table m n x
      | x * n > 1000000 = return ()
      | otherwise = do
        target <- VUM.read table (x * n)
        if target == 0
          then do
            VUM.write table (x * n) x
            modi table m (n + 1) x
          else modi table m (n + 1) x

--BinarySearchっぽいもの 1からmまでのすべての数値をFにいれたとき最初にTrueになる数値を見つける。
binarySearchFirstTrueSerialASC f m =
  binarySearchFirstTrueSerialASCP f 0 (m + 1)

binarySearchFirstTrueSerialASCP f l r =
  let i = l + (div (r - l) 2)
      test = f i
  in if
       | test && i - l == 1 -> i
       | test && i - l /= 1 -> binarySearchFirstTrueSerialASCP f l i
       | not test && r - i == 1 -> r
       | otherwise -> binarySearchFirstTrueSerialASCP f i r

--BinarySearchっぽいもの その２ vuiのすべての数値をFにいれたとき最初にTrueになる数値を見つける。
binarySearchFirstTrueList f vui = let lenl = VU.length vui
                                  in binarySearchFirstTrueListP f vui (-1) lenl

binarySearchFirstTrueListP f vui l r =
  let i = l + (div (r - l) 2)
      test = f (vui VU.! i)
  in if
       | test && i - l == 1 -> i
       | test && i - l /= 1 -> binarySearchFirstTrueListP f vui l i
       | not test && r - i == 1 -> r
       | otherwise -> binarySearchFirstTrueListP f vui i r

--MaxHeap関連
hMaxPoint :: Int
hMaxPoint = 101

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