Submission #57980633
Source Code Expand
-- toy-lib: https://github.com/toyboot4e/toy-lib
{- ORMOLU_DISABLE -}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds -Wno-orphans #-}
{-# LANGUAGE BlockArguments, CPP, DataKinds, DefaultSignatures, DerivingVia, LambdaCase, MagicHash, MultiWayIf, NumDecimals, PatternSynonyms, QuantifiedConstraints, RecordWildCards, StandaloneDeriving, StrictData, TypeFamilies, ViewPatterns #-}
import Control.Applicative;import Control.DeepSeq;import Control.Exception (assert);import Control.Monad;import Control.Monad.Fix;import Control.Monad.IO.Class;import Control.Monad.Primitive;import Control.Monad.ST;import Control.Monad.State.Class;import Control.Monad.Trans (MonadTrans, lift);import Control.Monad.Trans.Cont;import Control.Monad.Trans.Maybe;import Control.Monad.Trans.State.Strict (State, StateT(..), evalState, evalStateT, execState, execStateT, runState, runStateT);import Data.Bifunctor;import Data.Bits;import Data.Bool (bool);import Data.Char;import Data.Coerce;import Data.Either;import Data.Foldable;import Data.Function (on);import Data.Functor;import Data.Functor.Identity;import Data.IORef;import Data.Kind;import Data.List.Extra hiding (nubOn);import Data.Maybe;import Data.Ord;import Data.Primitive.MutVar;import Data.Proxy;import Data.STRef;import Data.Semigroup;import Data.Word;import Debug.Trace;import GHC.Exts (proxy#);import GHC.Float (int2Float);import GHC.Ix (unsafeIndex);import GHC.Stack (HasCallStack);import GHC.TypeLits;import System.Exit (exitSuccess);import System.IO;import System.Random;import System.Random.Stateful;import Text.Printf;import Data.Ratio;import Data.Array.IArray;import Data.Array.IO;import Data.Array.MArray;import Data.Array.ST;import Data.Array.Unboxed (UArray);import Data.Array.Unsafe;import qualified Data.Array as A;import Data.Bit;import qualified Data.ByteString.Builder as BSB;import qualified Data.ByteString.Char8 as BS;import qualified Data.ByteString.Unsafe as BSU;import Control.Monad.Extra hiding (loop);import Data.IORef.Extra;import Data.List.Extra hiding (merge);import Data.Tuple.Extra hiding (first, second);import Numeric.Extra;import Data.Bool.HT;import qualified Data.Ix.Enum as HT;import qualified Data.List.HT as HT;import qualified Data.Vector.Fusion.Bundle as FB;import qualified Data.Vector.Generic as G;import qualified Data.Vector.Generic.Mutable as GM;import qualified Data.Vector.Primitive as P;import qualified Data.Vector.Unboxed as U;import qualified Data.Vector.Unboxed.Base as U;import qualified Data.Vector.Unboxed.Mutable as UM;import qualified Data.Vector as V;import qualified Data.Vector.Mutable as VM;import qualified Data.Vector.Fusion.Bundle.Monadic as MB;import qualified Data.Vector.Fusion.Bundle.Size as MB;import qualified Data.Vector.Fusion.Stream.Monadic as MS;import qualified Data.Vector.Algorithms.Merge as VAM;import qualified Data.Vector.Algorithms.Intro as VAI;import qualified Data.Vector.Algorithms.Radix as VAR;import qualified Data.Vector.Algorithms.Search as VAS;import qualified Data.IntMap.Strict as IM;import qualified Data.Map.Strict as M;import qualified Data.IntSet as IS;import qualified Data.Set as S;import qualified Data.Sequence as Seq;import qualified Data.Heap as H;import Data.Hashable;import qualified Data.HashMap.Strict as HM;import qualified Data.HashSet as HS;import qualified Test.QuickCheck as QC;import Unsafe.Coerce;
class (Ix i, U.Unbox i) => Unindex i where { unindex :: (i, i) -> Int -> i};instance Unindex Int where { {-# INLINE unindex #-}; unindex _ !v = v};instance Unindex (Int, Int) where { {-# INLINE unindex #-}; unindex ((!y0, !x0), (!_, !x1)) !yx = let { !w = x1 - x0 + 1; (!dy, !dx) = yx `quotRem` w} in (y0 + dy, x0 + dx)};instance Unindex (Int, Int, Int) where { {-# INLINE unindex #-}; unindex ((!z0, !y0, !x0), (!_, !y1, !x1)) !zyx = let { !h = y1 - y0 + 1; !w = x1 - x0 + 1; (!dz, !yx) = zyx `quotRem` (h * w); (!dy, !dx) = yx `quotRem` w} in (z0 + dz, y0 + dy, x0 + dx)};instance Unindex (Int, Int, Int, Int) where { {-# INLINE unindex #-}; unindex ((!b3, !b2, !b1, !b0), (!_, !x2, !x1, !x0)) !pos3 = let { !w2 = x2 - b2 + 1; !w1 = x1 - b1 + 1; !w0 = x0 - b0 + 1; (!y3, !pos2) = pos3 `quotRem` (w2 * w1 * w0); (!y2, !pos1) = pos2 `quotRem` (w1 * w0); (!y1, !y0) = pos1 `quotRem` w0} in (b3 + y3, b2 + y2, b1 + y1, b0 + y0)};instance Unindex ((Int, Int), (Int, Int)) where { {-# INLINE unindex #-}; unindex (((!b3, !b2), (!b1, !b0)), ((!_, !x2), (!x1, !x0))) !pos3 = let { !w2 = x2 - b2 + 1; !w1 = x1 - b1 + 1; !w0 = x0 - b0 + 1; (!y3, !pos2) = pos3 `quotRem` (w2 * w1 * w0); (!y2, !pos1) = pos2 `quotRem` (w1 * w0); (!y1, !y0) = pos1 `quotRem` w0} in ((b3 + y3, b2 + y2), (b1 + y1, b0 + y0))};bisectImpl :: forall i m . (Eq i, Monad m) => (i -> i -> Maybe i) -> i -> i -> i -> i -> (i -> m Bool) -> m (Maybe i, Maybe i);bisectImpl getMid l0 r0 lowOut highOut p = done <$> inner lowOut highOut where { done :: (i, i) -> (Maybe i, Maybe i); done (!l, !r) | l == lowOut = (Nothing, Just l0) | r == highOut = (Just r0, Nothing) | otherwise = (Just l, Just r); inner :: i -> i -> m (i, i); inner !y !n | Just m <- getMid y n = p m >>= \case { True -> inner m n; False -> inner y m} | otherwise = return (y, n)};getMidInt :: Int -> Int -> Maybe Int;getMidInt l r | abs (r - l) == 1 = Nothing | otherwise = Just $ (l + r) `div` 2;getMidDouble :: Double -> Double -> Double -> Maybe Double;getMidDouble eps l r | abs (r - l) < eps = Nothing | otherwise = Just $ (l + r) / 2;{-# INLINE bisectM #-};bisectM :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int, Maybe Int);bisectM !l !r !p | l <= r = bisectImpl getMidInt l r (l - 1) (r + 1) p | otherwise = bisectImpl getMidInt l r (l + 1) (r - 1) p;{-# INLINE bisectML #-};bisectML :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectML !l !r !p = fst <$> bisectM l r p;{-# INLINE bisectMR #-};bisectMR :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectMR !l !r !p = snd <$> bisectM l r p;{-# INLINE bisect #-};bisect :: Int -> Int -> (Int -> Bool) -> (Maybe Int, Maybe Int);bisect !l !r !p = runIdentity $ bisectM l r (return . p);{-# INLINE bisectL #-};bisectL :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectL !l !r !p = fst $! bisect l r p;{-# INLINE bisectR #-};bisectR :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectR !l !r !p = snd $! bisect l r p;{-# INLINE bisectMF64 #-};bisectMF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double, Maybe Double);bisectMF64 !eps !l !r !p | l <= r = bisectImpl (getMidDouble eps) l r (l - eps) (r + eps) p | otherwise = bisectImpl (getMidDouble eps) l r (l + eps) (r - eps) p;{-# INLINE bisectMLF64 #-};bisectMLF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double);bisectMLF64 !eps !l !r !p = fst <$> bisectMF64 eps l r p;{-# INLINE bisectMRF64 #-};bisectMRF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double);bisectMRF64 !eps !l !r !p = snd <$> bisectMF64 eps l r p;{-# INLINE bisectF64 #-};bisectF64 :: Double -> Double -> Double -> (Double -> Bool) -> (Maybe Double, Maybe Double);bisectF64 !eps !l !r !p = runIdentity $ bisectMF64 eps l r (return . p);{-# INLINE bisectLF64 #-};bisectLF64 :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectLF64 !eps !l !r !p = fst $! bisectF64 eps l r p;{-# INLINE bisectRF64 #-};bisectRF64 :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectRF64 !eps !l !r !p = snd $! bisectF64 eps l r p;{-# INLINE bsearchM #-};bsearchM :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int, Maybe Int);bsearchM !vec !p = bisectM 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchML #-};bsearchML :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int);bsearchML !vec !p = bisectML 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchMR #-};bsearchMR :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int);bsearchMR !vec !p = bisectMR 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchMExact #-};bsearchMExact :: (PrimMonad m, GM.MVector v a, Ord b) => v (PrimState m) a -> (a -> b) -> b -> m (Maybe Int);bsearchMExact !vec f !xref = bisectML 0 (GM.length vec - 1) (fmap ((<= xref) . f) . GM.read vec) >>= \case { Just !i -> do { !x <- f <$> GM.read vec i; if x == xref then return $ Just i else return Nothing}; _ -> return Nothing};{-# INLINE bsearch #-};bsearch :: (G.Vector v a) => v a -> (a -> Bool) -> (Maybe Int, Maybe Int);bsearch !vec !p = bisect 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchL #-};bsearchL :: (G.Vector v a) => v a -> (a -> Bool) -> Maybe Int;bsearchL !vec !p = bisectL 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchR #-};bsearchR :: (G.Vector v a) => v a -> (a -> Bool) -> Maybe Int;bsearchR !vec !p = bisectR 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchExact #-};bsearchExact :: (G.Vector v a, Ord b) => v a -> (a -> b) -> b -> Maybe Int;bsearchExact !vec f !xref = case bisectL 0 (G.length vec - 1) ((<= xref) . f . (vec G.!)) of { Just !x | f (vec G.! x) == xref -> Just x; _ -> Nothing};isqrtSlow :: Int -> Int;isqrtSlow n = fromJust $ bisectR 0 n ((< n) . (^ (2 :: Int)));{-# INLINE endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';{-# INLINE putBSB #-};putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;{-# INLINE putLnBSB #-};putLnBSB :: (MonadIO m) => BSB.Builder -> m ();putLnBSB = liftIO . BSB.hPutBuilder stdout . (<> endlBSB);{-# INLINE wsBSB #-};wsBSB :: BSB.Builder;wsBSB = BSB.char7 ' ';class ShowBSB a where { showBSB :: a -> BSB.Builder; {-# INLINE showBSB #-}; default showBSB :: (Show a) => a -> BSB.Builder; showBSB = BSB.string8 . show};instance ShowBSB Int where { {-# INLINE showBSB #-}; showBSB = BSB.intDec};instance ShowBSB Integer where { {-# INLINE showBSB #-}; showBSB = BSB.integerDec};instance ShowBSB Float where { {-# INLINE showBSB #-}; showBSB = BSB.floatDec};instance ShowBSB Double where { {-# INLINE showBSB #-}; showBSB = BSB.doubleDec};instance ShowBSB Char where { {-# INLINE showBSB #-}; showBSB = BSB.char7};instance ShowBSB String where { {-# INLINE showBSB #-}; showBSB = BSB.string8};instance ShowBSB BS.ByteString where { {-# INLINE showBSB #-}; showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { {-# INLINE showBSB #-}; showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { {-# INLINE showBSB #-}; showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};instance (ShowBSB a, ShowBSB b, ShowBSB c, ShowBSB d) => ShowBSB (a, b, c, d) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c, !d) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c <> BSB.string7 " " <> showBSB d};{-# INLINE showLnBSB #-};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;{-# INLINE printBSB #-};printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;{-# INLINE concatBSB #-};concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;{-# INLINE intersperseBSB #-};intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB = intersperseWithBSB showBSB;{-# INLINE intersperseWithBSB #-};intersperseWithBSB :: (G.Vector v a) => (a -> BSB.Builder) -> BSB.Builder -> v a -> BSB.Builder;intersperseWithBSB showF del vec | G.null vec = mempty | otherwise = showF (G.head vec) <> G.foldMap ((del <>) . showF) (G.tail vec);{-# INLINE unwordsBSB #-};unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;{-# INLINE unlinesBSB #-};unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;{-# INLINE yn #-};yn :: Bool -> String;yn = bool "No" "Yes";{-# INLINE ynBSB #-};ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");{-# INLINE printYn #-};printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;{-# INLINE printList #-};printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;{-# INLINE putList #-};putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;{-# INLINE printVec #-};printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;{-# INLINE putVec #-};putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();dbgM :: (Monad m, Show a) => m a -> m ();dbgM m | debug = do { !s <- m; let { !_ = traceShow s ()}; return ()} | otherwise = return ();dbgS :: String -> ();dbgS s | debug = let { !_ = trace s ()} in () | otherwise = ();dbgSM :: (Monad m) => m String -> m ();dbgSM m | debug = do { !s <- m; let { !_ = trace s ()}; return ()} | otherwise = return ();dbgId :: (Show a) => a -> a;dbgId x | debug = let { !_ = traceShow x ()} in x | otherwise = x;note :: (Show s, Show a) => s -> a -> a;note s x | debug = let { !_ = trace (show s ++ ": " ++ show x) ()} in x | otherwise = x;dbgAssert :: Bool -> String -> ();dbgAssert b s | debug && not b = error $ "assertion failed!: " ++ s | otherwise = ();($$) :: (Show a) => (a -> b) -> a -> b;($$) lhs rhs = lhs (dbgId rhs);infixr 0 $$;(.$) :: (Show b) => (b -> c) -> (a -> b) -> a -> c;g .$ f = \ a -> let { !b = dbgId (f a)} in g b;infixr 9 .$;dbgVec :: (Show (v a), G.Vector v a, PrimMonad m) => (G.Mutable v) (PrimState m) a -> m ();dbgVec vec | debug = do { !xs' <- G.unsafeFreeze vec; let { !_ = dbg xs'}; return ()} | otherwise = return ();data SegmentTree s a = SegmentTree{unSegmentTree :: !(UM.MVector s a), nValidLeavesSegmentTree :: {-# UNPACK #-} !Int};newSTree :: (U.Unbox a, Monoid a, PrimMonad m) => Int -> m (SegmentTree (PrimState m) a);newSTree nValidLeaves = do { vec <- GM.replicate nVerts mempty; return $ SegmentTree vec nValidLeaves} where { !nVerts = until (>= (nValidLeaves .<<. 1)) (.<<. 1) (1 :: Int)};buildSTree :: (U.Unbox a, Monoid a, PrimMonad m) => U.Vector a -> m (SegmentTree (PrimState m) a);buildSTree leaves = do { verts <- GM.unsafeNew nVerts; G.unsafeCopy (GM.unsafeSlice nLeaves (G.length leaves) verts) leaves; forM_ [U.length leaves .. nLeaves - 1] $ \ i -> GM.write verts (nLeaves + i) mempty; forM_ [nLeaves - 1, nLeaves - 2 .. 1] $ \ i -> do { !x' <- (<>) <$> GM.unsafeRead verts (i .<<. 1) <*> GM.unsafeRead verts ((i .<<. 1) .|. 1); GM.unsafeWrite verts i x'}; return $ SegmentTree verts nValidLeaves} where { !nValidLeaves = G.length leaves; !nVerts = until (>= (nValidLeaves .<<. 1)) (.<<. 1) (1 :: Int); !nLeaves = nVerts .>>. 1};{-# INLINE readSTree #-};readSTree :: (HasCallStack, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> m a;readSTree (SegmentTree vec nValidLeaves) i = GM.unsafeRead vec (nLeaves + i) where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "readSTree: given invalid index: " ++ show i ++ " out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};_unsafeUpdateParentNodes :: (U.Unbox a, Monoid a, PrimMonad m) => UM.MVector (PrimState m) a -> Int -> m ();_unsafeUpdateParentNodes vec v0 = stToPrim $ do { flip fix (v0 .>>. 1) $ \ loop v -> do { !x' <- (<>) <$> GM.unsafeRead vec (v .<<. 1) <*> GM.unsafeRead vec ((v .<<. 1) .|. 1); GM.unsafeWrite vec v x'; when (v > 1) $ loop (v .>>. 1)}};{-# INLINE writeSTree #-};writeSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> a -> m ();writeSTree (SegmentTree vec nValidLeaves) i x = do { let { v0 = nLeaves + i}; GM.unsafeWrite vec v0 x; _unsafeUpdateParentNodes vec v0} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "writeSTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};{-# INLINE exchangeSTree #-};exchangeSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> a -> m a;exchangeSTree (SegmentTree vec nValidLeaves) i x = do { let { v0 = nLeaves + i}; !ret <- GM.unsafeExchange vec v0 x; _unsafeUpdateParentNodes vec v0; return ret} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "exchangeSTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};{-# INLINE modifySTree #-};modifySTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> (a -> a) -> Int -> m ();modifySTree (SegmentTree vec nValidLeaves) f i = do { let { v0 = nLeaves + i}; GM.unsafeModify vec f v0; _unsafeUpdateParentNodes vec v0} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "modifySTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};foldSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> m a;foldSTree (SegmentTree vec nValidLeaves) l0 r0 = stToPrim $ glitchFold (l0 + nLeaves) (r0 + nLeaves) mempty mempty where { !_ = dbgAssert (l0 <= r0 && inRange (0, nValidLeaves - 1) l0 && inRange (0, nValidLeaves - 1) r0) $ "foldSTree: given invalid range: " ++ show (l0, r0) ++ " is out of " ++ show nValidLeaves; !nLeaves = GM.length vec .>>. 1; glitchFold l r lx rx | l > r = return $! lx <> rx | otherwise = do { !lx' <- if testBit l 0 then (lx <>) <$> GM.unsafeRead vec l else return lx; !rx' <- if not (testBit r 0) then (<> rx) <$> GM.unsafeRead vec r else return rx; glitchFold ((l + 1) .>>. 1) ((r - 1) .>>. 1) lx' rx'}};{-# INLINE foldMaySTree #-};foldMaySTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> m (Maybe a);foldMaySTree stree@(SegmentTree vec _) l0 r0 | l0 > r0 || not (inRange (0, nLeaves - 1) l0) || not (inRange (0, nLeaves - 1) r0) = return Nothing | otherwise = Just <$> foldSTree stree l0 r0 where { nLeaves = GM.length vec .>>. 1};{-# INLINE foldAllSTree #-};foldAllSTree :: (HasCallStack, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m a;foldAllSTree (SegmentTree vec _) = GM.read vec 1;{-# INLINE bsearchSTree #-};bsearchSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int, Maybe Int);bsearchSTree stree@(SegmentTree _ nValidLeaves) l0 r0 f = do { let { !_ = dbgAssert (l0 <= r0 && inRange (0, nValidLeaves - 1) l0 && inRange (0, nValidLeaves - 1) l0) $ "bsearhSTree: wrong range " ++ show (l0, r0) ++ " for " ++ show nValidLeaves}; bisectM l0 r0 $ \ r -> do { x <- foldSTree stree l0 r; return $ f x}};{-# INLINE bsearchSTreeL #-};bsearchSTreeL :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bsearchSTreeL stree l0 r0 f = fst <$> bsearchSTree stree l0 r0 f;{-# INLINE bsearchSTreeR #-};bsearchSTreeR :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bsearchSTreeR stree l0 r0 f = snd <$> bsearchSTree stree l0 r0 f;{-# INLINE freezeLeavesSTree #-};freezeLeavesSTree :: (U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m (U.Vector a);freezeLeavesSTree (SegmentTree vec nLeaves) = do { G.take nLeaves . G.drop (GM.length vec `div` 2) <$> G.freeze vec};{-# INLINE unsafeFreezeLeavesSTree #-};unsafeFreezeLeavesSTree :: (U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m (U.Vector a);unsafeFreezeLeavesSTree (SegmentTree vec nLeaves) = do { G.take nLeaves . G.drop (GM.length vec `div` 2) <$> G.unsafeFreeze vec};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (HasCallStack, Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum U.! (r + 1) - csum U.! l where { _ | debug = let { n = U.length csum - 1; !_ = dbgAssert (inRange (0, n - 1) l && inRange (0, n - 1) r) $ "(+!) invalid range: " ++ show (l, r)} in () | otherwise = ()};{-# INLINE newCSumU #-};newCSumU :: (PrimMonad m, Num a, U.Unbox a) => Int -> m (UM.MVector (PrimState m) a);newCSumU n = UM.replicate (n + 1) 0;{-# INLINE readCSum #-};readCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> Int -> m a;readCSum vec l r = (-) <$> GM.read vec (r + 1) <*> GM.read vec l;{-# INLINE appendCSum #-};appendCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();appendCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;int' :: (MonadState BS.ByteString m) => m Int;int' = state $ fromJust . BS.readInt . BS.dropSpace;int1' :: (MonadState BS.ByteString m) => m Int;int1' = subtract 1 <$> int';char' :: (MonadState BS.ByteString m) => m Char;char' = state $ fromJust . BS.uncons . BS.dropSpace;word' :: (MonadState BS.ByteString m) => m BS.ByteString;word' = state $ BS.break isSpace . BS.dropSpace;double' :: (MonadState BS.ByteString m) => m Double;double' = read . BS.unpack <$> word';ints2' :: (MonadState BS.ByteString m) => m (Int, Int);ints2' = (,) <$> int' <*> int';ints11' :: (MonadState BS.ByteString m) => m (Int, Int);ints11' = (,) <$> int1' <*> int1';ints3' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3' = (,,) <$> int' <*> int' <*> int';ints110' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110' = (,,) <$> int1' <*> int1' <*> int';ints011' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints011' = (,,) <$> int' <*> int1' <*> int1';ints111' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111' = (,,) <$> int1' <*> int1' <*> int1';ints4' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4' = (,,,) <$> int' <*> int' <*> int' <*> int';ints5' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5' = (,,,,) <$> int' <*> int' <*> int' <*> int' <*> int';ints6' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6' = (,,,,,) <$> int' <*> int' <*> int' <*> int' <*> int' <*> int';line' :: (MonadState BS.ByteString m) => m BS.ByteString;line' = state $ BS.span (/= '\n') . BS.dropSpace;withLine' :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine' f = evalState f <$> line';ints' :: (MonadState BS.ByteString m) => m [Int];ints' = unfoldr (BS.readInt . BS.dropSpace) <$> line';intsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);intsU' = U.unfoldr (BS.readInt . BS.dropSpace) <$> line';intsN' :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsN' n = U.replicateM n int';digitsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsU' = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> line';{-# INLINE square #-};square :: (Num a) => a -> a;square !x = x * x;{-# INLINE isqrt #-};isqrt :: Int -> Int;isqrt = round @Double . sqrt . fromIntegral;{-# INLINE (.:) #-};(.:) :: (b -> c) -> (a1 -> a2 -> b) -> (a1 -> a2 -> c);(.:) = (.) . (.);{-# INLINE swapDupeU #-};swapDupeU :: U.Vector (Int, Int) -> U.Vector (Int, Int);swapDupeU = U.concatMap (\ (!u, !v) -> U.fromListN 2 [(u, v), (v, u)]);{-# INLINE swapDupeW #-};swapDupeW :: (U.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);swapDupeW = U.concatMap (\ (!u, !v, !d) -> U.fromListN 2 [(u, v, d), (v, u, d)]);{-# INLINE ortho4 #-};ortho4 :: U.Vector (Int, Int);ortho4 = U.fromList [(0, 1), (0, -1), (1, 0), (-1, 0)];{-# INLINE ortho4' #-};ortho4' :: ((Int, Int), (Int, Int)) -> (Int, Int) -> U.Vector (Int, Int);ortho4' bnd base = U.filter (inRange bnd) $ U.map (add2 base) ortho4;{-# INLINE orthoWith #-};orthoWith :: ((Int, Int), (Int, Int)) -> ((Int, Int) -> Bool) -> (Int -> U.Vector Int);orthoWith bnd p v1 = U.map (index bnd) . U.filter ((&&) <$> inRange bnd <*> p) $ U.map (add2 (unindex bnd v1)) ortho4;{-# INLINE diag4 #-};diag4 :: U.Vector (Int, Int);diag4 = U.fromList [(-1, 1), (1, 1), (1, -1), (-1, -1)];{-# INLINE slice #-};slice :: (G.Vector v a) => Int -> Int -> v a -> v a;slice !l !r !vec = G.slice l (max 0 (r - l + 1)) vec;{-# INLINE zero2 #-};zero2 :: Int -> Int -> ((Int, Int), (Int, Int));zero2 n1 n2 = ((0, 0), (n1 - 1, n2 - 1));{-# INLINE zero3 #-};zero3 :: Int -> Int -> Int -> ((Int, Int, Int), (Int, Int, Int));zero3 n1 n2 n3 = ((0, 0, 0), (n1 - 1, n2 - 1, n3 - 1));{-# INLINE rangeG #-};rangeG :: (G.Vector v Int) => Int -> Int -> v Int;rangeG !i !j = G.enumFromN i (succ j - i);{-# INLINE rangeV #-};rangeV :: Int -> Int -> V.Vector Int;rangeV = rangeG;{-# INLINE rangeU #-};rangeU :: Int -> Int -> U.Vector Int;rangeU = rangeG;{-# INLINE rangeGR #-};rangeGR :: (G.Vector v Int) => Int -> Int -> v Int;rangeGR !i !j = G.enumFromStepN j (-1) (succ j - i);{-# INLINE rangeVR #-};rangeVR :: Int -> Int -> V.Vector Int;rangeVR = rangeGR;{-# INLINE rangeUR #-};rangeUR :: Int -> Int -> U.Vector Int;rangeUR = rangeGR;{-# INLINE times #-};times :: Int -> (a -> a) -> a -> a;times !n !f = inner 0 where { inner i !s | i >= n = s | otherwise = inner (i + 1) $! f s};interleave :: [a] -> [a] -> [a];interleave xs [] = xs; interleave [] ys = ys; interleave (x : xs) (y : ys) = x : y : interleave xs ys;combs :: Int -> [a] -> [[a]];combs _ [] = []; combs k as@(!(_ : xs)) | k == 0 = [[]] | k == 1 = map pure as | k == l = pure as | k > l = [] | otherwise = run (l - 1) (k - 1) as $ combs (k - 1) xs where { l = length as; run :: Int -> Int -> [a] -> [[a]] -> [[a]]; run n k ys cs | n == k = map (ys ++) cs | otherwise = map (q :) cs ++ run (n - 1) k qs (drop dc cs) where { (!(q : qs)) = take (n - k + 1) ys; dc = product [(n - k + 1) .. (n - 1)] `div` product [1 .. (k - 1)]}};{-# INLINE swapDupe #-};swapDupe :: (a, a) -> [(a, a)];swapDupe (!x1, !x2) = [(x1, x2), (x2, x1)];{-# INLINE add2 #-};add2 :: (Int, Int) -> (Int, Int) -> (Int, Int);add2 (!y, !x) = bimap (y +) (x +);{-# INLINE sub2 #-};sub2 :: (Int, Int) -> (Int, Int) -> (Int, Int);sub2 (!y, !x) = bimap (y -) (x -);{-# INLINE mul2 #-};mul2 :: Int -> (Int, Int) -> (Int, Int);mul2 !m = both (m *);{-# INLINE add3 #-};add3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);add3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 + z2, y1 + y2, x1 + x2);{-# INLINE sub3 #-};sub3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);sub3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE mul3 #-};mul3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);mul3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE toRadian #-};toRadian :: Double -> Double;toRadian degree = degree / 180.0 * pi;{-# INLINE toDegree #-};toDegree :: Double -> Double;toDegree rad = rad / pi * 180.0;{-# INLINE fst4 #-};fst4 :: (a, b, c, d) -> a;fst4 (!a, !_, !_, !_) = a;{-# INLINE snd4 #-};snd4 :: (a, b, c, d) -> b;snd4 (!_, !b, !_, !_) = b;{-# INLINE thd4 #-};thd4 :: (a, b, c, d) -> c;thd4 (!_, !_, !c, !_) = c;{-# INLINE fth4 #-};fth4 :: (a, b, c, d) -> d;fth4 (!_, !_, !_, !d) = d;{-# INLINE first4 #-};first4 :: (a -> x) -> (a, b, c, d) -> (x, b, c, d);first4 f (!a, !b, !c, !d) = (f a, b, c, d);{-# INLINE second4 #-};second4 :: (b -> x) -> (a, b, c, d) -> (a, x, c, d);second4 f (!a, !b, !c, !d) = (a, f b, c, d);{-# INLINE third4 #-};third4 :: (c -> x) -> (a, b, c, d) -> (a, b, x, d);third4 f (!a, !b, !c, !d) = (a, b, f c, d);{-# INLINE fourth4 #-};fourth4 :: (d -> x) -> (a, b, c, d) -> (a, b, c, x);fourth4 f (!a, !b, !c, !d) = (a, b, c, f d);fix1 :: a -> ((a -> b) -> a -> b) -> b;fix1 a f = fix f a;fix2 :: a -> b -> ((a -> b -> c) -> a -> b -> c) -> c;fix2 a b f = fix f a b;fix3 :: a -> b -> c -> ((a -> b -> c -> d) -> a -> b -> c -> d) -> d;fix3 a b c f = fix f a b c;
{-# RULES "Force inline VAI.sort" VAI.sort = VAI.sortBy compare #-}
#ifdef DEBUG
debug :: Bool ; debug = True
#else
debug :: Bool ; debug = False
#endif
{- ORMOLU_ENABLE -}
solve :: StateT BS.ByteString IO ()
solve = do
!n <- int'
!hs <- intsU'
-- stree <- buildSTree $ U.replicate (2 ^ 10 ^ 5 + 1 :: Int) (mempty @Max)
stree <- buildSTree $ U.map Max hs
imos <- UM.replicate (n + 1) (0 :: Int)
forM_ [1 .. n - 1] $ \r -> do
let !xr = hs G.! r
l <- fmap (maybe xr (r -)) $ bisectML 0 r $ \di -> do
let !l = r - di
Max x <- foldSTree stree l r
return $ x <= xr
let !_ = dbg (r, (l, r))
-- +1 to [l .. r)
let !l' = max 0 $ l - 1
UM.modify imos (+ 1) l'
UM.modify imos (subtract 1) r
res <- U.init . U.scanl1' (+) <$> U.unsafeFreeze imos
printVec res
-- verification-helper: PROBLEM https://atcoder.jp/contests/abc372/tasks/abc372_d
main :: IO ()
main = runIO solve
Submission Info
| Submission Time |
|
| Task |
D - Buildings |
| User |
toyboot4e |
| Language |
Haskell (GHC 9.4.5) |
| Score |
400 |
| Code Size |
28943 Byte |
| Status |
AC |
| Exec Time |
301 ms |
| Memory |
24580 KiB |
Compile Error
app/Main.hs:6:16800: warning: [-Wunused-local-binds]
Defined but not used: ‘n’
|
6 | class (Ix i, U.Unbox i) => Unindex i where { unindex :: (i, i) -> Int -> i};instance Unindex Int where { {-# INLINE unindex #-}; unindex _ !v = v};instance Unindex (Int, Int) where { {-# INLINE unindex #-}; unindex ((!y0, !x0), (!_, !x1)) !yx = let { !w = x1 - x0 + 1; (!dy, !dx) = yx `quotRem` w} in (y0 + dy, x0 + dx)};instance Unindex (Int, Int, Int) where { {-# INLINE unindex #-}; unindex ((!z0, !y0, !x0), (!_, !y1, !x1)) !zyx = let { !h = y1 - y0 + 1; !w = x1 - x0 + 1; (!dz, !yx) = zyx `quotRem` (h * w); (!dy, !dx) = yx `quotRem` w} in (z0 + dz, y0 + dy, x0 + dx)};instance Unindex (Int, Int, Int, Int) where { {-# INLINE unindex #-}; unindex ((!b3, !b2, !b1, !b0), (!_, !x2, !x1, !x0)) !pos3 = let { !w2 = x2 - b2 + 1; !w1 = x1 - b1 + 1; !w0 = x0 - b0 + 1; (!y3, !pos2) = pos3 `quotRem` (w2 * w1 * w0); (!y2, !pos1) = pos2 `quotRem` (w1 * w0); (!y1, !y0) = pos1 `quotRem` w0} in (b3 + y3, b2 + y2, b1 + y1, b0 + y0)};instance Unindex ((Int, Int), (Int, Int)) where { {-# INLINE unindex #-}; unindex (((!b3, !b2), (!b1, !b0)), ((!_, !x2), (!x1, !x0))) !pos3 = let { !w2 = x2 - b2 + 1; !w1 = x1 - b1 + 1; !w0 = x0 - b0 + 1; (!y3, !pos2) = pos3 `quotRem` (w2 * w1 * w0); (!y2, !pos1) = pos2 `quotRem` (w1 * w0); (!y1, !y0) = pos1 `quotRem` w0} in ((b3 + y3, b2 + y2), (b1 + y1, b0 + y0))};bisectImpl :: forall i m . (Eq i, Monad m) => (i -> i -> Maybe i) -> i -> i -> i -> i -> (i -> m Bool) -> m (Maybe i, Maybe i);bisectImpl getMid l0 r0 lowOut highOut p = done <$> inner lowOut highOut where { done :: (i, i) -> (Maybe i, Maybe i); done (!l, !r) | l == lowOut = (Nothing, Just l0) | r == highOut = (Just r0, Nothing) | otherwise = (Just l, Just r); inner :: i -> i -> m (i, i); inner !y !n | Just m <- getMid y n = p m >>= \case { True -> inner m n; False -> inner y m} | otherwise = return (y, n)};getMidInt :: Int -> Int -> Maybe Int;getMidInt l r | abs (r - l) == 1 = Nothing | otherwise = Just $ (l + r) `div` 2;getMidDouble :: Double -> Double -> Double -> Maybe Double;getMidDouble eps l r | abs (r - l) < eps = Nothing | otherwise = Just $ (l + r) / 2;{-# INLINE bisectM #-};bisectM :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int, Maybe Int);bisectM !l !r !p | l <= r = bisectImpl getMidInt l r (l - 1) (r + 1) p | otherwise = bisectImpl getMidInt l r (l + 1) (r - 1) p;{-# INLINE bisectML #-};bisectML :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectML !l !r !p = fst <$> bisectM l r p;{-# INLINE bisectMR #-};bisectMR :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectMR !l !r !p = snd <$> bisectM l r p;{-# INLINE bisect #-};bisect :: Int -> Int -> (Int -> Bool) -> (Maybe Int, Maybe Int);bisect !l !r !p = runIdentity $ bisectM l r (return . p);{-# INLINE bisectL #-};bisectL :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectL !l !r !p = fst $! bisect l r p;{-# INLINE bisectR #-};bisectR :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectR !l !r !p = snd $! bisect l r p;{-# INLINE bisectMF64 #-};bisectMF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double, Maybe Double);bisectMF64 !eps !l !r !p | l <= r = bisectImpl (getMidDouble eps) l r (l - eps) (r + eps) p | otherwise = bisectImpl (getMidDouble eps) l r (l + eps) (r - eps) p;{-# INLINE bisectMLF64 #-};bisectMLF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double);bisectMLF64 !eps !l !r !p = fst <$> bisectMF64 eps l r p;{-# INLINE bisectMRF64 #-};bisectMRF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double);bisectMRF64 !eps !l !r !p = snd <$> bisectMF64 eps l r p;{-# INLINE bisectF64 #-};bisectF64 :: Double -> Double -> Double -> (Double -> Bool) -> (Maybe Double, Maybe Double);bisectF64 !eps !l !r !p = runIdentity $ bisectMF64 eps l r (return . p);{-# INLINE bisectLF64 #-};bisectLF64 :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectLF64 !eps !l !r !p = fst $! bisectF64 eps l r p;{-# INLINE bisectRF64 #-};bisectRF64 :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectRF64 !eps !l !r !p = snd $! bisectF64 eps l r p;{-# INLINE bsearchM #-};bsearchM :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int, Maybe Int);bsearchM !vec !p = bisectM 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchML #-};bsearchML :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int);bsearchML !vec !p = bisectML 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchMR #-};bsearchMR :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int);bsearchMR !vec !p = bisectMR 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchMExact #-};bsearchMExact :: (PrimMonad m, GM.MVector v a, Ord b) => v (PrimState m) a -> (a -> b) -> b -> m (Maybe Int);bsearchMExact !vec f !xref = bisectML 0 (GM.length vec - 1) (fmap ((<= xref) . f) . GM.read vec) >>= \case { Just !i -> do { !x <- f <$> GM.read vec i; if x == xref then return $ Just i else return Nothing}; _ -> return Nothing};{-# INLINE bsearch #-};bsearch :: (G.Vector v a) => v a -> (a -> Bool) -> (Maybe Int, Maybe Int);bsearch !vec !p = bisect 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchL #-};bsearchL :: (G.Vector v a) => v a -> (a -> Bool) -> Maybe Int;bsearchL !vec !p = bisectL 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchR #-};bsearchR :: (G.Vector v a) => v a -> (a -> Bool) -> Maybe Int;bsearchR !vec !p = bisectR 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchExact #-};bsearchExact :: (G.Vector v a, Ord b) => v a -> (a -> b) -> b -> Maybe Int;bsearchExact !vec f !xref = case bisectL 0 (G.length vec - 1) ((<= xref) . f . (vec G.!)) of { Just !x | f (vec G.! x) == xref -> Just x; _ -> Nothing};isqrtSlow :: Int -> Int;isqrtSlow n = fromJust $ bisectR 0 n ((< n) . (^ (2 :: Int)));{-# INLINE endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';{-# INLINE putBSB #-};putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;{-# INLINE putLnBSB #-};putLnBSB :: (MonadIO m) => BSB.Builder -> m ();putLnBSB = liftIO . BSB.hPutBuilder stdout . (<> endlBSB);{-# INLINE wsBSB #-};wsBSB :: BSB.Builder;wsBSB = BSB.char7 ' ';class ShowBSB a where { showBSB :: a -> BSB.Builder; {-# INLINE showBSB #-}; default showBSB :: (Show a) => a -> BSB.Builder; showBSB = BSB.string8 . show};instance ShowBSB Int where { {-# INLINE showBSB #-}; showBSB = BSB.intDec};instance ShowBSB Integer where { {-# INLINE showBSB #-}; showBSB = BSB.integerDec};instance ShowBSB Float where { {-# INLINE showBSB #-}; showBSB = BSB.floatDec};instance ShowBSB Double where { {-# INLINE showBSB #-}; showBSB = BSB.doubleDec};instance ShowBSB Char where { {-# INLINE showBSB #-}; showBSB = BSB.char7};instance ShowBSB String where { {-# INLINE showBSB #-}; showBSB = BSB.string8};instance ShowBSB BS.ByteString where { {-# INLINE showBSB #-}; showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { {-# INLINE showBSB #-}; showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { {-# INLINE showBSB #-}; showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};instance (ShowBSB a, ShowBSB b, ShowBSB c, ShowBSB d) => ShowBSB (a, b, c, d) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c, !d) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c <> BSB.string7 " " <> showBSB d};{-# INLINE showLnBSB #-};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;{-# INLINE printBSB #-};printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;{-# INLINE concatBSB #-};concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;{-# INLINE intersperseBSB #-};intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB = intersperseWithBSB showBSB;{-# INLINE intersperseWithBSB #-};intersperseWithBSB :: (G.Vector v a) => (a -> BSB.Builder) -> BSB.Builder -> v a -> BSB.Builder;intersperseWithBSB showF del vec | G.null vec = mempty | otherwise = showF (G.head vec) <> G.foldMap ((del <>) . showF) (G.tail vec);{-# INLINE unwordsBSB #-};unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;{-# INLINE unlinesBSB #-};unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;{-# INLINE yn #-};yn :: Bool -> String;yn = bool "No" "Yes";{-# INLINE ynBSB #-};ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");{-# INLINE printYn #-};printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;{-# INLINE printList #-};printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;{-# INLINE putList #-};putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;{-# INLINE printVec #-};printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;{-# INLINE putVec #-};putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();dbgM :: (Monad m, Show a) => m a -> m ();dbgM m | debug = do { !s <- m; let { !_ = traceShow s ()}; return ()} | otherwise = return ();dbgS :: String -> ();dbgS s | debug = let { !_ = trace s ()} in () | otherwise = ();dbgSM :: (Monad m) => m String -> m ();dbgSM m | debug = do { !s <- m; let { !_ = trace s ()}; return ()} | otherwise = return ();dbgId :: (Show a) => a -> a;dbgId x | debug = let { !_ = traceShow x ()} in x | otherwise = x;note :: (Show s, Show a) => s -> a -> a;note s x | debug = let { !_ = trace (show s ++ ": " ++ show x) ()} in x | otherwise = x;dbgAssert :: Bool -> String -> ();dbgAssert b s | debug && not b = error $ "assertion failed!: " ++ s | otherwise = ();($$) :: (Show a) => (a -> b) -> a -> b;($$) lhs rhs = lhs (dbgId rhs);infixr 0 $$;(.$) :: (Show b) => (b -> c) -> (a -> b) -> a -> c;g .$ f = \ a -> let { !b = dbgId (f a)} in g b;infixr 9 .$;dbgVec :: (Show (v a), G.Vector v a, PrimMonad m) => (G.Mutable v) (PrimState m) a -> m ();dbgVec vec | debug = do { !xs' <- G.unsafeFreeze vec; let { !_ = dbg xs'}; return ()} | otherwise = return ();data SegmentTree s a = SegmentTree{unSegmentTree :: !(UM.MVector s a), nValidLeavesSegmentTree :: {-# UNPACK #-} !Int};newSTree :: (U.Unbox a, Monoid a, PrimMonad m) => Int -> m (SegmentTree (PrimState m) a);newSTree nValidLeaves = do { vec <- GM.replicate nVerts mempty; return $ SegmentTree vec nValidLeaves} where { !nVerts = until (>= (nValidLeaves .<<. 1)) (.<<. 1) (1 :: Int)};buildSTree :: (U.Unbox a, Monoid a, PrimMonad m) => U.Vector a -> m (SegmentTree (PrimState m) a);buildSTree leaves = do { verts <- GM.unsafeNew nVerts; G.unsafeCopy (GM.unsafeSlice nLeaves (G.length leaves) verts) leaves; forM_ [U.length leaves .. nLeaves - 1] $ \ i -> GM.write verts (nLeaves + i) mempty; forM_ [nLeaves - 1, nLeaves - 2 .. 1] $ \ i -> do { !x' <- (<>) <$> GM.unsafeRead verts (i .<<. 1) <*> GM.unsafeRead verts ((i .<<. 1) .|. 1); GM.unsafeWrite verts i x'}; return $ SegmentTree verts nValidLeaves} where { !nValidLeaves = G.length leaves; !nVerts = until (>= (nValidLeaves .<<. 1)) (.<<. 1) (1 :: Int); !nLeaves = nVerts .>>. 1};{-# INLINE readSTree #-};readSTree :: (HasCallStack, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> m a;readSTree (SegmentTree vec nValidLeaves) i = GM.unsafeRead vec (nLeaves + i) where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "readSTree: given invalid index: " ++ show i ++ " out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};_unsafeUpdateParentNodes :: (U.Unbox a, Monoid a, PrimMonad m) => UM.MVector (PrimState m) a -> Int -> m ();_unsafeUpdateParentNodes vec v0 = stToPrim $ do { flip fix (v0 .>>. 1) $ \ loop v -> do { !x' <- (<>) <$> GM.unsafeRead vec (v .<<. 1) <*> GM.unsafeRead vec ((v .<<. 1) .|. 1); GM.unsafeWrite vec v x'; when (v > 1) $ loop (v .>>. 1)}};{-# INLINE writeSTree #-};writeSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> a -> m ();writeSTree (SegmentTree vec nValidLeaves) i x = do { let { v0 = nLeaves + i}; GM.unsafeWrite vec v0 x; _unsafeUpdateParentNodes vec v0} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "writeSTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};{-# INLINE exchangeSTree #-};exchangeSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> a -> m a;exchangeSTree (SegmentTree vec nValidLeaves) i x = do { let { v0 = nLeaves + i}; !ret <- GM.unsafeExchange vec v0 x; _unsafeUpdateParentNodes vec v0; return ret} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "exchangeSTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};{-# INLINE modifySTree #-};modifySTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> (a -> a) -> Int -> m ();modifySTree (SegmentTree vec nValidLeaves) f i = do { let { v0 = nLeaves + i}; GM.unsafeModify vec f v0; _unsafeUpdateParentNodes vec v0} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "modifySTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};foldSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> m a;foldSTree (SegmentTree vec nValidLeaves) l0 r0 = stToPrim $ glitchFold (l0 + nLeaves) (r0 + nLeaves) mempty mempty where { !_ = dbgAssert (l0 <= r0 && inRange (0, nValidLeaves - 1) l0 && inRange (0, nValidLeaves - 1) r0) $ "foldSTree: given invalid range: " ++ show (l0, r0) ++ " is out of " ++ show nValidLeaves; !nLeaves = GM.length vec .>>. 1; glitchFold l r lx rx | l > r = return $! lx <> rx | otherwise = do { !lx' <- if testBit l 0 then (lx <>) <$> GM.unsafeRead vec l else return lx; !rx' <- if not (testBit r 0) then (<> rx) <$> GM.unsafeRead vec r else return rx; glitchFold ((l + 1) .>>. 1) ((r - 1) .>>. 1) lx' rx'}};{-# INLINE foldMaySTree #-};foldMaySTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> m (Maybe a);foldMaySTree stree@(SegmentTree vec _) l0 r0 | l0 > r0 || not (inRange (0, nLeaves - 1) l0) || not (inRange (0, nLeaves - 1) r0) = return Nothing | otherwise = Just <$> foldSTree stree l0 r0 where { nLeaves = GM.length vec .>>. 1};{-# INLINE foldAllSTree #-};foldAllSTree :: (HasCallStack, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m a;foldAllSTree (SegmentTree vec _) = GM.read vec 1;{-# INLINE bsearchSTree #-};bsearchSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int, Maybe Int);bsearchSTree stree@(SegmentTree _ nValidLeaves) l0 r0 f = do { let { !_ = dbgAssert (l0 <= r0 && inRange (0, nValidLeaves - 1) l0 && inRange (0, nValidLeaves - 1) l0) $ "bsearhSTree: wrong range " ++ show (l0, r0) ++ " for " ++ show nValidLeaves}; bisectM l0 r0 $ \ r -> do { x <- foldSTree stree l0 r; return $ f x}};{-# INLINE bsearchSTreeL #-};bsearchSTreeL :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bsearchSTreeL stree l0 r0 f = fst <$> bsearchSTree stree l0 r0 f;{-# INLINE bsearchSTreeR #-};bsearchSTreeR :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bsearchSTreeR stree l0 r0 f = snd <$> bsearchSTree stree l0 r0 f;{-# INLINE freezeLeavesSTree #-};freezeLeavesSTree :: (U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m (U.Vector a);freezeLeavesSTree (SegmentTree vec nLeaves) = do { G.take nLeaves . G.drop (GM.length vec `div` 2) <$> G.freeze vec};{-# INLINE unsafeFreezeLeavesSTree #-};unsafeFreezeLeavesSTree :: (U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m (U.Vector a);unsafeFreezeLeavesSTree (SegmentTree vec nLeaves) = do { G.take nLeaves . G.drop (GM.length vec `div` 2) <$> G.unsafeFreeze vec};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (HasCallStack, Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum U.! (r + 1) - csum U.! l where { _ | debug = let { n = U.length csum - 1; !_ = dbgAssert (inRange (0, n - 1) l && inRange (0, n - 1) r) $ "(+!) invalid range: " ++ show (l, r)} in () | otherwise = ()};{-# INLINE newCSumU #-};newCSumU :: (PrimMonad m, Num a, U.Unbox a) => Int -> m (UM.MVector (PrimState m) a);newCSumU n = UM.replicate (n + 1) 0;{-# INLINE readCSum #-};readCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> Int -> m a;readCSum vec l r = (-) <$> GM.read vec (r + 1) <*> GM.read vec l;{-# INLINE appendCSum #-};appendCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();appendCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;int' :: (MonadState BS.ByteString m) => m Int;int' = state $ fromJust . BS.readInt . BS.dropSpace;int1' :: (MonadState BS.ByteString m) => m Int;int1' = subtract 1 <$> int';char' :: (MonadState BS.ByteString m) => m Char;char' = state $ fromJust . BS.uncons . BS.dropSpace;word' :: (MonadState BS.ByteString m) => m BS.ByteString;word' = state $ BS.break isSpace . BS.dropSpace;double' :: (MonadState BS.ByteString m) => m Double;double' = read . BS.unpack <$> word';ints2' :: (MonadState BS.ByteString m) => m (Int, Int);ints2' = (,) <$> int' <*> int';ints11' :: (MonadState BS.ByteString m) => m (Int, Int);ints11' = (,) <$> int1' <*> int1';ints3' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3' = (,,) <$> int' <*> int' <*> int';ints110' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110' = (,,) <$> int1' <*> int1' <*> int';ints011' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints011' = (,,) <$> int' <*> int1' <*> int1';ints111' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111' = (,,) <$> int1' <*> int1' <*> int1';ints4' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4' = (,,,) <$> int' <*> int' <*> int' <*> int';ints5' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5' = (,,,,) <$> int' <*> int' <*> int' <*> int' <*> int';ints6' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6' = (,,,,,) <$> int' <*> int' <*> int' <*> int' <*> int' <*> int';line' :: (MonadState BS.ByteString m) => m BS.ByteString;line' = state $ BS.span (/= '\n') . BS.dropSpace;withLine' :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine' f = evalState f <$> line';ints' :: (MonadState BS.ByteString m) => m [Int];ints' = unfoldr (BS.readInt . BS.dropSpace) <$> line';intsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);intsU' = U.unfoldr (BS.readInt . BS.dropSpace) <$> line';intsN' :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsN' n = U.replicateM n int';digitsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsU' = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> line';{-# INLINE square #-};square :: (Num a) => a -> a;square !x = x * x;{-# INLINE isqrt #-};isqrt :: Int -> Int;isqrt = round @Double . sqrt . fromIntegral;{-# INLINE (.:) #-};(.:) :: (b -> c) -> (a1 -> a2 -> b) -> (a1 -> a2 -> c);(.:) = (.) . (.);{-# INLINE swapDupeU #-};swapDupeU :: U.Vector (Int, Int) -> U.Vector (Int, Int);swapDupeU = U.concatMap (\ (!u, !v) -> U.fromListN 2 [(u, v), (v, u)]);{-# INLINE swapDupeW #-};swapDupeW :: (U.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);swapDupeW = U.concatMap (\ (!u, !v, !d) -> U.fromListN 2 [(u, v, d), (v, u, d)]);{-# INLINE ortho4 #-};ortho4 :: U.Vector (Int, Int);ortho4 = U.fromList [(0, 1), (0, -1), (1, 0), (-1, 0)];{-# INLINE ortho4' #-};ortho4' :: ((Int, Int), (Int, Int)) -> (Int, Int) -> U.Vector (Int, Int);ortho4' bnd base = U.filter (inRange bnd) $ U.map (add2 base) ortho4;{-# INLINE orthoWith #-};orthoWith :: ((Int, Int), (Int, Int)) -> ((Int, Int) -> Bool) -> (Int -> U.Vector Int);orthoWith bnd p v1 = U.map (index bnd) . U.filter ((&&) <$> inRange bnd <*> p) $ U.map (add2 (unindex bnd v1)) ortho4;{-# INLINE diag4 #-};diag4 :: U.Vector (Int, Int);diag4 = U.fromList [(-1, 1), (1, 1), (1, -1), (-1, -1)];{-# INLINE slice #-};slice :: (G.Vector v a) => Int -> Int -> v a -> v a;slice !l !r !vec = G.slice l (max 0 (r - l + 1)) vec;{-# INLINE zero2 #-};zero2 :: Int -> Int -> ((Int, Int), (Int, Int));zero2 n1 n2 = ((0, 0), (n1 - 1, n2 - 1));{-# INLINE zero3 #-};zero3 :: Int -> Int -> Int -> ((Int, Int, Int), (Int, Int, Int));zero3 n1 n2 n3 = ((0, 0, 0), (n1 - 1, n2 - 1, n3 - 1));{-# INLINE rangeG #-};rangeG :: (G.Vector v Int) => Int -> Int -> v Int;rangeG !i !j = G.enumFromN i (succ j - i);{-# INLINE rangeV #-};rangeV :: Int -> Int -> V.Vector Int;rangeV = rangeG;{-# INLINE rangeU #-};rangeU :: Int -> Int -> U.Vector Int;rangeU = rangeG;{-# INLINE rangeGR #-};rangeGR :: (G.Vector v Int) => Int -> Int -> v Int;rangeGR !i !j = G.enumFromStepN j (-1) (succ j - i);{-# INLINE rangeVR #-};rangeVR :: Int -> Int -> V.Vector Int;rangeVR = rangeGR;{-# INLINE rangeUR #-};rangeUR :: Int -> Int -> U.Vector Int;rangeUR = rangeGR;{-# INLINE times #-};times :: Int -> (a -> a) -> a -> a;times !n !f = inner 0 where { inner i !s | i >= n = s | otherwise = inner (i + 1) $! f s};interleave :: [a] -> [a] -> [a];interleave xs [] = xs; interleave [] ys = ys; interleave (x : xs) (y : ys) = x : y : interleave xs ys;combs :: Int -> [a] -> [[a]];combs _ [] = []; combs k as@(!(_ : xs)) | k == 0 = [[]] | k == 1 = map pure as | k == l = pure as | k > l = [] | otherwise = run (l - 1) (k - 1) as $ combs (k - 1) xs where { l = length as; run :: Int -> Int -> [a] -> [[a]] -> [[a]]; run n k ys cs | n == k = map (ys ++) cs | otherwise = map (q :) cs ++ run (n - 1) k qs (drop dc cs) where { (!(q : qs)) = take (n - k + 1) ys; dc = product [(n - k + 1) .. (n - 1)] `div` product [1 .. (k - 1)]}};{-# INLINE swapDupe #-};swapDupe :: (a, a) -> [(a, a)];swapDupe (!x1, !x2) = [(x1, x2), (x2, x1)];{-# INLINE add2 #-};add2 :: (Int, Int) -> (Int, Int) -> (Int, Int);add2 (!y, !x) = bimap (y +) (x +);{-# INLINE sub2 #-};sub2 :: (Int, Int) -> (Int, Int) -> (Int, Int);sub2 (!y, !x) = bimap (y -) (x -);{-# INLINE mul2 #-};mul2 :: Int -> (Int, Int) -> (Int, Int);mul2 !m = both (m *);{-# INLINE add3 #-};add3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);add3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 + z2, y1 + y2, x1 + x2);{-# INLINE sub3 #-};sub3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);sub3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE mul3 #-};mul3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);mul3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE toRadian #-};toRadian :: Double -> Double;toRadian degree = degree / 180.0 * pi;{-# INLINE toDegree #-};toDegree :: Double -> Double;toDegree rad = rad / pi * 180.0;{-# INLINE fst4 #-};fst4 :: (a, b, c, d) -> a;fst4 (!a, !_, !_, !_) = a;{-# INLINE snd4 #-};snd4 :: (a, b, c, d) -> b;snd4 (!_, !b, !_, !_) = b;{-# INLINE thd4 #-};thd4 :: (a, b, c, d) -> c;thd4 (!_, !_, !c, !_) = c;{-# INLINE fth4 #-};fth4 :: (a, b, c, d) -> d;fth4 (!_, !_, !_, !d) = d;{-# INLINE first4 #-};first4 :: (a -> x) -> (a, b, c, d) -> (x, b, c, d);first4 f (!a, !b, !c, !d) = (f a, b, c, d);{-# INLINE second4 #-};second4 :: (b -> x) -> (a, b, c, d) -> (a, x, c, d);second4 f (!a, !b, !c, !d) = (a, f b, c, d);{-# INLINE third4 #-};third4 :: (c -> x) -> (a, b, c, d) -> (a, b, x, d);third4 f (!a, !b, !c, !d) = (a, b, f c, d);{-# INLINE fourth4 #-};fourth4 :: (d -> x) -> (a, b, c, d) -> (a, b, c, x);fourth4 f (!a, !b, !c, !d) = (a, b, c, f d);fix1 :: a -> ((a -> b) -> a -> b) -> b;fix1 a f = fix f a;fix2 :: a -> b -> ((a -> b -> c) -> a -> b -> c) -> c;fix2 a b f = fix f a b;fix3 :: a -> b -> c -> ((a -> b -> c -> d) -> a -> b -> c -> d) -> d;fix3 a b c f = fix f a b c;
| ^
app/Main.hs:6:22456: warning: [-Wname-shadowing]
This binding for ‘k’ shadows the existing binding
bound at app/Main.hs:6:22239
|
6 | class (Ix i, U.Unbox i) => Unindex i where { unindex :: (i, i) -> Int -> i};instance Unindex Int where { {-# INLINE unindex #-}; unindex _ !v = v};instance Unindex (Int, Int) where { {-# INLINE unindex #-}; unindex ((!y0, !x0), (!_, !x1)) !yx = let { !w = x1 - x0 + 1; (!dy, !dx) = yx `quotRem` w} in (y0 + dy, x0 + dx)};instance Unindex (Int, Int, Int) where { {-# INLINE unindex #-}; unindex ((!z0, !y0, !x0), (!_, !y1, !x1)) !zyx = let { !h = y1 - y0 + 1; !w = x1 - x0 + 1; (!dz, !yx) = zyx `quotRem` (h * w); (!dy, !dx) = yx `quotRem` w} in (z0 + dz, y0 + dy, x0 + dx)};instance Unindex (Int, Int, Int, Int) where { {-# INLINE unindex #-}; unindex ((!b3, !b2, !b1, !b0), (!_, !x2, !x1, !x0)) !pos3 = let { !w2 = x2 - b2 + 1; !w1 = x1 - b1 + 1; !w0 = x0 - b0 + 1; (!y3, !pos2) = pos3 `quotRem` (w2 * w1 * w0); (!y2, !pos1) = pos2 `quotRem` (w1 * w0); (!y1, !y0) = pos1 `quotRem` w0} in (b3 + y3, b2 + y2, b1 + y1, b0 + y0)};instance Unindex ((Int, Int), (Int, Int)) where { {-# INLINE unindex #-}; unindex (((!b3, !b2), (!b1, !b0)), ((!_, !x2), (!x1, !x0))) !pos3 = let { !w2 = x2 - b2 + 1; !w1 = x1 - b1 + 1; !w0 = x0 - b0 + 1; (!y3, !pos2) = pos3 `quotRem` (w2 * w1 * w0); (!y2, !pos1) = pos2 `quotRem` (w1 * w0); (!y1, !y0) = pos1 `quotRem` w0} in ((b3 + y3, b2 + y2), (b1 + y1, b0 + y0))};bisectImpl :: forall i m . (Eq i, Monad m) => (i -> i -> Maybe i) -> i -> i -> i -> i -> (i -> m Bool) -> m (Maybe i, Maybe i);bisectImpl getMid l0 r0 lowOut highOut p = done <$> inner lowOut highOut where { done :: (i, i) -> (Maybe i, Maybe i); done (!l, !r) | l == lowOut = (Nothing, Just l0) | r == highOut = (Just r0, Nothing) | otherwise = (Just l, Just r); inner :: i -> i -> m (i, i); inner !y !n | Just m <- getMid y n = p m >>= \case { True -> inner m n; False -> inner y m} | otherwise = return (y, n)};getMidInt :: Int -> Int -> Maybe Int;getMidInt l r | abs (r - l) == 1 = Nothing | otherwise = Just $ (l + r) `div` 2;getMidDouble :: Double -> Double -> Double -> Maybe Double;getMidDouble eps l r | abs (r - l) < eps = Nothing | otherwise = Just $ (l + r) / 2;{-# INLINE bisectM #-};bisectM :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int, Maybe Int);bisectM !l !r !p | l <= r = bisectImpl getMidInt l r (l - 1) (r + 1) p | otherwise = bisectImpl getMidInt l r (l + 1) (r - 1) p;{-# INLINE bisectML #-};bisectML :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectML !l !r !p = fst <$> bisectM l r p;{-# INLINE bisectMR #-};bisectMR :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectMR !l !r !p = snd <$> bisectM l r p;{-# INLINE bisect #-};bisect :: Int -> Int -> (Int -> Bool) -> (Maybe Int, Maybe Int);bisect !l !r !p = runIdentity $ bisectM l r (return . p);{-# INLINE bisectL #-};bisectL :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectL !l !r !p = fst $! bisect l r p;{-# INLINE bisectR #-};bisectR :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectR !l !r !p = snd $! bisect l r p;{-# INLINE bisectMF64 #-};bisectMF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double, Maybe Double);bisectMF64 !eps !l !r !p | l <= r = bisectImpl (getMidDouble eps) l r (l - eps) (r + eps) p | otherwise = bisectImpl (getMidDouble eps) l r (l + eps) (r - eps) p;{-# INLINE bisectMLF64 #-};bisectMLF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double);bisectMLF64 !eps !l !r !p = fst <$> bisectMF64 eps l r p;{-# INLINE bisectMRF64 #-};bisectMRF64 :: forall m . (Monad m) => Double -> Double -> Double -> (Double -> m Bool) -> m (Maybe Double);bisectMRF64 !eps !l !r !p = snd <$> bisectMF64 eps l r p;{-# INLINE bisectF64 #-};bisectF64 :: Double -> Double -> Double -> (Double -> Bool) -> (Maybe Double, Maybe Double);bisectF64 !eps !l !r !p = runIdentity $ bisectMF64 eps l r (return . p);{-# INLINE bisectLF64 #-};bisectLF64 :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectLF64 !eps !l !r !p = fst $! bisectF64 eps l r p;{-# INLINE bisectRF64 #-};bisectRF64 :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectRF64 !eps !l !r !p = snd $! bisectF64 eps l r p;{-# INLINE bsearchM #-};bsearchM :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int, Maybe Int);bsearchM !vec !p = bisectM 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchML #-};bsearchML :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int);bsearchML !vec !p = bisectML 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchMR #-};bsearchMR :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> (a -> Bool) -> m (Maybe Int);bsearchMR !vec !p = bisectMR 0 (GM.length vec - 1) (fmap p . GM.read vec);{-# INLINE bsearchMExact #-};bsearchMExact :: (PrimMonad m, GM.MVector v a, Ord b) => v (PrimState m) a -> (a -> b) -> b -> m (Maybe Int);bsearchMExact !vec f !xref = bisectML 0 (GM.length vec - 1) (fmap ((<= xref) . f) . GM.read vec) >>= \case { Just !i -> do { !x <- f <$> GM.read vec i; if x == xref then return $ Just i else return Nothing}; _ -> return Nothing};{-# INLINE bsearch #-};bsearch :: (G.Vector v a) => v a -> (a -> Bool) -> (Maybe Int, Maybe Int);bsearch !vec !p = bisect 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchL #-};bsearchL :: (G.Vector v a) => v a -> (a -> Bool) -> Maybe Int;bsearchL !vec !p = bisectL 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchR #-};bsearchR :: (G.Vector v a) => v a -> (a -> Bool) -> Maybe Int;bsearchR !vec !p = bisectR 0 (G.length vec - 1) (p . (vec G.!));{-# INLINE bsearchExact #-};bsearchExact :: (G.Vector v a, Ord b) => v a -> (a -> b) -> b -> Maybe Int;bsearchExact !vec f !xref = case bisectL 0 (G.length vec - 1) ((<= xref) . f . (vec G.!)) of { Just !x | f (vec G.! x) == xref -> Just x; _ -> Nothing};isqrtSlow :: Int -> Int;isqrtSlow n = fromJust $ bisectR 0 n ((< n) . (^ (2 :: Int)));{-# INLINE endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';{-# INLINE putBSB #-};putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;{-# INLINE putLnBSB #-};putLnBSB :: (MonadIO m) => BSB.Builder -> m ();putLnBSB = liftIO . BSB.hPutBuilder stdout . (<> endlBSB);{-# INLINE wsBSB #-};wsBSB :: BSB.Builder;wsBSB = BSB.char7 ' ';class ShowBSB a where { showBSB :: a -> BSB.Builder; {-# INLINE showBSB #-}; default showBSB :: (Show a) => a -> BSB.Builder; showBSB = BSB.string8 . show};instance ShowBSB Int where { {-# INLINE showBSB #-}; showBSB = BSB.intDec};instance ShowBSB Integer where { {-# INLINE showBSB #-}; showBSB = BSB.integerDec};instance ShowBSB Float where { {-# INLINE showBSB #-}; showBSB = BSB.floatDec};instance ShowBSB Double where { {-# INLINE showBSB #-}; showBSB = BSB.doubleDec};instance ShowBSB Char where { {-# INLINE showBSB #-}; showBSB = BSB.char7};instance ShowBSB String where { {-# INLINE showBSB #-}; showBSB = BSB.string8};instance ShowBSB BS.ByteString where { {-# INLINE showBSB #-}; showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { {-# INLINE showBSB #-}; showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { {-# INLINE showBSB #-}; showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};instance (ShowBSB a, ShowBSB b, ShowBSB c, ShowBSB d) => ShowBSB (a, b, c, d) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c, !d) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c <> BSB.string7 " " <> showBSB d};{-# INLINE showLnBSB #-};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;{-# INLINE printBSB #-};printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;{-# INLINE concatBSB #-};concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;{-# INLINE intersperseBSB #-};intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB = intersperseWithBSB showBSB;{-# INLINE intersperseWithBSB #-};intersperseWithBSB :: (G.Vector v a) => (a -> BSB.Builder) -> BSB.Builder -> v a -> BSB.Builder;intersperseWithBSB showF del vec | G.null vec = mempty | otherwise = showF (G.head vec) <> G.foldMap ((del <>) . showF) (G.tail vec);{-# INLINE unwordsBSB #-};unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;{-# INLINE unlinesBSB #-};unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;{-# INLINE yn #-};yn :: Bool -> String;yn = bool "No" "Yes";{-# INLINE ynBSB #-};ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");{-# INLINE printYn #-};printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;{-# INLINE printList #-};printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;{-# INLINE putList #-};putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;{-# INLINE printVec #-};printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;{-# INLINE putVec #-};putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();dbgM :: (Monad m, Show a) => m a -> m ();dbgM m | debug = do { !s <- m; let { !_ = traceShow s ()}; return ()} | otherwise = return ();dbgS :: String -> ();dbgS s | debug = let { !_ = trace s ()} in () | otherwise = ();dbgSM :: (Monad m) => m String -> m ();dbgSM m | debug = do { !s <- m; let { !_ = trace s ()}; return ()} | otherwise = return ();dbgId :: (Show a) => a -> a;dbgId x | debug = let { !_ = traceShow x ()} in x | otherwise = x;note :: (Show s, Show a) => s -> a -> a;note s x | debug = let { !_ = trace (show s ++ ": " ++ show x) ()} in x | otherwise = x;dbgAssert :: Bool -> String -> ();dbgAssert b s | debug && not b = error $ "assertion failed!: " ++ s | otherwise = ();($$) :: (Show a) => (a -> b) -> a -> b;($$) lhs rhs = lhs (dbgId rhs);infixr 0 $$;(.$) :: (Show b) => (b -> c) -> (a -> b) -> a -> c;g .$ f = \ a -> let { !b = dbgId (f a)} in g b;infixr 9 .$;dbgVec :: (Show (v a), G.Vector v a, PrimMonad m) => (G.Mutable v) (PrimState m) a -> m ();dbgVec vec | debug = do { !xs' <- G.unsafeFreeze vec; let { !_ = dbg xs'}; return ()} | otherwise = return ();data SegmentTree s a = SegmentTree{unSegmentTree :: !(UM.MVector s a), nValidLeavesSegmentTree :: {-# UNPACK #-} !Int};newSTree :: (U.Unbox a, Monoid a, PrimMonad m) => Int -> m (SegmentTree (PrimState m) a);newSTree nValidLeaves = do { vec <- GM.replicate nVerts mempty; return $ SegmentTree vec nValidLeaves} where { !nVerts = until (>= (nValidLeaves .<<. 1)) (.<<. 1) (1 :: Int)};buildSTree :: (U.Unbox a, Monoid a, PrimMonad m) => U.Vector a -> m (SegmentTree (PrimState m) a);buildSTree leaves = do { verts <- GM.unsafeNew nVerts; G.unsafeCopy (GM.unsafeSlice nLeaves (G.length leaves) verts) leaves; forM_ [U.length leaves .. nLeaves - 1] $ \ i -> GM.write verts (nLeaves + i) mempty; forM_ [nLeaves - 1, nLeaves - 2 .. 1] $ \ i -> do { !x' <- (<>) <$> GM.unsafeRead verts (i .<<. 1) <*> GM.unsafeRead verts ((i .<<. 1) .|. 1); GM.unsafeWrite verts i x'}; return $ SegmentTree verts nValidLeaves} where { !nValidLeaves = G.length leaves; !nVerts = until (>= (nValidLeaves .<<. 1)) (.<<. 1) (1 :: Int); !nLeaves = nVerts .>>. 1};{-# INLINE readSTree #-};readSTree :: (HasCallStack, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> m a;readSTree (SegmentTree vec nValidLeaves) i = GM.unsafeRead vec (nLeaves + i) where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "readSTree: given invalid index: " ++ show i ++ " out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};_unsafeUpdateParentNodes :: (U.Unbox a, Monoid a, PrimMonad m) => UM.MVector (PrimState m) a -> Int -> m ();_unsafeUpdateParentNodes vec v0 = stToPrim $ do { flip fix (v0 .>>. 1) $ \ loop v -> do { !x' <- (<>) <$> GM.unsafeRead vec (v .<<. 1) <*> GM.unsafeRead vec ((v .<<. 1) .|. 1); GM.unsafeWrite vec v x'; when (v > 1) $ loop (v .>>. 1)}};{-# INLINE writeSTree #-};writeSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> a -> m ();writeSTree (SegmentTree vec nValidLeaves) i x = do { let { v0 = nLeaves + i}; GM.unsafeWrite vec v0 x; _unsafeUpdateParentNodes vec v0} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "writeSTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};{-# INLINE exchangeSTree #-};exchangeSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> a -> m a;exchangeSTree (SegmentTree vec nValidLeaves) i x = do { let { v0 = nLeaves + i}; !ret <- GM.unsafeExchange vec v0 x; _unsafeUpdateParentNodes vec v0; return ret} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "exchangeSTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};{-# INLINE modifySTree #-};modifySTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> (a -> a) -> Int -> m ();modifySTree (SegmentTree vec nValidLeaves) f i = do { let { v0 = nLeaves + i}; GM.unsafeModify vec f v0; _unsafeUpdateParentNodes vec v0} where { !_ = dbgAssert (inRange (0, nValidLeaves - 1) i) $ "modifySTree: given invalid index: " ++ show i ++ " is out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};foldSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> m a;foldSTree (SegmentTree vec nValidLeaves) l0 r0 = stToPrim $ glitchFold (l0 + nLeaves) (r0 + nLeaves) mempty mempty where { !_ = dbgAssert (l0 <= r0 && inRange (0, nValidLeaves - 1) l0 && inRange (0, nValidLeaves - 1) r0) $ "foldSTree: given invalid range: " ++ show (l0, r0) ++ " is out of " ++ show nValidLeaves; !nLeaves = GM.length vec .>>. 1; glitchFold l r lx rx | l > r = return $! lx <> rx | otherwise = do { !lx' <- if testBit l 0 then (lx <>) <$> GM.unsafeRead vec l else return lx; !rx' <- if not (testBit r 0) then (<> rx) <$> GM.unsafeRead vec r else return rx; glitchFold ((l + 1) .>>. 1) ((r - 1) .>>. 1) lx' rx'}};{-# INLINE foldMaySTree #-};foldMaySTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> m (Maybe a);foldMaySTree stree@(SegmentTree vec _) l0 r0 | l0 > r0 || not (inRange (0, nLeaves - 1) l0) || not (inRange (0, nLeaves - 1) r0) = return Nothing | otherwise = Just <$> foldSTree stree l0 r0 where { nLeaves = GM.length vec .>>. 1};{-# INLINE foldAllSTree #-};foldAllSTree :: (HasCallStack, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m a;foldAllSTree (SegmentTree vec _) = GM.read vec 1;{-# INLINE bsearchSTree #-};bsearchSTree :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int, Maybe Int);bsearchSTree stree@(SegmentTree _ nValidLeaves) l0 r0 f = do { let { !_ = dbgAssert (l0 <= r0 && inRange (0, nValidLeaves - 1) l0 && inRange (0, nValidLeaves - 1) l0) $ "bsearhSTree: wrong range " ++ show (l0, r0) ++ " for " ++ show nValidLeaves}; bisectM l0 r0 $ \ r -> do { x <- foldSTree stree l0 r; return $ f x}};{-# INLINE bsearchSTreeL #-};bsearchSTreeL :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bsearchSTreeL stree l0 r0 f = fst <$> bsearchSTree stree l0 r0 f;{-# INLINE bsearchSTreeR #-};bsearchSTreeR :: (HasCallStack, Monoid a, U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bsearchSTreeR stree l0 r0 f = snd <$> bsearchSTree stree l0 r0 f;{-# INLINE freezeLeavesSTree #-};freezeLeavesSTree :: (U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m (U.Vector a);freezeLeavesSTree (SegmentTree vec nLeaves) = do { G.take nLeaves . G.drop (GM.length vec `div` 2) <$> G.freeze vec};{-# INLINE unsafeFreezeLeavesSTree #-};unsafeFreezeLeavesSTree :: (U.Unbox a, PrimMonad m) => SegmentTree (PrimState m) a -> m (U.Vector a);unsafeFreezeLeavesSTree (SegmentTree vec nLeaves) = do { G.take nLeaves . G.drop (GM.length vec `div` 2) <$> G.unsafeFreeze vec};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (HasCallStack, Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum U.! (r + 1) - csum U.! l where { _ | debug = let { n = U.length csum - 1; !_ = dbgAssert (inRange (0, n - 1) l && inRange (0, n - 1) r) $ "(+!) invalid range: " ++ show (l, r)} in () | otherwise = ()};{-# INLINE newCSumU #-};newCSumU :: (PrimMonad m, Num a, U.Unbox a) => Int -> m (UM.MVector (PrimState m) a);newCSumU n = UM.replicate (n + 1) 0;{-# INLINE readCSum #-};readCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> Int -> m a;readCSum vec l r = (-) <$> GM.read vec (r + 1) <*> GM.read vec l;{-# INLINE appendCSum #-};appendCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();appendCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;int' :: (MonadState BS.ByteString m) => m Int;int' = state $ fromJust . BS.readInt . BS.dropSpace;int1' :: (MonadState BS.ByteString m) => m Int;int1' = subtract 1 <$> int';char' :: (MonadState BS.ByteString m) => m Char;char' = state $ fromJust . BS.uncons . BS.dropSpace;word' :: (MonadState BS.ByteString m) => m BS.ByteString;word' = state $ BS.break isSpace . BS.dropSpace;double' :: (MonadState BS.ByteString m) => m Double;double' = read . BS.unpack <$> word';ints2' :: (MonadState BS.ByteString m) => m (Int, Int);ints2' = (,) <$> int' <*> int';ints11' :: (MonadState BS.ByteString m) => m (Int, Int);ints11' = (,) <$> int1' <*> int1';ints3' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3' = (,,) <$> int' <*> int' <*> int';ints110' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110' = (,,) <$> int1' <*> int1' <*> int';ints011' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints011' = (,,) <$> int' <*> int1' <*> int1';ints111' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111' = (,,) <$> int1' <*> int1' <*> int1';ints4' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4' = (,,,) <$> int' <*> int' <*> int' <*> int';ints5' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5' = (,,,,) <$> int' <*> int' <*> int' <*> int' <*> int';ints6' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6' = (,,,,,) <$> int' <*> int' <*> int' <*> int' <*> int' <*> int';line' :: (MonadState BS.ByteString m) => m BS.ByteString;line' = state $ BS.span (/= '\n') . BS.dropSpace;withLine' :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine' f = evalState f <$> line';ints' :: (MonadState BS.ByteString m) => m [Int];ints' = unfoldr (BS.readInt . BS.dropSpace) <$> line';intsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);intsU' = U.unfoldr (BS.readInt . BS.dropSpace) <$> line';intsN' :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsN' n = U.replicateM n int';digitsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsU' = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> line';{-# INLINE square #-};square :: (Num a) => a -> a;square !x = x * x;{-# INLINE isqrt #-};isqrt :: Int -> Int;isqrt = round @Double . sqrt . fromIntegral;{-# INLINE (.:) #-};(.:) :: (b -> c) -> (a1 -> a2 -> b) -> (a1 -> a2 -> c);(.:) = (.) . (.);{-# INLINE swapDupeU #-};swapDupeU :: U.Vector (Int, Int) -> U.Vector (Int, Int);swapDupeU = U.concatMap (\ (!u, !v) -> U.fromListN 2 [(u, v), (v, u)]);{-# INLINE swapDupeW #-};swapDupeW :: (U.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);swapDupeW = U.concatMap (\ (!u, !v, !d) -> U.fromListN 2 [(u, v, d), (v, u, d)]);{-# INLINE ortho4 #-};ortho4 :: U.Vector (Int, Int);ortho4 = U.fromList [(0, 1), (0, -1), (1, 0), (-1, 0)];{-# INLINE ortho4' #-};ortho4' :: ((Int, Int), (Int, Int)) -> (Int, Int) -> U.Vector (Int, Int);ortho4' bnd base = U.filter (inRange bnd) $ U.map (add2 base) ortho4;{-# INLINE orthoWith #-};orthoWith :: ((Int, Int), (Int, Int)) -> ((Int, Int) -> Bool) -> (Int -> U.Vector Int);orthoWith bnd p v1 = U.map (index bnd) . U.filter ((&&) <$> inRange bnd <*> p) $ U.map (add2 (unindex bnd v1)) ortho4;{-# INLINE diag4 #-};diag4 :: U.Vector (Int, Int);diag4 = U.fromList [(-1, 1), (1, 1), (1, -1), (-1, -1)];{-# INLINE slice #-};slice :: (G.Vector v a) => Int -> Int -> v a -> v a;slice !l !r !vec = G.slice l (max 0 (r - l + 1)) vec;{-# INLINE zero2 #-};zero2 :: Int -> Int -> ((Int, Int), (Int, Int));zero2 n1 n2 = ((0, 0), (n1 - 1, n2 - 1));{-# INLINE zero3 #-};zero3 :: Int -> Int -> Int -> ((Int, Int, Int), (Int, Int, Int));zero3 n1 n2 n3 = ((0, 0, 0), (n1 - 1, n2 - 1, n3 - 1));{-# INLINE rangeG #-};rangeG :: (G.Vector v Int) => Int -> Int -> v Int;rangeG !i !j = G.enumFromN i (succ j - i);{-# INLINE rangeV #-};rangeV :: Int -> Int -> V.Vector Int;rangeV = rangeG;{-# INLINE rangeU #-};rangeU :: Int -> Int -> U.Vector Int;rangeU = rangeG;{-# INLINE rangeGR #-};rangeGR :: (G.Vector v Int) => Int -> Int -> v Int;rangeGR !i !j = G.enumFromStepN j (-1) (succ j - i);{-# INLINE rangeVR #-};rangeVR :: Int -> Int -> V.Vector Int;rangeVR = rangeGR;{-# INLINE rangeUR #-};rangeUR :: Int -> Int -> U.Vector Int;rangeUR = rangeGR;{-# INLINE times #-};times :: Int -> (a -> a) -> a -> a;times !n !f = inner 0 where { inner i !s | i >= n = s | otherwise = inner (i + 1) $! f s};interleave :: [a] -> [a] -> [a];interleave xs [] = xs; interleave [] ys = ys; interleave (x : xs) (y : ys) = x : y : interleave xs ys;combs :: Int -> [a] -> [[a]];combs _ [] = []; combs k as@(!(_ : xs)) | k == 0 = [[]] | k == 1 = map pure as | k == l = pure as | k > l = [] | otherwise = run (l - 1) (k - 1) as $ combs (k - 1) xs where { l = length as; run :: Int -> Int -> [a] -> [[a]] -> [[a]]; run n k ys cs | n == k = map (ys ++) cs | otherwise = map (q :) cs ++ run (n - 1) k qs (drop dc cs) where { (!(q : qs)) = take (n - k + 1) ys; dc = product [(n - k + 1) .. (n - 1)] `div` product [1 .. (k - 1)]}};{-# INLINE swapDupe #-};swapDupe :: (a, a) -> [(a, a)];swapDupe (!x1, !x2) = [(x1, x2), (x2, x1)];{-# INLINE add2 #-};add2 :: (Int, Int) -> (Int, Int) -> (Int, Int);add2 (!y, !x) = bimap (y +) (x +);{-# INLINE sub2 #-};sub2 :: (Int, Int) -> (Int, Int) -> (Int, Int);sub2 (!y, !x) = bimap (y -) (x -);{-# INLINE mul2 #-};mul2 :: Int -> (Int, Int) -> (Int, Int);mul2 !m = both (m *);{-# INLINE add3 #-};add3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);add3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 + z2, y1 + y2, x1 + x2);{-# INLINE sub3 #-};sub3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);sub3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE mul3 #-};mul3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);mul3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE toRadian #-};toRadian :: Double -> Double;toRadian degree = degree / 180.0 * pi;{-# INLINE toDegree #-};toDegree :: Double -> Double;toDegree rad = rad / pi * 180.0;{-# INLINE fst4 #-};fst4 :: (a, b, c, d) -> a;fst4 (!a, !_, !_, !_) = a;{-# INLINE snd4 #-};snd4 :: (a, b, c, d) -> b;snd4 (!_, !b, !_, !_) = b;{-# INLINE thd4 #-};...
Judge Result
| Set Name |
Sample |
All |
| Score / Max Score |
0 / 0 |
400 / 400 |
| Status |
|
|
| Set Name |
Test Cases |
| Sample |
00_sample_00.txt, 00_sample_01.txt, 00_sample_02.txt |
| All |
00_sample_00.txt, 00_sample_01.txt, 00_sample_02.txt, 01_random_00.txt, 01_random_01.txt, 01_random_02.txt, 01_random_03.txt, 01_random_04.txt, 01_random_05.txt, 01_random_06.txt, 01_random_07.txt, 01_random_08.txt, 01_random_09.txt, 01_random_10.txt, 01_random_11.txt, 01_random_12.txt, 01_random_13.txt, 01_random_14.txt, 01_random_15.txt, 01_random_16.txt, 01_random_17.txt, 01_random_18.txt, 01_random_19.txt, 01_random_20.txt, 01_random_21.txt, 01_random_22.txt, 01_random_23.txt, 01_random_24.txt, 01_random_25.txt, 01_random_26.txt, 01_random_27.txt, 01_random_28.txt, 01_random_29.txt, 01_random_30.txt, 01_random_31.txt, 01_random_32.txt, 01_random_33.txt, 01_random_34.txt, 01_random_35.txt, 01_random_36.txt, 01_random_37.txt, 01_random_38.txt |
| Case Name |
Status |
Exec Time |
Memory |
| 00_sample_00.txt |
AC |
2 ms |
6908 KiB |
| 00_sample_01.txt |
AC |
2 ms |
6912 KiB |
| 00_sample_02.txt |
AC |
1 ms |
6876 KiB |
| 01_random_00.txt |
AC |
2 ms |
6908 KiB |
| 01_random_01.txt |
AC |
1 ms |
6932 KiB |
| 01_random_02.txt |
AC |
3 ms |
8208 KiB |
| 01_random_03.txt |
AC |
2 ms |
7276 KiB |
| 01_random_04.txt |
AC |
3 ms |
8056 KiB |
| 01_random_05.txt |
AC |
11 ms |
11732 KiB |
| 01_random_06.txt |
AC |
161 ms |
21472 KiB |
| 01_random_07.txt |
AC |
71 ms |
14452 KiB |
| 01_random_08.txt |
AC |
61 ms |
14464 KiB |
| 01_random_09.txt |
AC |
241 ms |
24284 KiB |
| 01_random_10.txt |
AC |
241 ms |
24580 KiB |
| 01_random_11.txt |
AC |
241 ms |
23004 KiB |
| 01_random_12.txt |
AC |
241 ms |
22980 KiB |
| 01_random_13.txt |
AC |
241 ms |
22996 KiB |
| 01_random_14.txt |
AC |
241 ms |
24556 KiB |
| 01_random_15.txt |
AC |
241 ms |
22892 KiB |
| 01_random_16.txt |
AC |
241 ms |
22972 KiB |
| 01_random_17.txt |
AC |
252 ms |
24348 KiB |
| 01_random_18.txt |
AC |
261 ms |
22960 KiB |
| 01_random_19.txt |
AC |
271 ms |
22764 KiB |
| 01_random_20.txt |
AC |
281 ms |
22936 KiB |
| 01_random_21.txt |
AC |
291 ms |
22996 KiB |
| 01_random_22.txt |
AC |
301 ms |
22900 KiB |
| 01_random_23.txt |
AC |
301 ms |
23028 KiB |
| 01_random_24.txt |
AC |
301 ms |
22976 KiB |
| 01_random_25.txt |
AC |
301 ms |
22968 KiB |
| 01_random_26.txt |
AC |
301 ms |
22976 KiB |
| 01_random_27.txt |
AC |
291 ms |
22904 KiB |
| 01_random_28.txt |
AC |
281 ms |
22976 KiB |
| 01_random_29.txt |
AC |
271 ms |
22892 KiB |
| 01_random_30.txt |
AC |
261 ms |
22980 KiB |
| 01_random_31.txt |
AC |
251 ms |
22776 KiB |
| 01_random_32.txt |
AC |
251 ms |
22964 KiB |
| 01_random_33.txt |
AC |
241 ms |
22912 KiB |
| 01_random_34.txt |
AC |
2 ms |
6944 KiB |
| 01_random_35.txt |
AC |
2 ms |
6908 KiB |
| 01_random_36.txt |
AC |
1 ms |
6844 KiB |
| 01_random_37.txt |
AC |
301 ms |
22768 KiB |
| 01_random_38.txt |
AC |
191 ms |
22892 KiB |