{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ViewPatterns #-} {- base -} import Control.Arrow import Control.Monad import Control.Monad.ST import Control.Monad.Fix import Control.Monad.Identity import Data.Bits import Data.Bool import Data.Char import qualified Data.Complex as C import qualified Data.Foldable as F import qualified Data.List as L import Data.IORef import Data.Ix import qualified Data.Maybe as M import Data.Monoid import qualified Data.Ord as O import qualified Data.Ratio as R import Data.Semigroup import Data.Word import GHC.Exts import qualified System.IO as SysIO import Unsafe.Coerce {- array -} import qualified Data.Array as Arr import qualified Data.Array.IO as ArrIO import qualified Data.Array.MArray as ArrMA import qualified Data.Array.ST as ArrST import qualified Data.Array.Unboxed as ArrU {- bytestring -} import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Char8 as BSC8 import qualified Data.ByteString.Lazy.Char8 as BSLC8 import qualified Data.ByteString.Short as BSS import qualified Data.ByteString.Unsafe as BSU {- containers -} import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set {- deepseq -} import Control.DeepSeq {- integer-gmp -} import qualified GHC.Integer.GMP.Internals as GMP import qualified GHC.Integer.Logarithms.Internals as LOG {- mtl -} import qualified Control.Monad.State as MState {- time -} import Data.Time.Clock.POSIX (getPOSIXTime) {- vector -} import qualified Data.Vector as V import qualified Data.Vector.Fusion.Stream.Monadic as VFSM import qualified Data.Vector.Generic as VG import qualified Data.Vector.Generic.Mutable as VGM import qualified Data.Vector.Mutable as VM import qualified Data.Vector.Primitive as VP import qualified Data.Vector.Primitive.Mutable as VPM import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Unboxed.Mutable as VUM {- vector-algorithms -} -- import qualified Data.Vector.Algorithms.Tim as Tim -- import qualified Data.Vector.Algorithms.Intro as Intro #define MOD 1000000007 ------------------------------------------------------------------------------- -- main ------------------------------------------------------------------------------- main :: IO () main = do [n, k] <- map read . words <$> getLine bit <- newBIT 2000000 rep n $ \_ -> do w <- parse1 if w > 0 then do temp1 <- bit -|-! 2000000 temp2 <- bit -|-! (w - 1) when (temp1 - temp2 < k) $ incBIT w 1 bit else do let w' = abs w temp3 <- bit -|-! w' temp4 <- bit -|-! (w' - 1) when (temp3 - temp4 > 0) $ incBIT w' (-1) bit print =<< bit -|-! 2000000 ------------------------------------------------------------------------------- -- BinaryIndexedTree ------------------------------------------------------------------------------- type BinaryIndexedTree = ArrIO.IOUArray Int Int newBIT :: Int -> IO BinaryIndexedTree newBIT n = ArrMA.newListArray (1, n) $ repeat 0 (-|-!) :: BinaryIndexedTree -> Int -> IO Int (-|-!) bit i = f i 0 where f i acc | i < 1 = return acc | otherwise = do acc' <- (+acc) <$> ArrMA.readArray bit i let i' = i - (i .&. (-i)) f i' acc' incBIT :: Int -> Int -> BinaryIndexedTree -> IO () incBIT i v bit = do (_, u) <- ArrMA.getBounds bit _func i u v bit where _func :: (ArrMA.MArray a b f, Ix c, Num b, Num c, Bits c) => c -> c -> b -> a c b -> f () _func z u v bit = when (z <= u) $ do ArrMA.writeArray bit z . (+ v) =<< ArrMA.readArray bit z _func (z + (z .&. (-z))) u v bit ------------------------------------------------------------------------------- -- utils ------------------------------------------------------------------------------- fi :: Int -> Integer fi = fromIntegral {-# INLINE fi #-} fI :: Integer -> Int fI = fromInteger {-# INLINE fI #-} powModInt :: Int -> Int -> Int -> Int powModInt a b c = fI $ GMP.powModInteger (fi a) (fi b) (fi c) {-# INLINE powModInt #-} recipModInt :: Int -> Int -> Int recipModInt a m = fI $ GMP.recipModInteger (fi a) (fi m) {-# INLINE recipModInt #-} 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 (.^.) #-} 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 #-} rep :: Monad m => Int -> (Int -> m ()) -> m () rep n = flip VFSM.mapM_ (stream 0 n) {-# INLINE rep #-} 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 #-} rev :: Monad m => Int -> (Int -> m ()) -> m () rev !n = flip VFSM.mapM_ (streamR 0 n) {-# INLINE rev #-} streamStep :: Monad m => Int -> Int -> Int -> VFSM.Stream m Int streamStep !l !r !d = VFSM.Stream step l where step x | x < r = return $ VFSM.Yield x (x + d) | otherwise = return $ VFSM.Done {-# INLINE [0] step #-} {-# INLINE [1] streamStep #-} ------------------------------------------------------------------------------- -- input ------------------------------------------------------------------------------- type Parser a = BSC8.ByteString -> Maybe (a, BSC8.ByteString) parseInt :: Parser Int parseInt = fmap (second BSC8.tail) . BSC8.readInt parseChar :: IO (VU.Vector Char) parseChar = VU.fromList <$> getLine parse1 :: IO Int parse1 = readLn parse2 :: IO (Int, Int) parse2 = (\vec -> (vec VU.! 0, vec VU.! 1)) . VU.unfoldrN 2 parseInt <$> BSC8.getLine parse3 :: IO (Int, Int, Int) parse3 = (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2)) . VU.unfoldrN 3 parseInt <$> BSC8.getLine parse4 :: IO (Int, Int, Int, Int) parse4 = (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2, vec VU.! 3)) . VU.unfoldrN 4 parseInt <$> BSC8.getLine parseM :: Int -> IO (VU.Vector Int) parseM m = VU.unfoldrN m parseInt <$> BSC8.getLine parseN1 :: Int -> IO (VU.Vector Int) parseN1 n = VU.replicateM n parse1 parseN2 :: Int -> IO (VU.Vector (Int, Int)) parseN2 n = VU.replicate n <$> parse2 parseN3 :: Int -> IO (VU.Vector (Int, Int, Int)) parseN3 n = VU.replicate n <$> parse3 parseN4 :: Int -> IO (VU.Vector (Int ,Int, Int, Int)) parseN4 n = VU.replicate n <$> parse4 parseNM :: Int -> Int -> IO (V.Vector (VU.Vector Int)) parseNM n m = V.replicateM n $ VU.unfoldrN m parseInt <$> BSC8.getLine parseANBN :: Int -> IO (VU.Vector Int, VU.Vector Int) parseANBN n = do vectup <- VU.replicateM n $ (\vec -> (vec VU.! 0, vec VU.! 1)) . VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine return $ VU.unzip vectup parseANBNCN :: Int -> IO (VU.Vector Int, VU.Vector Int, VU.Vector Int) parseANBNCN n = do vectup <- VU.replicateM n $ (\vec -> (vec VU.! 0, vec VU.! 1, vec VU.! 2)) . VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine return $ VU.unzip3 vectup type CParser a = MState.StateT BSC8.ByteString Maybe a runCParser :: CParser a -> BSC8.ByteString -> Maybe (a, BSC8.ByteString) runCParser = MState.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 #-} char :: CParser Char char = coerce BSC8.uncons {-# INLINE char #-} byte :: CParser Word8 byte = coerce BS.uncons {-# INLINE byte #-} skipSpaces :: CParser () skipSpaces = MState.modify' (BSC8.dropWhile isSpace) {-# INLINE skipSpaces #-} v2BLinesWith :: VG.Vector v t => (t -> BSB.Builder) -> v t -> BSB.Builder v2BLinesWith showFct = VG.foldr (\ a -> (showFct a <>) . (BSB.char7 '\n' <>)) mempty {-# INLINE v2BLinesWith #-} putBuilder :: BSB.Builder -> IO () putBuilder = BSB.hPutBuilder SysIO.stdout {-# INLINE putBuilder #-} getVUInt :: IO (VU.Vector Int) getVUInt = VU.unfoldr (BSC8.readInt . BSC8.dropWhile isSpace) <$> BSC8.getLine ------------------------------------------------------------------------------- -- Mint ------------------------------------------------------------------------------- modulus :: Num a => a modulus = MOD {-# INLINE modulus #-} infixr 8 ^% infixl 7 *%, /% infixl 6 +%, -% (+%) :: Int -> Int -> Int (I# x#) +% (I# y#) = case x# +# y# of r# -> I# (r# -# ((r# >=# MOD#) *# MOD#)) {-# INLINE (+%) #-} (-%) :: Int -> Int -> Int (I# x#) -% (I# y#) = case x# -# y# of r# -> I# (r# +# ((r# <# 0#) *# MOD#)) {-# INLINE (-%) #-} (*%) :: Int -> Int -> Int (I# x#) *% (I# y#) = case timesWord# (int2Word# x#) (int2Word# y#) of z# -> case timesWord2# z# im# of (# q#, _ #) -> case minusWord# z# (timesWord# q# m#) of v# | isTrue# (geWord# v# m#) -> I# (word2Int# (plusWord# v# m#)) | otherwise -> I# (word2Int# v#) where m# = int2Word# MOD# im# = plusWord# (quotWord# 0xffffffffffffffff## m#) 1## {-# INLINE (*%) #-} (/%) :: Int -> Int -> Int (I# x#) /% (I# y#) = go# y# MOD# 1# 0# where go# a# b# u# v# | isTrue# (b# ># 0#) = case a# `quotInt#` b# of q# -> go# b# (a# -# (q# *# b#)) v# (u# -# (q# *# v#)) | otherwise = I# ((x# *# (u# +# MOD#)) `remInt#` MOD#) {-# INLINE (/%) #-} (^%) :: Int -> Int -> Int x ^% n | n > 0 = go 1 x n | n == 0 = 1 | otherwise = go 1 (1 /% x) (-n) where go !acc !y !m | m .&. 1 == 0 = go acc (y *% y) (unsafeShiftR m 1) | m == 1 = acc *% y | otherwise = go (acc *% y) (y *% y) (unsafeShiftR (m - 1) 1) newtype Mint = Mint { getMint :: Int } deriving newtype (Eq, Ord, Read, Show, Real) mint :: Integral a => a -> Mint mint x = fromIntegral $ mod (fromIntegral x) MOD {-# INLINE mint #-} mintValidate :: Mint -> Bool mintValidate (Mint x) = 0 <= x && x < MOD {-# INLINE mintValidate #-} instance Bounded Mint where minBound = Mint 0 maxBound = Mint $ modulus - 1 instance Enum Mint where toEnum = mint fromEnum = coerce instance Integral Mint where quotRem x y = (x / y, x - x / y * y) toInteger = coerce (toInteger @Int) instance Num Mint where (+) = coerce (+%) (-) = coerce (-%) (*) = coerce (*%) abs = id signum = const (Mint 1) fromInteger x = coerce @Int @Mint . fromInteger $ mod x modulus instance Fractional Mint where (/) = coerce (/%) fromRational q = fromInteger (R.numerator q) / fromInteger (R.denominator q) newtype instance VUM.MVector s Mint = MV_Mint (VUM.MVector s Int) newtype instance VU.Vector Mint = V_Mint (VU.Vector Int) instance VU.Unbox Mint instance VGM.MVector VUM.MVector Mint where basicLength (MV_Mint v) = VGM.basicLength v {-# INLINE basicLength #-} basicUnsafeSlice i n (MV_Mint v) = MV_Mint $ VGM.basicUnsafeSlice i n v {-# INLINE basicUnsafeSlice #-} basicOverlaps (MV_Mint v1) (MV_Mint v2) = VGM.basicOverlaps v1 v2 {-# INLINE basicOverlaps #-} basicUnsafeNew n = MV_Mint `fmap` VGM.basicUnsafeNew n {-# INLINE basicUnsafeNew #-} basicInitialize (MV_Mint v) = VGM.basicInitialize v {-# INLINE basicInitialize #-} basicUnsafeReplicate n x = MV_Mint `fmap` VGM.basicUnsafeReplicate n (coerce x) {-# INLINE basicUnsafeReplicate #-} basicUnsafeRead (MV_Mint v) i = coerce `fmap` VGM.basicUnsafeRead v i {-# INLINE basicUnsafeRead #-} basicUnsafeWrite (MV_Mint v) i x = VGM.basicUnsafeWrite v i (coerce x) {-# INLINE basicUnsafeWrite #-} basicClear (MV_Mint v) = VGM.basicClear v {-# INLINE basicClear #-} basicSet (MV_Mint v) x = VGM.basicSet v (coerce x) {-# INLINE basicSet #-} basicUnsafeCopy (MV_Mint v1) (MV_Mint v2) = VGM.basicUnsafeCopy v1 v2 {-# INLINE basicUnsafeCopy #-} basicUnsafeMove (MV_Mint v1) (MV_Mint v2) = VGM.basicUnsafeMove v1 v2 {-# INLINE basicUnsafeMove #-} basicUnsafeGrow (MV_Mint v) n = MV_Mint `fmap` VGM.basicUnsafeGrow v n {-# INLINE basicUnsafeGrow #-} instance VG.Vector VU.Vector Mint where basicUnsafeFreeze (MV_Mint v) = V_Mint `fmap` VG.basicUnsafeFreeze v {-# INLINE basicUnsafeFreeze #-} basicUnsafeThaw (V_Mint v) = MV_Mint `fmap` VG.basicUnsafeThaw v {-# INLINE basicUnsafeThaw #-} basicLength (V_Mint v) = VG.basicLength v {-# INLINE basicLength #-} basicUnsafeSlice i n (V_Mint v) = V_Mint $ VG.basicUnsafeSlice i n v {-# INLINE basicUnsafeSlice #-} basicUnsafeIndexM (V_Mint v) i = coerce `fmap` VG.basicUnsafeIndexM v i {-# INLINE basicUnsafeIndexM #-} basicUnsafeCopy (MV_Mint mv) (V_Mint v) = VG.basicUnsafeCopy mv v elemseq _ = seq {-# INLINE elemseq #-}