結果

問題 No.3 ビットすごろく
コンテスト
ユーザー こまる
提出日時 2020-10-14 13:23:44
言語 Haskell
(9.10.1)
結果
TLE  
実行時間 -
コード長 3,410 bytes
コンパイル時間 3,857 ms
コンパイル使用メモリ 179,764 KB
実行使用メモリ 12,448 KB
最終ジャッジ日時 2024-07-20 19:06:40
合計ジャッジ時間 16,425 ms
ジャッジサーバーID
（参考情報） 		judge2 / judge1
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
other TLE * 1 -- * 32
権限があれば一括ダウンロードができます
コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )
[2 of 2] Linking a.out

ソースコード

diff # 

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase   #-}

import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.Fix
import           Data.Bits
import           Data.Bool
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Unboxed               as VU
import qualified Data.Vector.Unboxed.Mutable       as VUM

inf32 :: Int
inf32 = 9999999
{-# NOINLINE inf32 #-}

stream :: Monad m => Int -> Int -> VFSM.Stream m Int
stream !l !r = VFSM.Stream step l
  where
    step x
      | x < r     = return $ VFSM.Yield x (2 * x)
      | otherwise = return $ VFSM.Done
    {-# INLINE [0] step #-}
{-# INLINE [1] stream #-}

rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep n = flip VFSM.mapM_ (stream (-n) (n + 1))
{-# INLINE rep #-}

main :: IO ()
main = readLn >>= print . solver

solver :: Int -> Int
solver n = runST $ do
  dp <- VUM.replicate (n + 1) inf32
  VUM.unsafeWrite dp 1 (1 :: Int)
  q <- newVecQueue defaultVecQueueSize
  enqueueVQ (1 :: Int) q
  fix $ \loop -> do
    dequeueVQ q >>= \case
      Nothing -> do
        item <- VUM.unsafeRead dp n
        return $ bool (-1) item (item /= inf32)
      Just j -> do
        let move = popCount j
        rep move $ \i -> do
          let next = i + j
          when (1 <= next && next <= n) $ do
            item1 <- VUM.unsafeRead dp next
            when (item1 == inf32) $ do
              now <- VUM.unsafeRead dp j
              VUM.unsafeWrite dp next now
              enqueueVQ next q
        loop

data VecQueue s a = VecQueue
  { intVarsVQ  :: !(VUM.STVector s Int)
  , internalVQ :: !(VUM.STVector s a)
  }

_dequeueCount :: Int
_dequeueCount = 0
{-# INLINE _dequeueCount #-}

_enqueueCount :: Int
_enqueueCount = 1
{-# INLINE _enqueueCount #-}

newVecQueue :: VUM.Unbox a => Int -> ST s (VecQueue s a)
newVecQueue n = VecQueue <$> VUM.replicate 2 0 <*> VUM.unsafeNew n

defaultVecQueueSize :: Int
defaultVecQueueSize = 1024 * 1024

lengthVQ :: VUM.Unbox a => VecQueue s a -> ST s Int
lengthVQ (VecQueue info _) = (-)
  <$> VUM.unsafeRead info _enqueueCount
  <*> VUM.unsafeRead info _dequeueCount
{-# INLINE lengthVQ #-}

dequeueVQ :: VUM.Unbox a => VecQueue s a -> ST s (Maybe a)
dequeueVQ (VecQueue info q) = do
  f <- VUM.unsafeRead info _dequeueCount
  r <- VUM.unsafeRead info _enqueueCount
  if f < r
    then do
      VUM.unsafeWrite info _dequeueCount (f + 1)
      pure <$> VUM.unsafeRead q f
    else return Nothing
{-# INLINE dequeueVQ #-}

enqueueVQ :: VUM.Unbox a => a -> VecQueue s a -> ST s ()
enqueueVQ x (VecQueue info q) = do
  r <- VUM.unsafeRead info _enqueueCount
  VUM.unsafeWrite q r x
  VUM.unsafeWrite info _enqueueCount (r + 1)
{-# INLINE enqueueVQ #-}

enqueuesVQ :: VUM.Unbox a => VU.Vector a -> VecQueue s a -> ST s ()
enqueuesVQ vec (VecQueue info q) = do
  r <- VUM.unsafeRead info _enqueueCount
  VUM.unsafeWrite info _enqueueCount (r + VU.length vec)
  VU.unsafeCopy (VUM.unsafeSlice r (VU.length vec) q) vec
{-# INLINE enqueuesVQ #-}

clearVQ :: VUM.Unbox a => VecQueue s a -> ST s ()
clearVQ (VecQueue info _) = do
  VUM.unsafeWrite info _dequeueCount 0
  VUM.unsafeWrite info _enqueueCount 0

freezeVecQueue :: VUM.Unbox a => VecQueue s a -> ST s (VU.Vector a)
freezeVecQueue (VecQueue info q) = do
  f <- VUM.unsafeRead info _dequeueCount
  r <- VUM.unsafeRead info _enqueueCount
  VU.unsafeFreeze $ VUM.unsafeSlice f (r - f) q
0