Submission #420289


Source Code Expand

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExplicitForAll #-}

import Control.Applicative
import Control.Monad
import qualified Control.Monad.Primitive as Primitive
import Control.Monad.ST
import qualified Data.ByteString.Char8 as BS
import Data.Ix (inRange)
import Data.List
import Data.STRef
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed.Mutable as UM
import GHC.Exts (Int(..))

main :: IO ()
main = do
  [h, _w] <- getInts
  cs <- V.replicateM h BS.getLine
  putStrLn $ case solve cs of
    True -> "Yes"
    False -> "No"

solve :: V.Vector BS.ByteString -> Bool
solve cs = runST $ do
  uf <- newUf ((width+2) * (height+2))
  start <- newSTRef undefined
  goal <- newSTRef undefined
  let
    idx (succ -> i) (succ -> j) = i * (width+2) + j
    un i j i' j' = when (inRange ((0,0), (height-1,width-1)) (i', j')) $ do
      let !c' = BS.index (cs V.! i') j'
      when (c' /= '#') $ joinUf uf (idx i j) (idx i' j')
  V.forM_ (V.indexed cs) $ \(i, row) -> forM (zip [0..] $ BS.unpack row) $ \(j, c) -> do
    when (c /= '#') $ do
      un i j (i-1) j
      un i j i (j-1)
      un i j (i+1) j
      un i j i (j+1)
    case c of
      's' -> writeSTRef start (i, j)
      'g' -> writeSTRef goal (i, j)
      _ -> return ()
  (sx, sy) <- readSTRef start
  (gx, gy) <- readSTRef goal
  sameUf uf (idx sx sy) (idx gx gy)
  where
    !width = BS.length $ V.head cs
    !height = V.length cs

----------------------------------------------------------------------------
-- IO

getInts :: IO [Int]
getInts = readInts <$> BS.getLine

readInts :: BS.ByteString -> [Int]
readInts = unfoldr $ \(BS.dropWhile (==' ') -> s) ->
  if s == "" then Nothing else case BS.readInt s of
    Just z -> Just z
    _ -> error $ "not an integer: " ++ show s

----------------------------------------------------------------------------
-- UnionFindST

newtype UnionFind s = UnionFind (UM.MVector s Int)

sameUf
  :: (Primitive.PrimMonad m, Applicative m)
  => UnionFind (Primitive.PrimState m)
  -> Int
  -> Int
  -> m Bool
sameUf uf x y = (==) <$> lookupUf uf x <*> lookupUf uf y
{-# INLINE sameUf #-}

lookupUf
  :: (Primitive.PrimMonad m, Applicative m)
  => UnionFind (Primitive.PrimState m)
  -> Int
  -> m Int
lookupUf !(UnionFind v) idx_
  = checkBoundsUf "lookupUf" v idx_ $
    lookupUf' v idx_
{-# INLINE lookupUf #-}

joinUf
  :: (Primitive.PrimMonad m, Applicative m)
  => UnionFind (Primitive.PrimState m)
  -> Int
  -> Int
  -> m ()
joinUf (UnionFind v) x y =
  checkBoundsUf "joinUf[x]" v x $
  checkBoundsUf "joinUf[y]" v y $ do
  rx <- lookupUf' v x
  ry <- lookupUf' v y
  when (rx /= ry) $ do
    rankx <- UM.unsafeRead v rx
    ranky <- UM.unsafeRead v ry
    case compare rankx ranky of
      GT -> UM.unsafeWrite v rx ry
      LT -> UM.unsafeWrite v ry rx
      EQ -> do
        UM.unsafeWrite v rx ry
        UM.unsafeWrite v ry (rankx - 1)
{-# INLINE joinUf #-}

checkBoundsUf :: String -> UM.STVector s Int -> Int -> a -> a
checkBoundsUf loc vec idx_ body
  | idx_ < 0 || idx_ >= UM.length vec = error $
    loc ++ ": index out of bounds(size=" ++ show (UM.length vec) ++ "): " ++ show idx_
  | otherwise = body
{-# INLINE checkBoundsUf #-}

lookupUf'
  :: forall m
  .  (Primitive.PrimMonad m, Applicative m)
  => UM.STVector (Primitive.PrimState m) Int
  -> Int
  -> m Int
lookupUf' v i0 = loop i0
  where
    loop :: Int -> m Int
    loop !i = Primitive.primitive $ \s -> case loop' i s of
      (# s', r #) -> (# s', I# r #)
    {-# INLINE loop #-}

    loop' !i s = case Primitive.internal (loop'' i) s of
      (# s', I# r #) -> (# s', r #)

    loop'' !i = do
      r <- UM.unsafeRead v i
      if r < 0
        then return i
        else do
          r' <- loop r
          UM.unsafeWrite v i r'
          return r'
    {-# INLINE loop'' #-}
{-# INLINE lookupUf' #-}

newUf
  :: (Primitive.PrimMonad m, Applicative m)
  => Int
  -> m (UnionFind (Primitive.PrimState m))
newUf !size
  | size < 0 = error $ "newUf: negative size: " ++ show size
  | otherwise = UnionFind <$> UM.replicate size (-1)
{-# INLINE newUf #-}

Submission Info

Submission Time
Task A - 深さ優先探索
User mkotha
Language Haskell (Haskell Platform 2014.2.0.0)
Score 100
Code Size 4618 Byte
Status AC
Exec Time 90 ms
Memory 4252 KB

Judge Result

Set Name Sample All
Score / Max Score 0 / 0 100 / 100
Status
AC × 5
AC × 83
Set Name Test Cases
Sample 00_sample_01.txt, 00_sample_02.txt, 00_sample_03.txt, 00_sample_04.txt, 00_sample_05.txt
All 00_min_01.txt, 00_min_02.txt, 00_min_03.txt, 00_min_04.txt, 00_min_05.txt, 00_min_06.txt, 00_min_07.txt, 00_min_08.txt, 00_sample_01.txt, 00_sample_02.txt, 00_sample_03.txt, 00_sample_04.txt, 00_sample_05.txt, 01_rnd_00.txt, 01_rnd_01.txt, 01_rnd_02.txt, 01_rnd_03.txt, 01_rnd_04.txt, 01_rnd_05.txt, 01_rnd_06.txt, 01_rnd_07.txt, 01_rnd_08.txt, 01_rnd_09.txt, 01_rnd_10.txt, 01_rnd_11.txt, 01_rnd_12.txt, 01_rnd_13.txt, 01_rnd_14.txt, 01_rnd_15.txt, 01_rnd_16.txt, 01_rnd_17.txt, 01_rnd_18.txt, 01_rnd_19.txt, 02_rndhard_00.txt, 02_rndhard_01.txt, 02_rndhard_02.txt, 02_rndhard_03.txt, 02_rndhard_04.txt, 02_rndhard_05.txt, 02_rndhard_06.txt, 02_rndhard_07.txt, 02_rndhard_08.txt, 02_rndhard_09.txt, 02_rndhard_10.txt, 02_rndhard_11.txt, 02_rndhard_12.txt, 02_rndhard_13.txt, 02_rndhard_14.txt, 02_rndhard_15.txt, 02_rndhard_16.txt, 02_rndhard_17.txt, 02_rndhard_18.txt, 02_rndhard_19.txt, 02_rndhard_20.txt, 02_rndhard_21.txt, 02_rndhard_22.txt, 02_rndhard_23.txt, 02_rndhard_24.txt, 02_rndhard_25.txt, 02_rndhard_26.txt, 02_rndhard_27.txt, 02_rndhard_28.txt, 02_rndhard_29.txt, 02_rndhard_30.txt, 02_rndhard_31.txt, 02_rndhard_32.txt, 02_rndhard_33.txt, 02_rndhard_34.txt, 02_rndhard_35.txt, 02_rndhard_36.txt, 02_rndhard_37.txt, 02_rndhard_38.txt, 02_rndhard_39.txt, 03_rndhardsmall_00.txt, 03_rndhardsmall_01.txt, 03_rndhardsmall_02.txt, 03_rndhardsmall_03.txt, 03_rndhardsmall_04.txt, 03_rndhardsmall_05.txt, 03_rndhardsmall_06.txt, 03_rndhardsmall_07.txt, 03_rndhardsmall_08.txt, 03_rndhardsmall_09.txt
Case Name Status Exec Time Memory
00_min_01.txt AC 90 ms 1260 KB
00_min_02.txt AC 28 ms 1300 KB
00_min_03.txt AC 28 ms 1368 KB
00_min_04.txt AC 30 ms 1428 KB
00_min_05.txt AC 27 ms 1368 KB
00_min_06.txt AC 28 ms 1368 KB
00_min_07.txt AC 27 ms 1308 KB
00_min_08.txt AC 28 ms 1308 KB
00_sample_01.txt AC 28 ms 1376 KB
00_sample_02.txt AC 27 ms 1380 KB
00_sample_03.txt AC 27 ms 1300 KB
00_sample_04.txt AC 30 ms 1308 KB
00_sample_05.txt AC 29 ms 1304 KB
01_rnd_00.txt AC 41 ms 4248 KB
01_rnd_01.txt AC 84 ms 4252 KB
01_rnd_02.txt AC 74 ms 4244 KB
01_rnd_03.txt AC 85 ms 4248 KB
01_rnd_04.txt AC 81 ms 4252 KB
01_rnd_05.txt AC 61 ms 4248 KB
01_rnd_06.txt AC 72 ms 4240 KB
01_rnd_07.txt AC 73 ms 4252 KB
01_rnd_08.txt AC 42 ms 4248 KB
01_rnd_09.txt AC 51 ms 4252 KB
01_rnd_10.txt AC 66 ms 4248 KB
01_rnd_11.txt AC 39 ms 4248 KB
01_rnd_12.txt AC 76 ms 4252 KB
01_rnd_13.txt AC 75 ms 4252 KB
01_rnd_14.txt AC 67 ms 4248 KB
01_rnd_15.txt AC 71 ms 4248 KB
01_rnd_16.txt AC 39 ms 4252 KB
01_rnd_17.txt AC 68 ms 4248 KB
01_rnd_18.txt AC 42 ms 4244 KB
01_rnd_19.txt AC 87 ms 4248 KB
02_rndhard_00.txt AC 69 ms 4244 KB
02_rndhard_01.txt AC 68 ms 4244 KB
02_rndhard_02.txt AC 69 ms 4244 KB
02_rndhard_03.txt AC 68 ms 4244 KB
02_rndhard_04.txt AC 70 ms 4248 KB
02_rndhard_05.txt AC 70 ms 4180 KB
02_rndhard_06.txt AC 69 ms 4244 KB
02_rndhard_07.txt AC 69 ms 4244 KB
02_rndhard_08.txt AC 69 ms 4248 KB
02_rndhard_09.txt AC 69 ms 4252 KB
02_rndhard_10.txt AC 68 ms 4248 KB
02_rndhard_11.txt AC 69 ms 4244 KB
02_rndhard_12.txt AC 68 ms 4244 KB
02_rndhard_13.txt AC 68 ms 4244 KB
02_rndhard_14.txt AC 69 ms 4244 KB
02_rndhard_15.txt AC 67 ms 4248 KB
02_rndhard_16.txt AC 67 ms 4248 KB
02_rndhard_17.txt AC 67 ms 4252 KB
02_rndhard_18.txt AC 68 ms 4248 KB
02_rndhard_19.txt AC 69 ms 4244 KB
02_rndhard_20.txt AC 69 ms 4244 KB
02_rndhard_21.txt AC 69 ms 4244 KB
02_rndhard_22.txt AC 68 ms 4248 KB
02_rndhard_23.txt AC 69 ms 4240 KB
02_rndhard_24.txt AC 69 ms 4244 KB
02_rndhard_25.txt AC 69 ms 4244 KB
02_rndhard_26.txt AC 69 ms 4244 KB
02_rndhard_27.txt AC 69 ms 4244 KB
02_rndhard_28.txt AC 67 ms 4240 KB
02_rndhard_29.txt AC 68 ms 4248 KB
02_rndhard_30.txt AC 66 ms 4248 KB
02_rndhard_31.txt AC 64 ms 4252 KB
02_rndhard_32.txt AC 68 ms 4252 KB
02_rndhard_33.txt AC 67 ms 4248 KB
02_rndhard_34.txt AC 68 ms 4248 KB
02_rndhard_35.txt AC 68 ms 4252 KB
02_rndhard_36.txt AC 67 ms 4252 KB
02_rndhard_37.txt AC 69 ms 4240 KB
02_rndhard_38.txt AC 67 ms 4248 KB
02_rndhard_39.txt AC 69 ms 4248 KB
03_rndhardsmall_00.txt AC 29 ms 1304 KB
03_rndhardsmall_01.txt AC 28 ms 1364 KB
03_rndhardsmall_02.txt AC 27 ms 1376 KB
03_rndhardsmall_03.txt AC 29 ms 1300 KB
03_rndhardsmall_04.txt AC 28 ms 1424 KB
03_rndhardsmall_05.txt AC 27 ms 1312 KB
03_rndhardsmall_06.txt AC 29 ms 1300 KB
03_rndhardsmall_07.txt AC 29 ms 1296 KB
03_rndhardsmall_08.txt AC 30 ms 1300 KB
03_rndhardsmall_09.txt AC 29 ms 1424 KB