#566237 (Haskell) No.1234 典型RMQ

• 問題: No.1234 典型RMQ
• ユーザー: こまる
• 提出日時: 2020-10-13 05:26:30
• 言語: Haskell (9.8.2)
• 結果: CE (最新)
  AC
  (最初)
• 実行時間: -
• コード長: 8,762 bytes
• コンパイル時間: 1,103 ms
• コンパイル使用メモリ: 190,456 KB
• 最終ジャッジ日時: 2024-04-27 05:01:43
• 合計ジャッジ時間: 1,941 ms
• ジャッジサーバーID （参考情報）: judge1 / judge4

コンパイルメッセージ

Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:135:67: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:13:1-26,
           or ‘Main..>>.’, defined at Main.hs:31:1.
    |
135 |   flip VFSM.mapM_ (streamR 1 h) $ \i -> pushLazySegmentTree st (k .>>. i)
    |                                                                   ^^^^

Main.hs:137:69: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:13:1-26,
           or ‘Main..>>.’, defined at Main.hs:31:1.
    |
137 |   flip VFSM.mapM_ (stream 1 h)  $ \i -> updateLazySegmentTree st (k .>>. i)
    |                                                                     ^^^^

Main.hs:145:67: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:13:1-26,
           or ‘Main..>>.’, defined at Main.hs:31:1.
    |
145 |   flip VFSM.mapM_ (streamR 1 h) $ \i -> pushLazySegmentTree st (k .>>. i)
    |                                                                   ^^^^

Main.hs:157:14: error: [GHC-87543]
    Ambiguous occurrence ‘.>>.’.
    It could refer to
       either ‘Data.Bits..>>.’,
              imported from ‘Data.Bits’ at Main.hs:13:1-26,
           or ‘Main..>>.’, defined at Main.hs:31:1.
    |
157 |     when ((l .>>. i) .<<. i /= l) $ pushLazySegmentTree st (l .>>. i)
    |              ^^^^

Main.hs:157:22: error: [GHC-87543]
    Ambiguous occurrence ‘.<<.’.
    It could refer to
       either ‘Data.Bits..<<.’,
              imported from ‘Data.Bits’ at Main.hs:13:1-26,
           or ‘Main..<<.’, defined at Main.hs:27:1.
 

ソースコード

{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}

import           Control.Arrow
import           Control.Monad
import           Control.Monad.Fix
import           Control.Monad.State.Strict
import           Data.Bits
import           Data.Char
import           Data.Monoid                       hiding (First (..), Last (..))
import           Data.Semigroup
import           GHC.Exts
import qualified Data.ByteString.Char8             as BSC8
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Unboxed               as VU
import qualified Data.Vector.Unboxed.Mutable       as VUM

infixl 8 .<<., .>>., .>>>.
infixl 6 .^.

