Submission #19449574


Source Code Expand

{-# LANGUAGE BangPatterns #-}
import           Control.Exception           (assert)
import           Control.Monad
import           Control.Monad.Primitive
import qualified Control.Monad.ST            as ST
import qualified Data.Array.IO               as IO
import qualified Data.Array.ST               as ST
import qualified Data.Array.Unboxed          as A
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Foldable
import           Data.List
import qualified Data.Map.Strict             as Map
import           Data.Maybe
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as Set
import qualified Data.Vector                 as VB
import qualified Data.Vector.Mutable         as VBM
import qualified Data.Vector.Unboxed         as V
import           Data.Vector.Unboxed.Base
import qualified Data.Vector.Unboxed.Mutable as VM
import           Debug.Trace

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntVec n = V.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

readInteger = fst . fromJust . BS.readInteger
readIntegerList = map readInteger . BS.words
getInteger = readInteger <$> BS.getLine
getIntegerList = readIntegerList <$> BS.getLine

inf :: Int
inf = 10^18

data IOUQueue a = IOUQueue { uq_size :: !Int
                           , uq_orig :: !Int
                           , uq_i    :: !Int
                           , uq_j    :: !Int
                           , uq_v    :: VM.MVector (PrimState IO) a
                           }

newUDequeue :: (Unbox a) => Int -> Int -> IO (IOUQueue a)
newUDequeue sizel sizer = do let sz = sizel + sizer
                             v <- VM.new sz
                             return $ IOUQueue sz sizel sizel sizel v

newUQueue :: (Unbox a) => Int -> IO (IOUQueue a)
newUQueue sz = newUDequeue 0 sz

nullUQ :: (Unbox a) => IOUQueue a -> Bool
nullUQ uq@(IOUQueue _ _ i j _) = (i == j)

poplUQ :: (Unbox a) => IOUQueue a -> IO (IOUQueue a, a)
poplUQ uq@(IOUQueue sz o i j v) | i < j = do r <- VM.unsafeRead v i
                                             return (uq{uq_i=i+1}, r)
                                | otherwise = error "poplUQ: empty queue"

popRUQ :: (Unbox a) => IOUQueue a -> IO (IOUQueue a, a)
popRUQ uq@(IOUQueue sz o i j v) | i < j = do r <- VM.unsafeRead v (j-1)
                                             return (uq{uq_j=j-1}, r)
                                | otherwise = error "poprUQ: empty queue"

recenterUQ :: (Unbox a) => IOUQueue a -> IO (IOUQueue a)
recenterUQ uq@(IOUQueue sz o i j v)
  | i == o = return uq
  | i > o = do let dist = i - o
               forM_ [i..(j-1)] $ \k -> do
                 t <- VM.unsafeRead v k
                 VM.unsafeWrite v (k-dist) t
               return $ uq{uq_i=i-dist, uq_j=j-dist}
  | otherwise = do let dist = o - j
                   forM_ [j-1,(j-2)..i] $ \k -> do
                     t <- VM.unsafeRead v k
                     VM.unsafeWrite v (k+dist) t
                   return $ uq{uq_i=i+dist, uq_j=j+dist}

pushListUQ :: (Unbox a) => IOUQueue a -> [a] -> IO (IOUQueue a)
pushListUQ uq [] = return uq
pushListUQ uq@(IOUQueue sz o i j v) (x:xs)
  | j < sz = do VM.unsafeWrite v j x
                pushListUQ uq{uq_j=j+1} xs
  | i > o  = do uq' <- recenterUQ uq
                pushListUQ uq' (x:xs)
  | otherwise = error "pushListUQ: overflow"

pushListWithDUQ :: (Unbox a, Unbox b) => IOUQueue (a, b) -> [a] -> b -> IO (IOUQueue (a, b))
pushListWithDUQ uq [] _ = return uq
pushListWithDUQ uq@(IOUQueue sz o i j v) (x:xs) d
  | j < sz = do VM.unsafeWrite v j (x, d)
                pushListWithDUQ uq{uq_j=j+1} xs d
  | i > o  = do uq' <- recenterUQ uq
                pushListWithDUQ uq' (x:xs) d
  | otherwise = error "pushListWithDUQ: overflow"

pushUQ :: (Unbox a) => IOUQueue a -> a -> IO (IOUQueue a)
pushUQ uq@(IOUQueue sz o i j v) x
  | j < sz = do VM.unsafeWrite v j x
                return $ uq{uq_j=j+1}
  | i > o = do uq' <- recenterUQ uq
               pushUQ uq' x
  | otherwise = error "pushUQ: overflow"

pushLListUQ :: (Unbox a) => IOUQueue a -> [a] -> IO (IOUQueue a)
pushLListUQ uq [] = return uq
pushLListUQ uq@(IOUQueue sz o i j v) (x:xs)
  | i > 0 = do VM.unsafeWrite v (i-1) x
               pushLListUQ uq{uq_i=i-1} xs
  | j < o = do uq' <- recenterUQ uq
               pushLListUQ uq' (x:xs)
  | otherwise = error "pushLListUQ: overflow"

pushLListWithDUQ :: (Unbox a, Unbox b) => IOUQueue (a, b) -> [a] -> b -> IO (IOUQueue (a, b))
pushLListWithDUQ uq [] _ = return uq
pushLListWithDUQ uq@(IOUQueue sz o i j v) (x:xs) d
  | i > 0 = do VM.unsafeWrite v (i-1) (x, d)
               pushLListWithDUQ uq{uq_i=i-1} xs d
  | j < o = do uq' <- recenterUQ uq
               pushLListWithDUQ uq' (x:xs) d
  | otherwise = error "pushLListWithDUQ: overflow"

pushLUQ :: (Unbox a) => IOUQueue a -> a -> IO (IOUQueue a)
pushLUQ uq@(IOUQueue sz o i j v) x
  | i > 0 = do VM.unsafeWrite v (i-1) x
               return $ uq{uq_i=i-1}
  | j < o = do uq' <- recenterUQ uq
               pushLUQ uq' x
  | otherwise = error "pushLUQ: overflow"

main = do
  [h, w] <- getIntList
  g <- VB.replicateM h BS.getLine

  tps <- VBM.new (fromEnum 'z' - fromEnum 'a' + 1)
  VBM.set tps ([] :: [(Int, Int)])

  let getC y x | y >= 0 && y < h && x >= 0 && x < w = (g VB.! y) `BS.index` x
               | otherwise = '#'

      scanG :: Int -> Int -> (Int, Int) -> (Int, Int) -> IO ((Int, Int), (Int, Int))
      scanG y x s g | y > h = return (s, g)
                    | x > w = scanG (y+1) 0 s g
                    | otherwise = do
                        let c = getC y x
                        case () of
                          () | c == 'S' -> scanG y (x+1) (y,x) g
                             | c == 'G' -> scanG y (x+1) s (y,x)
                             | c == '.' || c == '#' -> scanG y (x+1) s g
                             | otherwise -> do let j = fromEnum c - fromEnum 'a'
                                               t <- VBM.unsafeRead tps j
                                               VBM.unsafeWrite tps j ((y,x):t)
                                               scanG y (x+1) s g

  ((sy,sx), (gy, gx)) <- scanG 0 0 (-1,-1) (-1,-1)

  let nextPoss :: Int -> Int -> IO [(Int, Int)]
      nextPoss y x = do let c = getC y x
                            ns = [(y', x')
                                 | (y', x') <- [(y-1, x), (y+1, x), (y, x-1), (y, x+1)]
                                 , getC y' x' /= '#']
                        if (c >= 'a' && c <= 'z')
                          then do tp <- VBM.unsafeRead tps (fromEnum c - fromEnum 'a')
                                  VBM.unsafeWrite tps (fromEnum c - fromEnum 'a') []
                                  return $ ns ++ tp
                          else return ns

  arr <- IO.newArray ((0,0),(h-1,w-1)) inf :: IO (IO.IOUArray (Int, Int) Int)
  uq <- newUQueue 2000000

  let bfs :: IOUQueue ((Int, Int), Int) -> IO ()
      bfs uq | nullUQ uq = return ()
             | otherwise = do (uq', ((y, x), d)) <- poplUQ uq
                              t <- IO.readArray arr (y, x)
                              if (d < t)
                                then do IO.writeArray arr (y, x) d
                                        ns <- nextPoss y x
                                        uq'' <- pushListWithDUQ uq' ns (d+1)
                                        bfs uq''
                                else bfs uq'

  uq1 <- pushUQ uq ((sy, sx), 0)
  bfs uq1
  dist <- IO.readArray arr (gy, gx)
  print $ if dist == inf then (-1) else dist

Submission Info

Submission Time
Task E - Third Avenue
User unnohideyuki
Language Haskell (GHC 8.8.3)
Score 500
Code Size 7900 Byte
Status AC
Exec Time 1291 ms
Memory 105108 KiB

Compile Error

Loaded package environment from /home/contestant/.ghc/x86_64-linux-8.8.3/environments/default

Judge Result

Set Name Sample All
Score / Max Score 0 / 0 500 / 500
Status
AC × 3
AC × 38
Set Name Test Cases
Sample sample_01.txt, sample_02.txt, sample_03.txt
All hand_01.txt, random_01.txt, random_02.txt, random_03.txt, random_04.txt, random_05.txt, random_06.txt, random_07.txt, random_08.txt, random_09.txt, random_10.txt, random_11.txt, random_12.txt, random_13.txt, random_14.txt, random_15.txt, random_16.txt, random_17.txt, random_18.txt, random_19.txt, random_20.txt, random_21.txt, random_22.txt, random_23.txt, random_24.txt, random_25.txt, random_26.txt, random_27.txt, random_28.txt, random_29.txt, random_30.txt, random_31.txt, random_32.txt, random_33.txt, random_34.txt, sample_01.txt, sample_02.txt, sample_03.txt
Case Name Status Exec Time Memory
hand_01.txt AC 48 ms 51132 KiB
random_01.txt AC 39 ms 50960 KiB
random_02.txt AC 44 ms 51092 KiB
random_03.txt AC 40 ms 51180 KiB
random_04.txt AC 38 ms 51188 KiB
random_05.txt AC 42 ms 51048 KiB
random_06.txt AC 39 ms 51244 KiB
random_07.txt AC 41 ms 51348 KiB
random_08.txt AC 39 ms 51132 KiB
random_09.txt AC 34 ms 51192 KiB
random_10.txt AC 44 ms 51204 KiB
random_11.txt AC 42 ms 51232 KiB
random_12.txt AC 40 ms 51196 KiB
random_13.txt AC 39 ms 51184 KiB
random_14.txt AC 38 ms 51192 KiB
random_15.txt AC 38 ms 51352 KiB
random_16.txt AC 79 ms 54944 KiB
random_17.txt AC 321 ms 75120 KiB
random_18.txt AC 262 ms 64440 KiB
random_19.txt AC 68 ms 54220 KiB
random_20.txt AC 398 ms 73524 KiB
random_21.txt AC 47 ms 52468 KiB
random_22.txt AC 49 ms 52836 KiB
random_23.txt AC 201 ms 86656 KiB
random_24.txt AC 274 ms 100668 KiB
random_25.txt AC 87 ms 55008 KiB
random_26.txt AC 43 ms 52504 KiB
random_27.txt AC 357 ms 65708 KiB
random_28.txt AC 51 ms 52852 KiB
random_29.txt AC 39 ms 52496 KiB
random_30.txt AC 242 ms 105108 KiB
random_31.txt AC 1103 ms 92732 KiB
random_32.txt AC 1030 ms 103800 KiB
random_33.txt AC 1291 ms 88776 KiB
random_34.txt AC 321 ms 88780 KiB
sample_01.txt AC 41 ms 51136 KiB
sample_02.txt AC 41 ms 51192 KiB
sample_03.txt AC 37 ms 51136 KiB