Submission #422459
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 qualified Data.Foldable as Fold import Data.List import Data.Monoid import qualified Data.Vector as V import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as GM import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as UM import GHC.Exts (MutableByteArray#, newByteArray#, readIntArray#, writeIntArray#, Int(..)) import GHC.ST (ST(..)) 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' grid = distanceBetween1 graph start goal < 1000 where graph = gridGraph grid (/='#') Just start = toI <$> gridLocate grid 's' Just goal = toI <$> gridLocate grid 'g' toI (x, y) = x * w + y w = BS.length $ V.head grid ---------------------------------------------------------------------------- -- Grid type Grid = V.Vector BS.ByteString gridLocate :: Grid -> Char -> Maybe (Int, Int) gridLocate grid ch = getFirst $ Fold.foldMap f $ V.indexed grid where f (i, row) = First $ (i,) <$> BS.findIndex (==ch) row gridGraph :: Grid -> (Char -> Bool) -> Graph gridGraph grid good = mkGraph (h * w) $ U.filter ok $ vert U.++ horiz where !h = V.length grid !w = BS.length $ V.head grid ok (p0, p1) = ok' p0 && ok' p1 ok' (flip quotRem w -> (r, c)) = good $ grid V.! r `BS.index` c vert = U.generate ((h - 1) * w) $ \i -> let !i' = i + w in (i, i') horiz = U.generate (h * (w - 1)) $ \i -> let !(r, c) = quotRem i (w - 1) !p = r * w + c !p' = p + 1 in (p, p') ---------------------------------------------------------------------------- -- Graph type Graph = V.Vector (U.Vector Int) mkGraph :: Int -> U.Vector (Int, Int) -> Graph mkGraph !nv !edges = buildGraphlike nv (2 * U.length edges) trav where trav f = U.forM_ edges $ \(a, b) -> f a b >> f b a {-# INLINE trav #-} distanceBetween1 :: Graph -> Int -> Int -> Int distanceBetween1 graph start goal = distancesFrom1 graph start U.! goal distancesFrom1 :: Graph -> Int -> U.Vector Int distancesFrom1 !graph !start = U.create $ do let !nv = V.length graph level <- UM.replicate nv maxBound q <- newMQ nv let go = (popMQ q >>=) $ Fold.mapM_ $ \v -> do lev <- UM.unsafeRead level v U.forM_ (graph `G.unsafeIndex` v) $ \next -> do nextLev <- UM.unsafeRead level next when (nextLev == maxBound) $ do UM.unsafeWrite level next (lev + 1) pushMQ q next go pushMQ q start UM.unsafeWrite level start 0 go return level ---------------------------------------------------------------------------- -- 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 ---------------------------------------------------------------------------- -- MQueue data MQueue s a = MQueue { mqSzV :: !(MBA s) -- raedp, writep , mqVals :: !(UM.MVector s a) } popMQ :: (UM.Unbox a) => MQueue s a -> ST s (Maybe a) popMQ MQueue{..} = do readp <- readIntMBA mqSzV 0 writep <- readIntMBA mqSzV 1 if readp == writep then return Nothing else do writeIntMBA mqSzV 0 $ (readp + 1) `rem` UM.length mqVals Just <$> UM.unsafeRead mqVals readp {-# INLINE popMQ #-} pushMQ :: (UM.Unbox a) => MQueue s a -> a -> ST s () pushMQ MQueue{..} (forceU -> !val) = do readp <- readIntMBA mqSzV 0 writep <- readIntMBA mqSzV 1 let !writep' = rem (writep + 1) $ UM.length mqVals when (writep' == readp) $ fail $ "pushMQ: overflow (cap=" ++ show (UM.length mqVals) ++ ")" UM.unsafeWrite mqVals writep val writeIntMBA mqSzV 1 writep' {-# INLINE pushMQ #-} newMQ :: (UM.Unbox a) => Int -> ST s (MQueue s a) newMQ cap = MQueue <$> do r <- newMBA 16 writeIntMBA r 0 0 writeIntMBA r 1 0 return r <*> UM.new (max 1 cap) ---------------------------------------------------------------------------- -- Util buildGraphlike :: (G.Vector outv outedge) => Int -> Int -> (forall m. (Monad m) => (Int -> outedge -> m ()) -> m ()) -> V.Vector (outv outedge) buildGraphlike !nv !nEdges traverseEdges_ = runST $ do !counter <- UM.replicate nv 0 let incr v _ = UM.unsafeWrite counter v . (+1) =<< UM.read counter v traverseEdges_ incr inplacePrescanl (+) 0 counter !mpool <- GM.new nEdges let add a oe = do i <- UM.unsafeRead counter a GM.unsafeWrite mpool i oe UM.unsafeWrite counter a $ i + 1 traverseEdges_ add pool <- G.unsafeFreeze mpool V.generateM nv $ \i -> do begin <- if i == 0 then return 0 else UM.unsafeRead counter (i - 1) end <- UM.unsafeRead counter i return $! G.unsafeSlice begin (end - begin) pool {-# INLINE buildGraphlike #-} inplacePrescanl :: (Primitive.PrimMonad m, GM.MVector v a) => (a -> a -> a) -> a -> v (Primitive.PrimState m) a -> m () inplacePrescanl f x0 !mv = go 0 x0 where go !i !_ | i >= GM.length mv = return () go !i !x = do old <- GM.unsafeRead mv i GM.unsafeWrite mv i x go (i+1) $ f x old {-# INLINE inplacePrescanl #-} forceU :: (U.Unbox a) => a -> a forceU x = G.elemseq (vec x) x x where vec :: a -> U.Vector a vec = undefined {-# INLINE forceU #-} ---------------------------------------------------------------------------- -- MBA -- | Untyped byte array. data MBA s = MBA (MutableByteArray# s) readIntMBA :: MBA s -> Int -> ST s Int readIntMBA (MBA mba) (I# ofs) = ST $ \s -> let !(# s1, val #) = readIntArray# mba ofs s in (# s1, I# val #) {-# INLINE readIntMBA #-} writeIntMBA :: MBA s -> Int -> Int -> ST s () writeIntMBA (MBA mba) (I# ofs) (I# val) = ST $ \s -> let !s1 = writeIntArray# mba ofs val s in (# s1, () #) {-# INLINE writeIntMBA #-} newMBA :: Int -> ST s (MBA s) newMBA (I# bytes) = ST $ \s -> let !(# s1, mba #) = newByteArray# bytes s in (# s1, MBA mba #)
Submission Info
Submission Time | |
---|---|
Task | A - 深さ優先探索 |
User | mkotha |
Language | Haskell (Haskell Platform 2014.2.0.0) |
Score | 100 |
Code Size | 6904 Byte |
Status | AC |
Exec Time | 231 ms |
Memory | 35352 KB |
Judge Result
Set Name | Sample | All | ||||
---|---|---|---|---|---|---|
Score / Max Score | 0 / 0 | 100 / 100 | ||||
Status |
|
|
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 | 57 ms | 1256 KB |
00_min_02.txt | AC | 27 ms | 1180 KB |
00_min_03.txt | AC | 28 ms | 1272 KB |
00_min_04.txt | AC | 28 ms | 1180 KB |
00_min_05.txt | AC | 28 ms | 1304 KB |
00_min_06.txt | AC | 29 ms | 1300 KB |
00_min_07.txt | AC | 28 ms | 1272 KB |
00_min_08.txt | AC | 28 ms | 1180 KB |
00_sample_01.txt | AC | 28 ms | 1300 KB |
00_sample_02.txt | AC | 28 ms | 1288 KB |
00_sample_03.txt | AC | 28 ms | 1308 KB |
00_sample_04.txt | AC | 28 ms | 1300 KB |
00_sample_05.txt | AC | 30 ms | 1300 KB |
01_rnd_00.txt | AC | 117 ms | 17424 KB |
01_rnd_01.txt | AC | 231 ms | 33176 KB |
01_rnd_02.txt | AC | 203 ms | 29592 KB |
01_rnd_03.txt | AC | 231 ms | 35352 KB |
01_rnd_04.txt | AC | 223 ms | 32796 KB |
01_rnd_05.txt | AC | 133 ms | 18968 KB |
01_rnd_06.txt | AC | 202 ms | 29212 KB |
01_rnd_07.txt | AC | 213 ms | 29852 KB |
01_rnd_08.txt | AC | 118 ms | 17436 KB |
01_rnd_09.txt | AC | 131 ms | 18328 KB |
01_rnd_10.txt | AC | 188 ms | 28240 KB |
01_rnd_11.txt | AC | 118 ms | 17432 KB |
01_rnd_12.txt | AC | 219 ms | 31760 KB |
01_rnd_13.txt | AC | 220 ms | 31256 KB |
01_rnd_14.txt | AC | 141 ms | 21404 KB |
01_rnd_15.txt | AC | 199 ms | 28696 KB |
01_rnd_16.txt | AC | 129 ms | 17436 KB |
01_rnd_17.txt | AC | 194 ms | 28752 KB |
01_rnd_18.txt | AC | 121 ms | 17560 KB |
01_rnd_19.txt | AC | 230 ms | 35224 KB |
02_rndhard_00.txt | AC | 146 ms | 21272 KB |
02_rndhard_01.txt | AC | 144 ms | 21220 KB |
02_rndhard_02.txt | AC | 171 ms | 27928 KB |
02_rndhard_03.txt | AC | 170 ms | 27984 KB |
02_rndhard_04.txt | AC | 140 ms | 21532 KB |
02_rndhard_05.txt | AC | 141 ms | 21464 KB |
02_rndhard_06.txt | AC | 140 ms | 21268 KB |
02_rndhard_07.txt | AC | 140 ms | 21276 KB |
02_rndhard_08.txt | AC | 139 ms | 21144 KB |
02_rndhard_09.txt | AC | 140 ms | 21144 KB |
02_rndhard_10.txt | AC | 141 ms | 21272 KB |
02_rndhard_11.txt | AC | 141 ms | 21268 KB |
02_rndhard_12.txt | AC | 139 ms | 21144 KB |
02_rndhard_13.txt | AC | 140 ms | 21144 KB |
02_rndhard_14.txt | AC | 142 ms | 21204 KB |
02_rndhard_15.txt | AC | 143 ms | 21148 KB |
02_rndhard_16.txt | AC | 141 ms | 21272 KB |
02_rndhard_17.txt | AC | 138 ms | 21272 KB |
02_rndhard_18.txt | AC | 140 ms | 21148 KB |
02_rndhard_19.txt | AC | 139 ms | 21144 KB |
02_rndhard_20.txt | AC | 141 ms | 21272 KB |
02_rndhard_21.txt | AC | 140 ms | 21276 KB |
02_rndhard_22.txt | AC | 142 ms | 21148 KB |
02_rndhard_23.txt | AC | 140 ms | 21148 KB |
02_rndhard_24.txt | AC | 141 ms | 21272 KB |
02_rndhard_25.txt | AC | 143 ms | 21328 KB |
02_rndhard_26.txt | AC | 140 ms | 21148 KB |
02_rndhard_27.txt | AC | 140 ms | 21144 KB |
02_rndhard_28.txt | AC | 140 ms | 21016 KB |
02_rndhard_29.txt | AC | 140 ms | 20888 KB |
02_rndhard_30.txt | AC | 139 ms | 20504 KB |
02_rndhard_31.txt | AC | 139 ms | 20508 KB |
02_rndhard_32.txt | AC | 141 ms | 21272 KB |
02_rndhard_33.txt | AC | 142 ms | 21268 KB |
02_rndhard_34.txt | AC | 142 ms | 21272 KB |
02_rndhard_35.txt | AC | 139 ms | 21276 KB |
02_rndhard_36.txt | AC | 139 ms | 21140 KB |
02_rndhard_37.txt | AC | 140 ms | 21148 KB |
02_rndhard_38.txt | AC | 142 ms | 21148 KB |
02_rndhard_39.txt | AC | 142 ms | 21144 KB |
03_rndhardsmall_00.txt | AC | 28 ms | 1176 KB |
03_rndhardsmall_01.txt | AC | 28 ms | 1308 KB |
03_rndhardsmall_02.txt | AC | 28 ms | 1300 KB |
03_rndhardsmall_03.txt | AC | 28 ms | 1308 KB |
03_rndhardsmall_04.txt | AC | 26 ms | 1304 KB |
03_rndhardsmall_05.txt | AC | 28 ms | 1304 KB |
03_rndhardsmall_06.txt | AC | 28 ms | 1300 KB |
03_rndhardsmall_07.txt | AC | 27 ms | 1176 KB |
03_rndhardsmall_08.txt | AC | 29 ms | 1244 KB |
03_rndhardsmall_09.txt | AC | 26 ms | 1288 KB |