(.<<.) :: Bits b => b -> Int -> b
(.<<.) = unsafeShiftL
{-# INLINE (.<<.) #-}

(.>>.) :: Bits b => b -> Int -> b
(.>>.) = unsafeShiftR
{-# INLINE (.>>.) #-}

(.>>>.) :: Int -> Int -> Int
(.>>>.) (I# x#) (I# i#) = I# (uncheckedIShiftRL# x# i#)
{-# INLINE (.>>>.) #-}

(.^.) :: Bits b => b -> b -> b
(.^.) = xor
{-# INLINE (.^.) #-}

ctz :: FiniteBits fb => fb -> Int
ctz = countTrailingZeros
{-# INLINE ctz #-}

clz :: FiniteBits fb => fb -> Int
clz = countLeadingZeros
{-# INLINE clz #-}

extendToPowerOfTwo :: Int -> Int
extendToPowerOfTwo x
  | x > 1 = (-1) .>>>. (clz (x - 1)) + 1
  | otherwise = 1

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

rev :: Monad m => Int -> (Int -> m ()) -> m ()
rev !n = flip VFSM.mapM_ (streamR 0 n)
{-# INLINE rev #-}

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 (x + 1)
      | otherwise = return $ VFSM.Done
    {-# INLINE [0] step #-}
{-# INLINE [1] stream #-}

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

class Monoid f => MonoidAction f a where
  appMonoid :: f -> a -> a

data LazySegmentTree a f = LazySegmentTree (VUM.IOVector a) (VUM.IOVector f)

newLazySegmentTree :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f)
  => Int
  -> IO (LazySegmentTree a f)
newLazySegmentTree n = LazySegmentTree
  <$> VUM.replicate (2 * extendToPowerOfTwo n) mempty
  <*> VUM.replicate (extendToPowerOfTwo n) mempty

buildLazySegmentTree :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f)
  => VU.Vector a -> IO (LazySegmentTree a f)
buildLazySegmentTree xs = do
  tree <- VUM.replicate (2 * n) mempty
  lazy <- VUM.replicate n mempty
  VU.unsafeCopy (VUM.unsafeSlice n (VU.length xs) tree) xs
  let seg = LazySegmentTree tree lazy
  flip VFSM.mapM_ (streamR 1 n) $ \i -> updateLazySegmentTree seg i
  return seg
    where
      !n = extendToPowerOfTwo $ VU.length xs

updateLazySegmentTree :: (Monoid a, VU.Unbox a)
  => LazySegmentTree a f -> Int -> IO ()
updateLazySegmentTree (LazySegmentTree tree _) k = do
  (<>)
  <$> VUM.unsafeRead tree (2 * k)
  <*> VUM.unsafeRead tree (2 * k + 1) >>= VUM.unsafeWrite tree k
{-# INLINE updateLazySegmentTree #-}

appAllAt :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f, MonoidAction f a)
  => LazySegmentTree a f -> Int -> f -> IO ()
appAllAt (LazySegmentTree tree lazy) k f = do
  VUM.unsafeModify tree (appMonoid f) k
  when (k < VUM.length lazy) $ VUM.unsafeModify lazy (mappend f) k
{-# INLINE appAllAt #-}

pushLazySegmentTree :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f, MonoidAction f a)
  => LazySegmentTree a f -> Int  -> IO ()
pushLazySegmentTree st@(LazySegmentTree _ lazy) k = do
  fk <- VUM.unsafeRead lazy k
  appAllAt st (2 * k) fk
  appAllAt st (2 * k + 1) fk
  VUM.unsafeWrite lazy k mempty
{-# INLINE pushLazySegmentTree #-}

writeLazySegmentTree :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f, MonoidAction f a)
  => LazySegmentTree a f -> Int -> a -> IO ()
writeLazySegmentTree st@(LazySegmentTree tree lazy) k0 v = do
  let !n = VUM.length lazy
      k  = k0 + n
      !h = 64 - clz n
  flip VFSM.mapM_ (streamR 1 h) $ \i -> pushLazySegmentTree st (k .>>. i)
  VUM.unsafeWrite tree k v
  flip VFSM.mapM_ (stream 1 h)  $ \i -> updateLazySegmentTree st (k .>>. i)
{-# INLINE writeLazySegmentTree #-}

readLazySegmentTree :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f, MonoidAction f a) => LazySegmentTree a f -> Int -> IO a
readLazySegmentTree st@(LazySegmentTree tree lazy) k0 = do
  let !n = VUM.length lazy
      k  = k0 + n
      !h = 64 - clz n
  flip VFSM.mapM_ (streamR 1 h) $ \i -> pushLazySegmentTree st (k .>>. i)
  VUM.unsafeRead tree k
{-# INLINE readLazySegmentTree #-}

mappendFromTo :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f, MonoidAction f a)
  => LazySegmentTree a f -> Int -> Int -> IO a
mappendFromTo st@(LazySegmentTree tree lazy) l0 r0 = do
  let !n = VUM.length lazy
      !l = l0 + n
      !r = r0 + n
      !h = 64 - clz n
  flip VFSM.mapM_ (streamR 1 h) $ \i -> do
    when ((l .>>. i) .<<. i /= l) $ pushLazySegmentTree st (l .>>. i)
    when ((r .>>. i) .<<. i /= r) $ pushLazySegmentTree st (r .>>. i)
  let calcL l acc
        | l .&. 1 == 1 =      mappend acc <$> VUM.unsafeRead tree l
        | otherwise = return acc
      calcR r acc
        | r .&. 1 == 1 = flip mappend acc <$> VUM.unsafeRead tree (r - 1)
        | otherwise = return acc
  fix (\loop !accL !accR !l' !r' -> do
    if l' < r'
      then do
        !accL' <- calcL l' accL
        !accR' <- calcR r' accR
        loop accL' accR'
          ((l' + l' .&. 1) .>>>. 1)
          ((r' - r' .&. 1) .>>>. 1)
      else return $! accL <> accR
      ) mempty mempty l r
{-# INLINE mappendFromTo #-}

mappendAll :: (Monoid a, VU.Unbox a)
  => LazySegmentTree a f -> IO a
mappendAll (LazySegmentTree tree _) = VUM.unsafeRead tree 1
{-# INLINE mappendAll #-}

appAt :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f, MonoidAction f a)
  => LazySegmentTree a f -> Int -> f -> IO ()
appAt st@(LazySegmentTree tree lazy) k0 f = do
  let !n = VUM.length lazy
      k  = k0 + n
      !h = 64 - clz n
  flip VFSM.mapM_ (streamR 1 h) $ \i -> pushLazySegmentTree st (k .>>. i)
  VUM.unsafeModify tree (appMonoid f) k
  flip VFSM.mapM_ (stream 1 h)  $ \i -> updateLazySegmentTree st (k .>>. i)
{-# INLINE appAt #-}

appFromTo :: (Monoid a, VU.Unbox a, Monoid f, VU.Unbox f, MonoidAction f a)
  => LazySegmentTree a f -> Int -> Int -> f -> IO ()
appFromTo st@(LazySegmentTree _ lazy) l0 r0 f = when (l0 < r0) $ do
  let !n = VUM.length lazy
      !l = l0 + n
      !r = r0 + n
      !h = 64 - clz n
  flip VFSM.mapM_ (streamR 1 h) $ \i -> do
    when ((l .>>. i) .<<. i /= l) $ pushLazySegmentTree st (l .>>>. i)
    when ((r .>>. i) .<<. i /= r) $ pushLazySegmentTree st ((r - 1) .>>>. i)
  fix (\loop !l' !r' -> when (l' < r') $ do
    when (l' .&. 1 == 1) $ appAllAt st l' f
    when (r' .&. 1 == 1) $ appAllAt st (r' - 1) f
    loop ((l' + l' .&. 1) .>>>. 1) ((r' - r' .&. 1) .>>>. 1)
    ) l r
  flip VFSM.mapM_ (stream 1 h) $ \i -> do
    when ((l .>>. i) .<<. i /= l) $ updateLazySegmentTree st (l .>>>. i)
    when ((r .>>. i) .<<. i /= r) $ updateLazySegmentTree st ((r - 1) .>>>. i)
{-# INLINE appFromTo #-}

type Parser a = BSC8.ByteString -> Maybe (a, BSC8.ByteString)
parseInt :: Parser Int
parseInt = fmap (second BSC8.tail) . BSC8.readInt
parseM :: Int -> IO (VU.Vector Int)
parseM m = VU.unfoldrN m parseInt <$> BSC8.getLine

type CParser a = StateT BSC8.ByteString Maybe a
parseN4 :: Int -> IO (VU.Vector (Int ,Int, Int, Int))
parseN4 n = VU.unfoldrN n (runCParser $ (,,,) <$> int <*> int1 <*> int <*> int) <$> BSC8.getContents
runCParser :: CParser a -> BSC8.ByteString -> Maybe (a, BSC8.ByteString)
runCParser = runStateT
{-# INLINE runCParser #-}
int :: CParser Int
int = coerce $ BSC8.readInt . BSC8.dropWhile isSpace
{-# INLINE int #-}
int1 :: CParser Int
int1 = fmap (subtract 1) int
{-# INLINE int1 #-}

main :: IO ()
main = do
  m  <- readLn :: IO Int
  as <- parseM m
  q  <- readLn :: IO Int
  qs <- parseN4 q
  putStr . unlines . map show . VU.toList =<< solve m as q qs

solve :: Int -> VU.Vector Int -> Int -> VU.Vector (Int, Int, Int, Int) -> IO (VU.Vector Int)
solve _ as _ qs = do
  seg <- buildLazySegmentTree @(Min Int) @(Sum Int) $ VU.map Min as
  fmap (VU.map snd . VU.filter ((/= (1 :: Int)). fst)) $ VU.forM qs $ \case
    (1, l, r, c) -> do
      appFromTo seg l r (Sum c)
      return (1, 0)
    (t, l, r, _) -> do
      res <- getMin <$> mappendFromTo seg l r
      return (t, res)

instance MonoidAction (Sum Int) (Min Int) where
  appMonoid = coerce ((+) @Int)
  {-# INLINE appMonoid #-}