Submission #51461315 - 競プロ典型 90 問

Contest Duration: 2021-04-20 19:20:00+0900 - 5021-07-11 19:00:00+0900 (local time) Back to Home

Submission #51461315

Source Code Expand

#!/usr/bin/env stack
{- stack script --resolver lts-21.6 --package array --package bytestring --package containers --package deepseq --package extra --package hashable --package unordered-containers --package heaps --package mtl --package utility-ht --package vector --package vector-algorithms --package primitive --package QuickCheck --package random --package transformers --ghc-options "-D DEBUG" -}

-- {{{ toy-lib: https://github.com/toyboot4e/toy-lib
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds -Wno-orphans #-}
{- ORMOLU_DISABLE -}
{-# LANGUAGE BlockArguments, CPP, DataKinds, DefaultSignatures, DerivingVia, LambdaCase, MagicHash, MultiWayIf, NumDecimals, PatternSynonyms, QuantifiedConstraints, RecordWildCards, StandaloneDeriving, StrictData, TypeFamilies #-}
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.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 qualified Data.Ratio as 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 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.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
{-# RULES "Force inline VAI.sort" VAI.sort = VAI.sortBy compare #-}
#ifdef DEBUG
debug :: Bool ; debug = True
#else
debug :: Bool ; debug = False
#endif
type SparseUnionFind = IM.IntMap Int;newSUF :: SparseUnionFind;newSUF = IM.empty;memberSUF :: Int -> SparseUnionFind -> Bool;memberSUF = IM.member;insertSUF :: Int -> SparseUnionFind -> SparseUnionFind;insertSUF !x !uf = IM.insert x (-1) uf;fromListSUF :: [(Int, Int)] -> SparseUnionFind;fromListSUF = foldl' (\ uf (!i, !j) -> unifySUF i j uf) newSUF;fromVecSUF :: U.Vector (Int, Int) -> SparseUnionFind;fromVecSUF = U.foldl' (\ uf (!i, !j) -> unifySUF i j uf) newSUF;rootSUF :: (HasCallStack) => Int -> SparseUnionFind -> (Int, Int);rootSUF !i !uf | IM.notMember i uf = (i, 1) | j < 0 = (i, -j) | otherwise = rootSUF j uf where { j = uf IM.! i};sameSUF :: (HasCallStack) => Int -> Int -> SparseUnionFind -> Bool;sameSUF !i !j !uf = fst (rootSUF i uf) == fst (rootSUF j uf);unifySUF :: (HasCallStack) => Int -> Int -> SparseUnionFind -> SparseUnionFind;unifySUF !i !j !uf | a == b = uf | r >= s = IM.insert a (negate $! r + s) $ IM.insert b a uf | otherwise = IM.insert b (negate $! r + s) $ IM.insert a b uf where { (!a, !r) = rootSUF i uf; (!b, !s) = rootSUF j uf};newtype MUnionFind s = MUnionFind (UM.MVector s MUFNode);type IOUnionFind = MUnionFind RealWorld;type STUnionFind s = MUnionFind s;data MUFNode = MUFChild {-# UNPACK #-} !Int | MUFRoot {-# UNPACK #-} !Int deriving (Eq, Show);instance U.IsoUnbox MUFNode (Bool, Int) where { {-# INLINE toURepr #-}; toURepr (MUFChild !x) = (True, x); toURepr (MUFRoot !x) = (False, x); {-# INLINE fromURepr #-}; fromURepr (True, !x) = MUFChild x; fromURepr (False, !x) = MUFRoot x};newtype instance  U.MVector s MUFNode = MV_MUFNode (UM.MVector s (Bool, Int));newtype instance  U.Vector MUFNode = V_MUFNode (U.Vector (Bool, Int));deriving via (MUFNode `U.As` (Bool, Int)) instance GM.MVector UM.MVector MUFNode;deriving via (MUFNode `U.As` (Bool, Int)) instance G.Vector U.Vector MUFNode;instance U.Unbox MUFNode;{-# INLINE newMUF #-};newMUF :: (PrimMonad m) => Int -> m (MUnionFind (PrimState m));newMUF !n = MUnionFind <$> UM.replicate n (MUFRoot 1);{-# INLINE rootMUF #-};rootMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> m Int;rootMUF uf@(MUnionFind !vec) i = do { !node <- UM.unsafeRead vec i; case node of { MUFRoot _ -> return i; MUFChild p -> do { !r <- rootMUF uf p; UM.unsafeWrite vec i (MUFChild r); return r}}};{-# INLINE groupsMUF #-};groupsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m IS.IntSet;groupsMUF uf@(MUnionFind !vec) = foldM step IS.empty [0 .. pred (GM.length vec)] where { step !is !i = do { !root <- rootMUF uf i; return $ IS.insert root is}};{-# INLINE sameMUF #-};sameMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> Int -> m Bool;sameMUF !uf !x !y = liftM2 (==) (rootMUF uf x) (rootMUF uf y);_unwrapMUFRoot :: MUFNode -> Int;_unwrapMUFRoot (MUFRoot !s) = s; _unwrapMUFRoot (MUFChild !_) = error "tried to unwrap child as UF root";{-# INLINE unifyMUF #-};unifyMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> Int -> m Bool;unifyMUF uf@(MUnionFind !vec) !x !y = do { !px <- rootMUF uf x; !py <- rootMUF uf y; when (px /= py) $ do { !sx <- _unwrapMUFRoot <$> UM.unsafeRead vec px; !sy <- _unwrapMUFRoot <$> UM.unsafeRead vec py; let { (!par, !chld) = if sx < sy then (px, py) else (py, px)}; UM.unsafeWrite vec chld (MUFChild par); UM.unsafeWrite vec par (MUFRoot $! sx + sy)}; return $ px /= py};{-# INLINE unifyMUF_ #-};unifyMUF_ :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> Int -> m ();unifyMUF_ uf x y = void $ unifyMUF uf x y;{-# INLINE sizeMUF #-};sizeMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> m Int;sizeMUF uf@(MUnionFind !vec) !x = do { !px <- rootMUF uf x; _unwrapMUFRoot <$> UM.unsafeRead vec px};{-# INLINE clearMUF #-};clearMUF :: (PrimMonad m) => MUnionFind (PrimState m) -> m ();clearMUF (MUnionFind !vec) = do { UM.set vec (MUFRoot 1)};data PUnionFind s = DUnionFind{nodesPUF :: UM.MVector s MUFNode, potencialPUF :: UM.MVector s Int};newPUF :: (PrimMonad m) => Int -> m (PUnionFind (PrimState m));newPUF n = DUnionFind <$> UM.replicate n (MUFRoot 1) <*> UM.replicate n (0 :: Int);rootPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> m Int;rootPUF uf = inner where { inner v = UM.read (nodesPUF uf) v >>= \case { MUFRoot _ -> return v; MUFChild p -> do { !r <- inner p; when (p /= r) $ do { !pp <- UM.read (potencialPUF uf) p; UM.write (nodesPUF uf) v (MUFChild r); UM.modify (potencialPUF uf) (pp +) v}; return r}}};unifyPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> Int -> m Bool;unifyPUF !uf !v1 !v2 !dp = do { !r1 <- rootPUF uf v1; !r2 <- rootPUF uf v2; if r1 == r2 then return False else do { !size1 <- UM.read (potencialPUF uf) v1; !size2 <- UM.read (potencialPUF uf) v2; if size1 < size2 then unifyPUF uf v2 v1 (-dp) else do { !sz1 <- _unwrapMUFRoot <$> UM.read (nodesPUF uf) r1; !sz2 <- _unwrapMUFRoot <$> UM.read (nodesPUF uf) r2; UM.write (nodesPUF uf) r1 (MUFRoot (sz1 + sz2)); !p1 <- UM.read (potencialPUF uf) v1; !p2 <- UM.read (potencialPUF uf) v2; let { !pr2 = p1 - p2 - dp}; UM.write (nodesPUF uf) r2 (MUFChild r1); UM.write (potencialPUF uf) r2 pr2; return True}}};sizePUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> m Int;sizePUF !uf !v = fmap _unwrapMUFRoot . UM.read (nodesPUF uf) =<< rootPUF uf v;samePUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> m Bool;samePUF !uf !v1 !v2 = (==) <$> rootPUF uf v1 <*> rootPUF uf v2;canUnifyPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> Int -> m Bool;canUnifyPUF !uf !v1 !v2 !d = do { !r1 <- rootPUF uf v1; !r2 <- rootPUF uf v2; !p1 <- UM.read (potencialPUF uf) v1; !p2 <- UM.read (potencialPUF uf) v2; return $ r1 /= r2 || p1 - p2 == d};potPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> m Int;potPUF !uf !v1 = do { void $ rootPUF uf v1; UM.read (potencialPUF uf) v1};diffPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> m Int;diffPUF !uf !v1 !v2 = (-) <$> potPUF uf v1 <*> potPUF uf v2;clearPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> m ();clearPUF !uf = do { UM.set (potencialPUF uf) (0 :: Int); UM.set (nodesPUF uf) (MUFRoot 1)};class SemigroupAction s a where { sact :: s -> a -> a};instance (Semigroup a) => SemigroupAction a a where { sact x y = x <> y};class (SemigroupAction m a, Monoid m) => MonoidAction m a where { mact :: m -> a -> a; {-# INLINE mact #-}; mact = sact};class Semiring s where { (<+>) :: s -> s -> s; szero :: s; (<.>) :: s -> s -> s; sone :: s};foldP :: (Semiring a, G.Vector v a) => v a -> a;foldP = G.foldl' (<+>) szero;foldT :: (Semiring a, G.Vector v a) => v a -> a;foldT = G.foldl' (<.>) sone;newtype MaxPlus a = MaxPlus{getMaxPlus :: a} deriving (P.Prim)                                             deriving newtype (Eq, Ord, Show);newtype instance  U.MVector s (MaxPlus a) = MV_MaxPlus (P.MVector s (MaxPlus a));newtype instance  U.Vector (MaxPlus a) = V_MaxPlus (P.Vector (MaxPlus a));deriving via (U.UnboxViaPrim (MaxPlus a)) instance (P.Prim a) => GM.MVector UM.MVector (MaxPlus a);deriving via (U.UnboxViaPrim (MaxPlus a)) instance (P.Prim a) => G.Vector U.Vector (MaxPlus a);instance (P.Prim a) => U.Unbox (MaxPlus a);instance (Num a, Bounded a, Ord a) => Semiring (MaxPlus a) where { {-# INLINE (<+>) #-}; (MaxPlus x1) <+> (MaxPlus x2) = MaxPlus (x1 `max` x2); {-# INLINE szero #-}; szero = MaxPlus minBound; {-# INLINE (<.>) #-}; (MaxPlus x1) <.> (MaxPlus x2) = MaxPlus (x1 + x2); {-# INLINE sone #-}; sone = MaxPlus 0};newtype MinPlus a = MinPlus{getMinPlus :: a} deriving (P.Prim)                                             deriving newtype (Eq, Ord, Show);newtype instance  U.MVector s (MinPlus a) = MV_MinPlus (P.MVector s (MinPlus a));newtype instance  U.Vector (MinPlus a) = V_MinPlus (P.Vector (MinPlus a));deriving via (U.UnboxViaPrim (MinPlus a)) instance (P.Prim a) => GM.MVector UM.MVector (MinPlus a);deriving via (U.UnboxViaPrim (MinPlus a)) instance (P.Prim a) => G.Vector U.Vector (MinPlus a);instance (P.Prim a) => U.Unbox (MinPlus a);instance (Num a, Bounded a, Ord a) => Semiring (MinPlus a) where { {-# INLINE (<+>) #-}; (MinPlus x1) <+> (MinPlus x2) = MinPlus (x1 `min` x2); {-# INLINE szero #-}; szero = MinPlus maxBound; {-# INLINE (<.>) #-}; (MinPlus x1) <.> (MinPlus x2) = MinPlus (x1 + x2); {-# INLINE sone #-}; sone = MinPlus 0};newtype Boolean = Boolean{getBoolean :: Bool} deriving newtype (Eq, Ord, Show);instance U.IsoUnbox Boolean Bool where { {-# INLINE toURepr #-}; toURepr (Boolean b) = b; {-# INLINE fromURepr #-}; fromURepr = Boolean};newtype instance  U.MVector s Boolean = MV_Foo (U.MVector s Bool);newtype instance  U.Vector Boolean = V_Foo (U.Vector Bool);deriving via (Boolean `U.As` Bool) instance GM.MVector UM.MVector Boolean;deriving via (Boolean `U.As` Bool) instance G.Vector U.Vector Boolean;instance U.Unbox Boolean;instance Semiring Boolean where { {-# INLINE (<+>) #-}; (Boolean x1) <+> (Boolean x2) = Boolean (x1 || x2); {-# INLINE szero #-}; szero = Boolean False; {-# INLINE (<.>) #-}; (Boolean x1) <.> (Boolean x2) = Boolean (x1 && x2); {-# INLINE sone #-}; sone = Boolean True};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))};type Vertex = Int;type EdgeId = Int;newtype Mat2x2 a = Mat2x2 (Mat2x2Repr a) deriving newtype (Eq, Ord, Show);type Mat2x2Repr a = (a, a, a, a);{-# INLINE unMat2x2 #-};unMat2x2 :: Mat2x2 a -> Mat2x2Repr a;unMat2x2 (Mat2x2 x) = x;instance (Num a) => Semigroup (Mat2x2 a) where { {-# INLINE (<>) #-}; (<>) = mulM22M22};{-# INLINE mulM22M22 #-};mulM22M22 :: (Num a) => Mat2x2 a -> Mat2x2 a -> Mat2x2 a;mulM22M22 (Mat2x2 (!a11, !a12, !a21, !a22)) (Mat2x2 (!b11, !b12, !b21, !b22)) = Mat2x2 (c11, c12, c21, c22) where { !c11 = a11 * b11 + a12 * b21; !c12 = a11 * b12 + a12 * b22; !c21 = a21 * b11 + a22 * b21; !c22 = a21 * b12 + a22 * b22};instance (Num a) => Monoid (Mat2x2 a) where { {-# INLINE mempty #-}; mempty = Mat2x2 (1, 0, 0, 1)};instance (Num a) => SemigroupAction (Mat2x2 a) (V2 a) where { {-# INLINE sact #-}; sact = mulM22V2};{-# INLINE mulM22V2 #-};mulM22V2 :: (Num a) => Mat2x2 a -> V2 a -> V2 a;mulM22V2 (Mat2x2 (!a11, !a12, !a21, !a22)) (V2 (!x1, !x2)) = V2 (a11 * x1 + a12 * x2, a21 * x1 + a22 * x2);newtype V2 a = V2 (V2Repr a) deriving newtype (Eq, Ord, Show);type V2Repr a = (a, a);{-# INLINE unV2 #-};unV2 :: V2 a -> V2Repr a;unV2 (V2 x) = x;instance (Num a) => Semigroup (V2 a) where { {-# INLINE (<>) #-}; (V2 (!a1, !a2)) <> (V2 (!b1, !b2)) = V2 (a1 + b1, a2 + b2)};instance (Num a) => Monoid (V2 a) where { {-# INLINE mempty #-}; mempty = V2 (0, 0)};newtype instance  U.MVector s (Mat2x2 a) = MV_Mat2x2 (U.MVector s (Mat2x2Repr a));newtype instance  U.Vector (Mat2x2 a) = V_Mat2x2 (U.Vector (Mat2x2Repr a));deriving instance (U.Unbox a) => GM.MVector UM.MVector (Mat2x2 a);deriving instance (U.Unbox a) => G.Vector U.Vector (Mat2x2 a);instance (U.Unbox a) => U.Unbox (Mat2x2 a);newtype instance  U.MVector s (V2 a) = MV_V2 (U.MVector s (V2Repr a));newtype instance  U.Vector (V2 a) = V_V2 (U.Vector (V2Repr a));deriving instance (U.Unbox a) => GM.MVector UM.MVector (V2 a);deriving instance (U.Unbox a) => G.Vector U.Vector (V2 a);instance (U.Unbox a) => U.Unbox (V2 a);instance (Num a) => MonoidAction (Mat2x2 a) (V2 a);data A3 a = A3 !a !a !a deriving (Eq, Show);newtype instance  UM.MVector s (A3 a) = MV_A3 (UM.MVector s a);newtype instance  U.Vector (A3 a) = V_A3 (U.Vector a);instance (U.Unbox a) => U.Unbox (A3 a);instance (U.Unbox a) => GM.MVector UM.MVector (A3 a) where { basicLength (MV_A3 v) = GM.basicLength v `div` 3; {-# INLINE basicLength #-}; basicUnsafeSlice i n (MV_A3 v) = MV_A3 $ GM.basicUnsafeSlice (3 * i) (3 * n) v; {-# INLINE basicUnsafeSlice #-}; basicOverlaps (MV_A3 v1) (MV_A3 v2) = GM.basicOverlaps v1 v2; {-# INLINE basicOverlaps #-}; basicUnsafeNew n = MV_A3 `liftM` GM.basicUnsafeNew (3 * n); {-# INLINE basicUnsafeNew #-}; basicInitialize (MV_A3 v) = GM.basicInitialize v; {-# INLINE basicInitialize #-}; basicUnsafeRead (MV_A3 v) i = liftM3 A3 (GM.basicUnsafeRead v (3 * i)) (GM.basicUnsafeRead v (3 * i + 1)) (GM.basicUnsafeRead v (3 * i + 2)); {-# INLINE basicUnsafeRead #-}; basicUnsafeWrite (MV_A3 v) i (A3 x y z) = GM.basicUnsafeWrite v (3 * i) x >> GM.basicUnsafeWrite v (3 * i + 1) y >> GM.basicUnsafeWrite v (3 * i + 2) z; {-# INLINE basicUnsafeWrite #-}; basicClear (MV_A3 v) = GM.basicClear v; {-# INLINE basicClear #-}; basicUnsafeCopy (MV_A3 v1) (MV_A3 v2) = GM.basicUnsafeCopy v1 v2; {-# INLINE basicUnsafeCopy #-}; basicUnsafeMove (MV_A3 v1) (MV_A3 v2) = GM.basicUnsafeMove v1 v2; {-# INLINE basicUnsafeMove #-}; basicUnsafeGrow (MV_A3 v) n = MV_A3 `liftM` GM.basicUnsafeGrow v (3 * n); {-# INLINE basicUnsafeGrow #-}};instance (U.Unbox a) => G.Vector U.Vector (A3 a) where { basicUnsafeFreeze (MV_A3 v) = V_A3 `liftM` G.basicUnsafeFreeze v; {-# INLINE basicUnsafeFreeze #-}; basicUnsafeThaw (V_A3 v) = MV_A3 `liftM` G.basicUnsafeThaw v; {-# INLINE basicUnsafeThaw #-}; basicLength (V_A3 v) = G.basicLength v `div` 3; {-# INLINE basicLength #-}; basicUnsafeSlice i n (V_A3 v) = V_A3 $ G.basicUnsafeSlice (3 * i) (3 * n) v; {-# INLINE basicUnsafeSlice #-}; basicUnsafeIndexM (V_A3 v) i = liftM3 A3 (G.basicUnsafeIndexM v (3 * i)) (G.basicUnsafeIndexM v (3 * i + 1)) (G.basicUnsafeIndexM v (3 * i + 2)); {-# INLINE basicUnsafeIndexM #-}; basicUnsafeCopy (MV_A3 mv) (V_A3 v) = G.basicUnsafeCopy mv v; elemseq _ = seq; {-# INLINE elemseq #-}};data A2 a = A2 !a !a deriving (Eq, Show);newtype instance  UM.MVector s (A2 a) = MV_A2 (UM.MVector s a);newtype instance  U.Vector (A2 a) = V_A2 (U.Vector a);instance (U.Unbox a) => U.Unbox (A2 a);instance (U.Unbox a) => GM.MVector UM.MVector (A2 a) where { basicLength (MV_A2 v) = unsafeShiftR (GM.basicLength v) 1; {-# INLINE basicLength #-}; basicUnsafeSlice i n (MV_A2 v) = MV_A2 $ GM.basicUnsafeSlice (2 * i) (2 * n) v; {-# INLINE basicUnsafeSlice #-}; basicOverlaps (MV_A2 v1) (MV_A2 v2) = GM.basicOverlaps v1 v2; {-# INLINE basicOverlaps #-}; basicUnsafeNew n = MV_A2 `liftM` GM.basicUnsafeNew (2 * n); {-# INLINE basicUnsafeNew #-}; basicInitialize (MV_A2 v) = GM.basicInitialize v; {-# INLINE basicInitialize #-}; basicUnsafeRead (MV_A2 v) i = liftM2 A2 (GM.basicUnsafeRead v (2 * i)) (GM.basicUnsafeRead v (2 * i + 1)); {-# INLINE basicUnsafeRead #-}; basicUnsafeWrite (MV_A2 v) i (A2 x y) = GM.basicUnsafeWrite v (2 * i) x >> GM.basicUnsafeWrite v (2 * i + 1) y; {-# INLINE basicUnsafeWrite #-}; basicClear (MV_A2 v) = GM.basicClear v; {-# INLINE basicClear #-}; basicUnsafeCopy (MV_A2 v1) (MV_A2 v2) = GM.basicUnsafeCopy v1 v2; {-# INLINE basicUnsafeCopy #-}; basicUnsafeMove (MV_A2 v1) (MV_A2 v2) = GM.basicUnsafeMove v1 v2; {-# INLINE basicUnsafeMove #-}; basicUnsafeGrow (MV_A2 v) n = MV_A2 `liftM` GM.basicUnsafeGrow v (2 * n); {-# INLINE basicUnsafeGrow #-}};instance (U.Unbox a) => G.Vector U.Vector (A2 a) where { basicUnsafeFreeze (MV_A2 v) = V_A2 `liftM` G.basicUnsafeFreeze v; {-# INLINE basicUnsafeFreeze #-}; basicUnsafeThaw (V_A2 v) = MV_A2 `liftM` G.basicUnsafeThaw v; {-# INLINE basicUnsafeThaw #-}; basicLength (V_A2 v) = unsafeShiftR (G.basicLength v) 1; {-# INLINE basicLength #-}; basicUnsafeSlice i n (V_A2 v) = V_A2 $ G.basicUnsafeSlice (2 * i) (2 * n) v; {-# INLINE basicUnsafeSlice #-}; basicUnsafeIndexM (V_A2 v) i = liftM2 A2 (G.basicUnsafeIndexM v (2 * i)) (G.basicUnsafeIndexM v (2 * i + 1)); {-# INLINE basicUnsafeIndexM #-}; basicUnsafeCopy (MV_A2 mv) (V_A2 v) = G.basicUnsafeCopy mv v; elemseq _ = seq; {-# INLINE elemseq #-}};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum U.! (r + 1) - csum U.! l;{-# 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 snocCSum #-};snocCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();snocCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};type SizedList = (Int, [Int]);compareSL :: SizedList -> SizedList -> Ordering;compareSL (!len1, !xs1) (!len2, !xs2) | len1 > len2 = GT | len1 < len2 = LT | otherwise = inner xs1 xs2 where { inner [] [] = EQ; inner (y1 : ys1) (y2 : ys2) = case compare y1 y2 of { EQ -> inner ys1 ys2; c -> c}; inner _ [] = error "unreachable: `compareSL`"; inner [] _ = error "unreachable: `compareSL`"};maxSL :: SizedList -> SizedList -> SizedList;maxSL sl1 sl2 = case compareSL sl1 sl2 of { GT -> sl1; _ -> sl2};nullSL :: SizedList -> Bool;nullSL = null . snd;emptySL :: SizedList;emptySL = (0, []);consSL :: SizedList -> Int -> SizedList;consSL (!len, !xs) !x = (len + 1, x : xs);class SafeList v where { type SafeListElem v; headMay :: v -> Maybe (SafeListElem v); lastMay :: v -> Maybe (SafeListElem v); headOr :: SafeListElem v -> v -> SafeListElem v; lastOr :: SafeListElem v -> v -> SafeListElem v; minimumMay :: v -> Maybe (SafeListElem v); maximumMay :: v -> Maybe (SafeListElem v); minimumOr :: SafeListElem v -> v -> SafeListElem v; maximumOr :: SafeListElem v -> v -> SafeListElem v};instance (Ord a) => SafeList [a] where { type SafeListElem [a] = a; headMay [] = Nothing; headMay (x : _) = Just x; lastMay [] = Nothing; lastMay xs = Just $ last xs; headOr x0 [] = x0; headOr _ xs = head xs; lastOr x0 [] = x0; lastOr _ xs = last xs; minimumMay [] = Nothing; minimumMay xs = Just $ minimum xs; maximumMay [] = Nothing; maximumMay xs = Just $ maximum xs; minimumOr x0 [] = x0; minimumOr _ xs = minimum xs; maximumOr x0 [] = x0; maximumOr _ xs = maximum xs};instance (Ord a) => SafeList (V.Vector a) where { type SafeListElem (V.Vector a) = a; headMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeHead xs; lastMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeLast xs; headOr x0 xs | G.null xs = x0 | otherwise = G.unsafeHead xs; lastOr x0 xs | G.null xs = x0 | otherwise = G.unsafeLast xs; minimumMay xs | G.null xs = Nothing | otherwise = Just $ G.minimum xs; maximumMay xs | G.null xs = Nothing | otherwise = Just $ G.maximum xs; minimumOr x0 xs | G.null xs = x0 | otherwise = G.minimum xs; maximumOr x0 xs | G.null xs = x0 | otherwise = G.maximum xs};instance (U.Unbox a, Ord a) => SafeList (U.Vector a) where { type SafeListElem (U.Vector a) = a; headMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeHead xs; lastMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeLast xs; headOr x0 xs | G.null xs = x0 | otherwise = G.unsafeHead xs; lastOr x0 xs | G.null xs = x0 | otherwise = G.unsafeLast xs; minimumMay xs | G.null xs = Nothing | otherwise = Just $ G.minimum xs; maximumMay xs | G.null xs = Nothing | otherwise = Just $ G.maximum xs; minimumOr x0 xs | G.null xs = x0 | otherwise = G.minimum xs; maximumOr x0 xs | G.null xs = x0 | otherwise = G.maximum xs};data BinaryHeap (f :: Type -> Type) s a = BinaryHeap{priorityBH :: !(a -> f a), intVarsBH :: !(UM.MVector s Int), internalVecBH :: !(UM.MVector s a)};_sizeBH :: Int;_sizeBH = 0;{-# INLINE _sizeBH #-};type MinBinaryHeap s a = BinaryHeap Identity s a;type MaxBinaryHeap s a = BinaryHeap Down s a;newBinaryHeap :: (U.Unbox a, PrimMonad m) => (a -> f a) -> Int -> m (BinaryHeap f (PrimState m) a);newBinaryHeap prio n = BinaryHeap prio <$> UM.replicate 1 0 <*> UM.unsafeNew n;newMinBinaryHeap :: (U.Unbox a, PrimMonad m) => Int -> m (MinBinaryHeap (PrimState m) a);newMinBinaryHeap = newBinaryHeap Identity;newMaxBinaryHeap :: (U.Unbox a, PrimMonad m) => Int -> m (MaxBinaryHeap (PrimState m) a);newMaxBinaryHeap = newBinaryHeap Down;getBinaryHeapSize :: (PrimMonad m) => BinaryHeap f (PrimState m) a -> m Int;getBinaryHeapSize BinaryHeap{..} = UM.unsafeRead intVarsBH _sizeBH;{-# INLINE getBinaryHeapSize #-};siftUpBy :: (U.Unbox a, PrimMonad m) => (a -> a -> Ordering) -> Int -> UM.MVector (PrimState m) a -> m ();siftUpBy cmp k vec = do { x <- UM.unsafeRead vec k; flip fix k $ \ loop !i -> if i > 0 then do { let { parent = (i - 1) `unsafeShiftR` 1}; p <- UM.unsafeRead vec parent; case cmp p x of { GT -> UM.unsafeWrite vec i p >> loop parent; _ -> UM.unsafeWrite vec i x}} else UM.unsafeWrite vec 0 x};{-# INLINE siftUpBy #-};siftDownBy :: (U.Unbox a, PrimMonad m) => (a -> a -> Ordering) -> Int -> UM.MVector (PrimState m) a -> m ();siftDownBy cmp k vec = do { x <- UM.unsafeRead vec k; let { !n = UM.length vec}; flip fix k $ \ loop !i -> do { let { l = unsafeShiftL i 1 .|. 1}; let { r = l + 1}; if n <= l then UM.unsafeWrite vec i x else do { vl <- UM.unsafeRead vec l; if r < n then do { vr <- UM.unsafeRead vec r; case cmp vr vl of { LT -> case cmp x vr of { GT -> UM.unsafeWrite vec i vr >> loop r; _ -> UM.unsafeWrite vec i x}; _ -> case cmp x vl of { GT -> UM.unsafeWrite vec i vl >> loop l; _ -> UM.unsafeWrite vec i x}}} else case cmp x vl of { GT -> UM.unsafeWrite vec i vl >> loop l; _ -> UM.unsafeWrite vec i x}}}};{-# INLINE siftDownBy #-};heapifyBy :: (U.Unbox a, PrimMonad m) => (a -> a -> Ordering) -> UM.MVector (PrimState m) a -> m ();heapifyBy cmp vec = do { let { n = UM.length vec `quot` 2}; forM_ [n - 1, n - 2 .. 0] $ \ i -> do { siftDownBy cmp i vec}};{-# INLINE heapifyBy #-};class OrdVia f a where { compareVia :: (a -> f a) -> a -> a -> Ordering};instance (Ord a) => OrdVia Identity a where { compareVia _ = coerce (compare :: Identity a -> Identity a -> Ordering); {-# INLINE compareVia #-}};instance (Ord a) => OrdVia Down a where { compareVia _ = coerce (compare :: Down a -> Down a -> Ordering); {-# INLINE compareVia #-}};buildBinaryHeapVia :: (OrdVia f a, U.Unbox a, PrimMonad m) => (a -> f a) -> U.Vector a -> m (BinaryHeap f (PrimState m) a);buildBinaryHeapVia priorityBH vec = do { intVarsBH <- UM.replicate 1 $ U.length vec; internalVecBH <- U.thaw vec; heapifyBy (compareVia priorityBH) internalVecBH; return $! BinaryHeap{..}};{-# INLINE buildBinaryHeapVia #-};buildMinBinaryHeap :: (Ord a, U.Unbox a, PrimMonad m) => U.Vector a -> m (BinaryHeap Identity (PrimState m) a);buildMinBinaryHeap = buildBinaryHeapVia Identity;{-# INLINE buildMinBinaryHeap #-};buildMaxBinaryHeap :: (Ord a, U.Unbox a, PrimMonad m) => U.Vector a -> m (BinaryHeap Down (PrimState m) a);buildMaxBinaryHeap = buildBinaryHeapVia Down;{-# INLINE buildMaxBinaryHeap #-};unsafeViewBH :: (U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m a;unsafeViewBH BinaryHeap{..} = UM.unsafeRead internalVecBH 0;{-# INLINE unsafeViewBH #-};viewBH :: (U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m (Maybe a);viewBH bh = do { size <- getBinaryHeapSize bh; if size > 0 then Just <$!> unsafeViewBH bh else return Nothing};{-# INLINE viewBH #-};insertBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> a -> m ();insertBH BinaryHeap{..} x = do { size <- UM.unsafeRead intVarsBH _sizeBH; UM.unsafeWrite intVarsBH _sizeBH (size + 1); UM.unsafeWrite internalVecBH size x; siftUpBy (compareVia priorityBH) size internalVecBH};{-# INLINE insertBH #-};unsafeDeleteBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m ();unsafeDeleteBH BinaryHeap{..} = do { size' <- subtract 1 <$!> UM.unsafeRead intVarsBH _sizeBH; UM.unsafeWrite intVarsBH _sizeBH size'; UM.unsafeSwap internalVecBH 0 size'; siftDownBy (compareVia priorityBH) 0 (UM.unsafeTake size' internalVecBH)};{-# INLINE unsafeDeleteBH #-};modifyTopBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> (a -> a) -> m ();modifyTopBH BinaryHeap{..} f = do { UM.unsafeModify internalVecBH f 0; size <- UM.unsafeRead intVarsBH _sizeBH; siftDownBy (compareVia priorityBH) 0 (UM.unsafeTake size internalVecBH)};{-# INLINE modifyTopBH #-};deleteFindTopBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m (Maybe a);deleteFindTopBH bh = do { size <- getBinaryHeapSize bh; if size > 0 then do { !top <- unsafeViewBH bh <* unsafeDeleteBH bh; return $ Just top} else return Nothing};{-# INLINE deleteFindTopBH #-};clearBH :: (PrimMonad m) => BinaryHeap f (PrimState m) a -> m ();clearBH BinaryHeap{..} = UM.unsafeWrite intVarsBH 0 0;freezeInternalVecBH :: (U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m (U.Vector a);freezeInternalVecBH BinaryHeap{..} = do { size <- UM.unsafeRead intVarsBH _sizeBH; U.unsafeFreeze (UM.unsafeTake size internalVecBH)};type MultiSet = (Int, IM.IntMap Int);{-# INLINE emptyMS #-};emptyMS :: MultiSet;emptyMS = (0, IM.empty);{-# INLINE singletonMS #-};singletonMS :: Int -> MultiSet;singletonMS !x = (1, IM.singleton x 1);{-# INLINE fromListMS #-};fromListMS :: [Int] -> MultiSet;fromListMS = foldl' (flip incMS) emptyMS;{-# INLINE incMS #-};incMS :: Int -> MultiSet -> MultiSet;incMS !k (!nKeys, !im) = case IM.lookup k im of { Just !n -> (nKeys, IM.insert k (n + 1) im); Nothing -> (nKeys + 1, IM.insert k 1 im)};{-# INLINE decMS #-};decMS :: Int -> MultiSet -> MultiSet;decMS !k (!nKeys, !im) = case IM.lookup k im of { Just 1 -> (nKeys - 1, IM.delete k im); Just n -> (nKeys, IM.insert k (n - 1) im); Nothing -> (nKeys, im)};{-# INLINE addMS #-};addMS :: Int -> Int -> MultiSet -> MultiSet;addMS !k !dn (!nKeys, !im) = case IM.lookup k im of { Just n -> (nKeys, IM.insert k (n + dn) im); Nothing -> (nKeys + 1, IM.insert k dn im)};{-# INLINE subMS #-};subMS :: Int -> Int -> MultiSet -> MultiSet;subMS !k !dn (!nKeys, !im) = case IM.lookup k im of { Just n | n > dn -> (nKeys, IM.insert k (n - dn) im) | n == dn -> (nKeys - 1, IM.delete k im) | otherwise -> (nKeys - 1, IM.delete k im); Nothing -> (nKeys, im)};{-# INLINE memberMS #-};memberMS :: Int -> MultiSet -> Bool;memberMS !k (!_, !im) = IM.member k im;{-# INLINE notMemberMS #-};notMemberMS :: Int -> MultiSet -> Bool;notMemberMS !k (!_, !im) = IM.notMember k im;{-# INLINE decFindMinMS #-};decFindMinMS :: MultiSet -> (Int, MultiSet);decFindMinMS ms@(!_, !im) = let { !key = fst $ IM.findMin im} in (key, decMS key ms);{-# INLINE lookupMS #-};lookupMS :: Int -> MultiSet -> Maybe Int;lookupMS !k = IM.lookup k . innerMS;{-# INLINE getMS #-};getMS :: (HasCallStack) => Int -> MultiSet -> Int;getMS !k !ms = case lookupMS k ms of { Just x -> x; Nothing -> error $ "getMS: panic with key: " ++ show k};{-# INLINE innerMS #-};innerMS :: MultiSet -> IM.IntMap Int;innerMS (!_, !im) = im;data MultiSetVec s = MultiSetVec (MutVar s Int) (UM.MVector s Int);showMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m String;showMSV (MultiSetVec !nRef !mVec) = do { !n <- readMutVar nRef; !vec <- G.unsafeFreeze mVec; return $ show (n, vec)};newMSV :: (PrimMonad m) => Int -> m (MultiSetVec (PrimState m));newMSV !capacity = MultiSetVec <$> newMutVar (0 :: Int) <*> UM.replicate capacity (0 :: Int);clearMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m ();clearMSV (MultiSetVec !nRef !mVec) = do { writeMutVar nRef 0; GM.set mVec 0};fromVecMSV :: (PrimMonad m) => Int -> U.Vector Int -> m (MultiSetVec (PrimState m));fromVecMSV !capacity !xs = do { !msv <- newMSV capacity; U.forM_ xs (incMSV msv); return msv};countMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m Int;countMSV (MultiSetVec !nRef !_) = readMutVar nRef;nullMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m Bool;nullMSV = fmap (== 0) . countMSV;readMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> Int -> m Int;readMSV (MultiSetVec !_ !mVec) = GM.read mVec;incMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> Int -> m ();incMSV (MultiSetVec !nRef !mVec) k = GM.read mVec k >>= \case { 0 -> do { modifyMutVar' nRef succ; GM.write mVec k 1}; !nk -> do { GM.write mVec k (nk + 1)}};decMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> Int -> m ();decMSV (MultiSetVec !nRef !mVec) k = GM.read mVec k >>= \case { 0 -> return (); 1 -> do { modifyMutVar' nRef pred; GM.write mVec k 0}; !nk -> do { GM.write mVec k (nk - 1)}};minMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m (Maybe (Int, Int));minMSV (MultiSetVec !nRef !mVec) = readMutVar nRef >>= \case { 0 -> return Nothing; _ -> do { !vec <- G.unsafeFreeze mVec; return . fmap (\ i -> (i, vec G.! i)) $ G.findIndex (> 0) vec}};maxMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m (Maybe (Int, Int));maxMSV (MultiSetVec !nRef !mVec) = readMutVar nRef >>= \case { 0 -> return Nothing; _ -> do { !vec <- G.unsafeFreeze mVec; return . fmap (\ i -> (i, vec G.! i)) $ G.findIndexR (> 0) vec}};unsafeFreezeMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m (Int, U.Vector Int);unsafeFreezeMSV (MultiSetVec !nRef !mVec) = (,) <$> readMutVar nRef <*> U.unsafeFreeze mVec;data RH b p = RH{nextDigitRH :: {-# UNPACK #-} !Int, hashRH :: {-# UNPACK #-} !Int} deriving (Eq, Ord, Show);{-# INLINE rh1 #-};rh1 :: forall b p . (KnownNat b) => Int -> RH b p;rh1 = RH (fromInteger (natVal' (proxy# @b)));instance (KnownNat b, KnownNat p) => Semigroup (RH b p) where { {-# INLINE (<>) #-}; (RH !digit1 !hash1) <> (RH !digit2 !hash2) = RH digit' hash' where { !p = fromInteger $ natVal' (proxy# @p); !digit' = digit1 * digit2 `mod` p; !hash' = (hash1 * digit2 + hash2) `mod` p}};instance (KnownNat b, KnownNat p) => Monoid (RH b p) where { {-# INLINE mempty #-}; mempty = RH 1 0};type RHRepr = A2 Int;instance U.IsoUnbox (RH b p) RHRepr where { {-# INLINE toURepr #-}; toURepr (RH a b) = A2 a b; {-# INLINE fromURepr #-}; fromURepr (A2 a b) = RH a b};newtype instance  U.MVector s (RH b p) = MV_RH (UM.MVector s RHRepr);newtype instance  U.Vector (RH b p) = V_RH (U.Vector RHRepr);deriving via (RH b p `U.As` RHRepr) instance GM.MVector UM.MVector (RH b p);deriving via (RH b p `U.As` RHRepr) instance G.Vector U.Vector (RH b p);instance U.Unbox (RH b p);data RollingHash b p = RollingHash{sourceLength :: !Int, dimensions :: !(U.Vector Int), hashSum :: !(U.Vector Int)} deriving (Show, Eq);type HashInt = (100 :: Nat);newRH :: forall p . (KnownNat p) => String -> RollingHash HashInt p;newRH !source = RollingHash n bn hashSum_ where { !p = fromInteger $ natVal (Proxy @p) :: Int; !b = fromInteger $ natVal (Proxy @HashInt) :: Int; !n = length source; !bn = U.iterateN (succ n) (\ lastB -> b * lastB `mod` p) (1 :: Int); !hashSum_ = evalState (U.mapM (\ !ch -> state $ \ !acc -> f ch acc) $ U.fromList source) (0 :: Int) where { f :: Char -> Int -> (Int, Int); f !ch !lastX = dupe $! (lastX * b + ord ch) `mod` p}};lengthRH :: RollingHash b p -> Int;lengthRH (RollingHash !len !_ !_) = len;data HashSlice p = HashSlice{hashValue :: {-# UNPACK #-} !Int, hashLength :: {-# UNPACK #-} !Int} deriving (Show, Eq);sliceRH :: forall b p . (KnownNat p) => RollingHash b p -> Int -> Int -> HashSlice p;sliceRH (RollingHash !_ !bn !s) !i0 !i1 | i0 > i1 = emptyHS | otherwise = let { !len = i1 - i0 + 1; !s1 = s U.! i1; !s0 = fromMaybe 0 $ s U.!? pred i0; !value = (s1 - (bn U.! len) * s0) `mod` p} in HashSlice value len where { !p = fromInteger $ natVal (Proxy @p) :: Int};consHS :: forall b p . (KnownNat p) => RollingHash b p -> HashSlice p -> HashSlice p -> HashSlice p;consHS (RollingHash !_ !bn !_) (HashSlice !v0 !l0) (HashSlice !v1 !l1) = HashSlice value len where { !p = fromInteger $ natVal (Proxy @p) :: Int; !value = ((bn U.! l1) * v0 + v1) `mod` p; !len = l0 + l1};emptyHS :: HashSlice p;emptyHS = HashSlice 0 0;concatHS :: forall b p t . (KnownNat p, Foldable t) => RollingHash b p -> t (HashSlice p) -> HashSlice p;concatHS !rhash !slices = foldl' (consHS rhash) emptyHS slices;data Buffer s a = Buffer{bufferVars :: !(UM.MVector s Int), internalBuffer :: !(UM.MVector s a), internalBufferSize :: !Int};_bufferFrontPos :: Int;_bufferFrontPos = 0;_bufferBackPos :: Int;_bufferBackPos = 1;newBuffer :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBuffer n = Buffer <$> UM.replicate 2 0 <*> UM.unsafeNew n <*> pure n;type Stack s a = Buffer s a;newBufferAsStack :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBufferAsStack n = Buffer <$> UM.replicate 2 0 <*> UM.unsafeNew n <*> pure n;createBuffer :: (U.Unbox a) => (forall s . ST s (Buffer s a)) -> U.Vector a;createBuffer f = runST $ do { !buf <- f; unsafeFreezeBuffer buf};type Queue s a = Buffer s a;newBufferAsQueue :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBufferAsQueue n = Buffer <$> UM.replicate 2 0 <*> UM.unsafeNew n <*> pure n;type Deque s a = Buffer s a;newBufferAsDeque :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBufferAsDeque n = Buffer <$> UM.replicate 2 n <*> UM.unsafeNew (2 * n) <*> pure (2 * n);lengthBuffer :: (PrimMonad m) => Buffer (PrimState m) a -> m Int;lengthBuffer Buffer{bufferVars} = liftA2 (-) (UM.unsafeRead bufferVars _bufferBackPos) (UM.unsafeRead bufferVars _bufferFrontPos);{-# INLINE lengthBuffer #-};nullBuffer :: (PrimMonad m) => Buffer (PrimState m) a -> m Bool;nullBuffer = fmap (== 0) . lengthBuffer;{-# INLINE nullBuffer #-};clearBuffer :: (PrimMonad m) => Buffer (PrimState m) a -> m ();clearBuffer Buffer{bufferVars} = do { UM.unsafeWrite bufferVars _bufferFrontPos 0; UM.unsafeWrite bufferVars _bufferBackPos 0};freezeBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);freezeBuffer Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; U.freeze $ UM.unsafeSlice f (b - f) internalBuffer};unsafeFreezeBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);unsafeFreezeBuffer Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; U.unsafeFreeze $ UM.unsafeSlice f (b - f) internalBuffer};freezeInternalBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);freezeInternalBuffer Buffer{bufferVars, internalBuffer} = do { b <- UM.unsafeRead bufferVars _bufferBackPos; U.freeze $ UM.unsafeSlice 0 b internalBuffer};unsafeFreezeInternalBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);unsafeFreezeInternalBuffer Buffer{bufferVars, internalBuffer} = do { b <- UM.unsafeRead bufferVars _bufferBackPos; U.unsafeFreeze $ UM.unsafeSlice 0 b internalBuffer};popFront :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);popFront Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then do { UM.unsafeWrite bufferVars _bufferFrontPos (f + 1); pure <$> UM.unsafeRead internalBuffer f} else return Nothing};{-# INLINE popFront #-};popFront_ :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m ();popFront_ = void . popFront;{-# INLINE popFront_ #-};popFrontN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe (U.Vector a));popFrontN Buffer{bufferVars, internalBuffer} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { res <- U.freeze (UM.slice f len internalBuffer); UM.unsafeWrite bufferVars _bufferFrontPos (f + len); pure $ Just res} else return Nothing};{-# INLINE popFrontN #-};popBackN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe (U.Vector a));popBackN Buffer{bufferVars, internalBuffer} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { res <- U.freeze (UM.slice (b - len) len internalBuffer); UM.unsafeWrite bufferVars _bufferBackPos (b - len); pure $ Just res} else pure Nothing};{-# INLINE popBackN #-};popFrontN_ :: (PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe ());popFrontN_ Buffer{bufferVars} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { UM.unsafeWrite bufferVars _bufferFrontPos (f + len); pure $ Just ()} else pure Nothing};{-# INLINE popFrontN_ #-};popBackN_ :: (PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe ());popBackN_ Buffer{bufferVars} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { UM.unsafeWrite bufferVars _bufferBackPos (b - len); pure $ Just ()} else pure Nothing};{-# INLINE popBackN_ #-};viewFront :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);viewFront Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then pure <$> UM.unsafeRead internalBuffer f else return Nothing};{-# INLINE viewFront #-};popBack :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);popBack Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then do { UM.unsafeWrite bufferVars _bufferBackPos (b - 1); pure <$> UM.unsafeRead internalBuffer (b - 1)} else return Nothing};{-# INLINE popBack #-};popBack_ :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m ();popBack_ = void . popBack;{-# INLINE popBack_ #-};viewBack :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);viewBack Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then pure <$> UM.unsafeRead internalBuffer (b - 1) else return Nothing};{-# INLINE viewBack #-};pushFront :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> a -> m ();pushFront Buffer{bufferVars, internalBuffer} x = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; UM.unsafeWrite bufferVars _bufferFrontPos (f - 1); assert (f > 0) $ do { UM.unsafeWrite internalBuffer (f - 1) x}};{-# INLINE pushFront #-};pushBack :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> a -> m ();pushBack Buffer{bufferVars, internalBuffer, internalBufferSize} x = do { b <- UM.unsafeRead bufferVars _bufferBackPos; UM.unsafeWrite bufferVars _bufferBackPos (b + 1); assert (b < internalBufferSize) $ do { UM.unsafeWrite internalBuffer b x}};{-# INLINE pushBack #-};pushFronts :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> U.Vector a -> m ();pushFronts Buffer{bufferVars, internalBuffer} vec = do { let { n = U.length vec}; f <- UM.unsafeRead bufferVars _bufferFrontPos; UM.unsafeWrite bufferVars _bufferFrontPos (f - n); assert (n <= f) $ do { U.unsafeCopy (UM.unsafeSlice (f - n) n internalBuffer) vec}};{-# INLINE pushFronts #-};pushBacks :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> U.Vector a -> m ();pushBacks Buffer{bufferVars, internalBuffer, internalBufferSize} vec = do { let { n = U.length vec}; b <- UM.unsafeRead bufferVars _bufferBackPos; UM.unsafeWrite bufferVars _bufferBackPos (b + n); assert (b + n - 1 < internalBufferSize) $ do { U.unsafeCopy (UM.unsafeSlice b n internalBuffer) vec}};{-# INLINE pushBacks #-};viewFrontN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe a);viewFrontN Buffer{..} i = do { !f <- UM.unsafeRead bufferVars _bufferFrontPos; !b <- UM.unsafeRead bufferVars _bufferBackPos; if inRange (f, b - 1) (f + i) then Just <$> UM.read internalBuffer (f + i) else return Nothing};{-# INLINE viewFrontN #-};viewBackN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe a);viewBackN Buffer{..} i = do { !f <- UM.unsafeRead bufferVars _bufferFrontPos; !b <- UM.unsafeRead bufferVars _bufferBackPos; if inRange (f, b - 1) (b - 1 - i) then Just <$> UM.read internalBuffer (b - 1 - i) else return Nothing};{-# INLINE viewBackN #-};readFront :: (HasCallStack, U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m a;readFront = (fmap fromJust .) . viewFrontN;{-# INLINE readFront #-};readBack :: (HasCallStack, U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m a;readBack = (fmap fromJust .) . viewBackN;{-# INLINE readBack #-};data MaxFlow s c = MaxFlow{nVertsMF :: !Int, nEdgesMF :: !Int, offsetsMF :: !(U.Vector Int), edgeDstMF :: !(U.Vector Int), edgeRevIndexMF :: !(U.Vector Int), edgeCapMF :: !(UM.MVector s c)};data MaxFlowBuffer s c = MaxFlowBuffer{distsMF :: !(UM.MVector s Int), queueMF :: !(Buffer s Vertex), iterMF :: !(UM.MVector s Int)};maxFlow :: (U.Unbox c, Num c, Ord c, Bounded c) => Int -> Int -> Int -> U.Vector (Vertex, Vertex, c) -> c;maxFlow !nVerts !src !sink !edges = runST $ do { fst <$> maxFlow' nVerts src sink edges};maxFlow' :: (PrimMonad m, U.Unbox c, Num c, Ord c, Bounded c) => Int -> Int -> Int -> U.Vector (Vertex, Vertex, c) -> m (c, MaxFlow (PrimState m) c);maxFlow' !nVerts !src !sink !edges = do { !container <- buildMaxFlow nVerts edges; !flow <- runMaxFlow src sink container; return (flow, container)};edgesMF :: (PrimMonad m, U.Unbox c, Num c, Ord c, Bounded c) => MaxFlow (PrimState m) c -> m (U.Vector (Int, Int, c, c));edgesMF MaxFlow{..} = do { !edgeCap <- U.unsafeFreeze edgeCapMF; let { next (!i12, !v1) | i12 == offsetsMF U.! (v1 + 1) = next (i12, v1 + 1) | otherwise = ((v1, v2, cap, flow), (i12 + 1, v1)) where { v2 = edgeDstMF U.! i12; i21 = edgeRevIndexMF U.! i12; flow = edgeCap U.! i21; cap = edgeCap U.! i12 + edgeCap U.! i21}}; return $ U.unfoldrExactN nEdgesMF next ((0 :: Vertex), 0 :: Int)};undefMF :: Int;undefMF = -1;buildMaxFlow :: forall c m . (U.Unbox c, Num c, PrimMonad m) => Int -> U.Vector (Vertex, Vertex, c) -> m (MaxFlow (PrimState m) c);buildMaxFlow !nVertsMF !edges = do { let { !offsetsMF = U.scanl' (+) (0 :: Int) $ U.create $ do { !degs <- UM.replicate nVertsMF (0 :: Int); G.forM_ edges $ \ (!v1, !v2, !_) -> do { GM.modify degs (+ 1) v1; GM.modify degs (+ 1) v2}; return degs}}; (!edgeDstMF, !edgeRevIndexMF, !edgeCapMF) <- do { !edgeDst <- UM.replicate nEdgesMF undefMF; !edgeRevIndex <- UM.replicate nEdgesMF undefMF; !edgeCap <- UM.replicate nEdgesMF (0 :: c); !edgeCounter <- U.thaw offsetsMF; G.forM_ edges $ \ (!v1, !v2, !cap) -> do { !i1 <- GM.read edgeCounter v1; !i2 <- GM.read edgeCounter v2; GM.modify edgeCounter (+ 1) v1; GM.modify edgeCounter (+ 1) v2; GM.write edgeRevIndex i1 i2; GM.write edgeRevIndex i2 i1; GM.write edgeDst i1 v2; GM.write edgeDst i2 v1; GM.write edgeCap i1 cap}; (, , edgeCap) <$> G.unsafeFreeze edgeDst <*> G.unsafeFreeze edgeRevIndex}; return MaxFlow{..}} where { !nEdgesMF = G.length edges * 2};runMaxFlow :: forall c m . (U.Unbox c, Num c, Ord c, Bounded c, PrimMonad m) => Vertex -> Vertex -> MaxFlow (PrimState m) c -> m c;runMaxFlow !src !sink container@MaxFlow{..} = do { bufs@MaxFlowBuffer{..} <- MaxFlowBuffer <$> UM.unsafeNew nVertsMF <*> newBufferAsQueue nVertsMF <*> U.thaw offsetsMF; flip fix 0 $ \ loopBfs !flow -> do { GM.set distsMF undefMF; clearBuffer queueMF; runMaxFlowBfs src sink container bufs; !distSink <- UM.read distsMF sink; if distSink == undefMF then return flow else do { U.unsafeCopy iterMF offsetsMF; flip fix flow $ \ loopDfs f -> do { !df <- runMaxFlowDfs src sink maxBound container bufs; if df > 0 then loopDfs $! f + df else loopBfs f}}}};runMaxFlowBfs :: forall c m . (U.Unbox c, Num c, Ord c, PrimMonad m) => Vertex -> Vertex -> MaxFlow (PrimState m) c -> MaxFlowBuffer (PrimState m) c -> m ();runMaxFlowBfs !src !sink MaxFlow{..} MaxFlowBuffer{..} = do { UM.write distsMF src 0; pushBack queueMF src; fix $ \ loop -> popFront queueMF >>= \case { Nothing -> return (); Just !v1 -> do { !notEnd <- (== undefMF) <$> UM.read distsMF sink; when notEnd $ do { let { !iStart = offsetsMF U.! v1; !iEnd = offsetsMF U.! (v1 + 1)}; !dist1 <- UM.read distsMF v1; U.forM_ (U.generate (iEnd - iStart) (+ iStart)) $ \ i12 -> do { let { !v2 = edgeDstMF U.! i12}; !cap12 <- UM.read edgeCapMF i12; !notVisited <- (== undefMF) <$> UM.read distsMF v2; when (cap12 > 0 && notVisited) $ do { UM.write distsMF v2 (dist1 + 1); pushBack queueMF v2}}; loop}}}};runMaxFlowDfs :: forall c m . (U.Unbox c, Num c, Ord c, PrimMonad m) => Vertex -> Vertex -> c -> MaxFlow (PrimState m) c -> MaxFlowBuffer (PrimState m) c -> m c;runMaxFlowDfs !v0 !sink !flow0 MaxFlow{..} MaxFlowBuffer{..} = runDfs v0 flow0 where { runDfs !v1 !flow | v1 == sink = return flow | otherwise = fix $ \ visitNeighbor -> do { !i1 <- UM.read iterMF v1; if i1 >= offsetsMF U.! (v1 + 1) then do { return 0} else do { UM.write iterMF v1 (i1 + 1); let { !v2 = edgeDstMF U.! i1}; !cap12 <- UM.read edgeCapMF i1; !connected <- (<) <$> UM.read distsMF v1 <*> UM.read distsMF v2; if cap12 > 0 && connected then do { !flow' <- runDfs v2 $! min flow cap12; if flow' > 0 then do { modifyFlow i1 flow'; return flow'} else visitNeighbor} else visitNeighbor}}; modifyFlow !i1 !flow = do { UM.modify edgeCapMF (subtract flow) i1; UM.modify edgeCapMF (+ flow) (edgeRevIndexMF U.! i1)}};{-# INLINE bisect #-};bisect :: Int -> Int -> (Int -> Bool) -> (Maybe Int, Maybe Int);bisect !l !r = runIdentity . bisectM l r . (return .);{-# INLINE bisectL #-};bisectL :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectL !a !b !c = fst $! bisect a b c;{-# INLINE bisectR #-};bisectR :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectR !a !b !c = snd $! bisect a b c;{-# INLINE bisectM #-};bisectM :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int, Maybe Int);bisectM !low !high !isOk = both wrap <$> inner (low - 1) (high + 1) where { inner :: Int -> Int -> m (Int, Int); inner !ok !ng | abs (ok - ng) == 1 = return (ok, ng); inner !ok !ng = isOk m >>= \case { True -> inner m ng; False -> inner ok m} where { !m = (ok + ng) `div` 2}; wrap :: Int -> Maybe Int; wrap !x | inRange (low, high) x = Just x | otherwise = Nothing};{-# INLINE bisectML #-};bisectML :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectML !a !b !c = fst <$> bisectM a b c;{-# INLINE bisectMR #-};bisectMR :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectMR !a !b !c = snd <$> bisectM a b c;{-# INLINE bisectF32 #-};bisectF32 :: Float -> Float -> Float -> (Float -> Bool) -> (Maybe Float, Maybe Float);bisectF32 !low !high !diff !isOk = both wrap (inner (low - diff) (high + diff)) where { inner :: Float -> Float -> (Float, Float); inner !ok !ng | abs (ok - ng) <= diff = (ok, ng); inner !ok !ng | isOk m = inner m ng | otherwise = inner ok m where { !m = (ok + ng) / 2}; wrap :: Float -> Maybe Float; wrap !x | x == (low - diff) || x == (high + diff) = Nothing | otherwise = Just x};{-# INLINE bisectF32L #-};bisectF32L :: Float -> Float -> Float -> (Float -> Bool) -> Maybe Float;bisectF32L !a !b !c !d = fst $! bisectF32 a b c d;{-# INLINE bisectF32R #-};bisectF32R :: Float -> Float -> Float -> (Float -> Bool) -> Maybe Float;bisectF32R !a !b !c !d = snd $! bisectF32 a b c d;{-# INLINE bisectF64 #-};bisectF64 :: Double -> Double -> Double -> (Double -> Bool) -> (Maybe Double, Maybe Double);bisectF64 !low !high !diff !isOk = both wrap (inner (low - diff) (high + diff)) where { inner :: Double -> Double -> (Double, Double); inner !ok !ng | abs (ok - ng) < diff = (ok, ng); inner !ok !ng | isOk m = inner m ng | otherwise = inner ok m where { !m = (ok + ng) / 2}; wrap :: Double -> Maybe Double; wrap !x | x == (low - diff) || x == (high + diff) = Nothing | otherwise = Just x};{-# INLINE bisectF64L #-};bisectF64L :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectF64L !a !b !c !d = fst $! bisectF64 a b c d;{-# INLINE bisectF64R #-};bisectF64R :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectF64R !a !b !c !d = snd $! bisectF64 a b c d;{-# 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};{-# 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};isqrtSlow :: Int -> Int;isqrtSlow n = fromJust $ bisectR 0 n ((< n) . (^ (2 :: Int)));twoPointers :: Int -> (Int -> Int -> Bool) -> [(Int, Int)];twoPointers !n !p = unfoldr (uncurry f) s0 where { !s0 = (0, 0) :: (Int, Int); f l r | l == n = Nothing | not (p l r) = f (l + 1) (max (l + 1) r) | otherwise = Just ((l, r'), (l + 1, max (l + 1) r')) where { r' = until ((||) <$> (== n - 1) <*> not . p l . succ) succ r}};twoPointersU :: Int -> (Int -> Int -> Bool) -> U.Vector (Int, Int);twoPointersU !n !p = U.unfoldr (uncurry f) s0 where { !s0 = (0, 0) :: (Int, Int); f l r | l == n = Nothing | not (p l r) = f (l + 1) (max (l + 1) r) | otherwise = Just ((l, r'), (l + 1, max (l + 1) r')) where { r' = until ((||) <$> (== n - 1) <*> not . p l . succ) succ r}};{-# INLINE twoPtrM #-};twoPtrM :: forall acc m v a . (Monad m, G.Vector v a) => acc -> (acc -> a -> m Bool) -> (acc -> a -> m acc) -> (acc -> a -> m acc) -> v a -> m [(Int, Int)];twoPtrM acc0 p onNext onPop xs0 = inner acc0 xs0 xs0 (0 :: Int) (0 :: Int) where { inner :: acc -> v a -> v a -> Int -> Int -> m [(Int, Int)]; inner acc pops nexts l r = case G.uncons pops of { Nothing -> return []; Just (!y, !pops') -> case G.uncons nexts of { Just (!x, !nexts') -> do { b <- (r - l == 0 ||) <$> p acc x; if b then do { !acc' <- onNext acc x; inner acc' pops nexts' l (r + 1)} else do { !acc' <- onPop acc y; ((l, r) :) <$> inner acc' pops' nexts (l + 1) r}}; Nothing -> do { !acc' <- onPop acc y; ((l, r) :) <$> inner acc' pops' nexts (l + 1) r}}}};{-# INLINE twoPtr #-};twoPtr :: (G.Vector v a) => acc -> (acc -> a -> Bool) -> (acc -> a -> acc) -> (acc -> a -> acc) -> v a -> [(Int, Int)];twoPtr acc0 p onNext onPop = runIdentity . twoPtrM acc0 ((pure .) . p) ((pure .) . onNext) ((pure .) . onPop);rolls :: (RandomGen g, UniformRange a, U.Unbox a) => Int -> (a, a) -> g -> U.Vector a;rolls n rng = U.unfoldrExactN n (uniformR rng);rollsM :: (StatefulGen g m, UniformRange a, U.Unbox a) => Int -> (a, a) -> g -> m (U.Vector a);rollsM n rng = U.replicateM n . uniformRM rng;uniformRSt :: (RandomGen g, UniformRange a, MonadState g m) => (a, a) -> m a;uniformRSt !rng = state (uniformR rng);dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();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 ();dbgUF :: (PrimMonad m, Show (U.Vector MUFNode)) => MUnionFind (PrimState m) -> m ();dbgUF (MUnionFind vec) = dbgVec vec;data LazySegmentTree v a op s = LazySegmentTree !(v s a) !(UM.MVector s op) !Int;newLazySTree :: forall v a op m . (GM.MVector v a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> m (LazySegmentTree v a op (PrimState m));newLazySTree !n = do { !as <- GM.replicate n2 mempty; !ops <- UM.replicate n2 mempty; return $ LazySegmentTree as ops h} where { (!h, !n2) = until ((>= 2 * n) . snd) (bimap succ (* 2)) (0 :: Int, 1 :: Int)};newLazySTreeV :: forall a op m . (Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> m (LazySegmentTree VM.MVector a op (PrimState m));newLazySTreeV = newLazySTree;newLazySTreeU :: forall a op m . (U.Unbox a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> m (LazySegmentTree UM.MVector a op (PrimState m));newLazySTreeU = newLazySTree;generateLazySTreeG :: forall v a op m . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> (Int -> a) -> m (LazySegmentTree v a op (PrimState m));generateLazySTreeG !n !f = do { !as <- GM.unsafeNew n2; forM_ [1 .. nLeaves] $ \ i -> do { if i <= n then GM.write as (nLeaves + i - 1) $! f (pred i) else GM.write as (nLeaves + i - 1) mempty}; forM_ [nLeaves - 1, nLeaves - 2 .. 1] $ \ i -> do { !l <- GM.read as (childL i); !r <- GM.read as (childR i); GM.write as i $! l <> r}; !ops <- UM.replicate n2 mempty; return $ LazySegmentTree as ops h} where { (!h, !n2) = until ((>= 2 * n) . snd) (bimap succ (* 2)) (0 :: Int, 1 :: Int); !nLeaves = n2 `div` 2; childL !vertex = vertex .<<. 1; childR !vertex = vertex .<<. 1 .|. 1};generateLazySTreeV :: forall a op m . (HasCallStack, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> (Int -> a) -> m (LazySegmentTree VM.MVector a op (PrimState m));generateLazySTreeV = generateLazySTreeG;generateLazySTreeU :: forall a op m . (HasCallStack, U.Unbox a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> (Int -> a) -> m (LazySegmentTree UM.MVector a op (PrimState m));generateLazySTreeU = generateLazySTreeG;updateLazySTree :: forall v a op m . (GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> op -> m ();updateLazySTree stree@(LazySegmentTree !_ !ops !_) !iLLeaf !iRLeaf !op = do { let { !_ = dbgAssert (inRange (0, nLeaves - 1) iLLeaf && inRange (0, nLeaves - 1) iRLeaf) $ "updateLazySTree: wrong range " ++ show (iLLeaf, iRLeaf)}; _propOpMonoidsToLeaf stree iLLeaf; _propOpMonoidsToLeaf stree iRLeaf; let { !lVertex = iLLeaf + nLeaves; !rVertex = iRLeaf + nLeaves}; glitchLoopUpdate lVertex rVertex; _evalToRoot stree iLLeaf; _evalToRoot stree iRLeaf; return ()} where { !nLeaves = UM.length ops `div` 2; isLeftChild = not . (`testBit` 0); isRightChild = (`testBit` 0); glitchLoopUpdate :: Int -> Int -> m (); glitchLoopUpdate !l !r | l > r = return () | otherwise = do { !l' <- if isRightChild l then do { UM.modify ops (op <>) l; return $ succ l} else return l; !r' <- if isLeftChild r then do { UM.modify ops (op <>) r; return $ pred r} else return r; glitchLoopUpdate (l' .>>. 1) (r' .>>. 1)}};queryLazySTree :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> m a;queryLazySTree stree@(LazySegmentTree !as !ops !_) !iLLeaf !iRLeaf = do { let { !_ = dbgAssert (inRange (0, nLeaves - 1) iLLeaf && inRange (0, nLeaves - 1) iRLeaf) $ "queryLazySTree: wrong range " ++ show (iLLeaf, iRLeaf)}; _propOpMonoidsToLeaf stree iLLeaf; _propOpMonoidsToLeaf stree iRLeaf; let { !lVertex = iLLeaf + nLeaves; !rVertex = iRLeaf + nLeaves}; glitchFold lVertex rVertex mempty mempty} where { !nLeaves = GM.length as `div` 2; isLeftChild = not . (`testBit` 0); isRightChild = (`testBit` 0); glitchFold :: Int -> Int -> a -> a -> m a; glitchFold !l !r !lAcc !rAcc | l > r = return $! lAcc <> rAcc | otherwise = do { (!l', !lAcc') <- if isRightChild l then do { !la' <- mact <$> UM.read ops l <*> GM.read as l; let { !la'' = lAcc <> la'}; return (succ l, la'')} else return (l, lAcc); (!r', !rAcc') <- if isLeftChild r then do { !ra' <- mact <$> UM.read ops r <*> GM.read as r; let { !ra'' = ra' <> rAcc}; return (pred r, ra'')} else return (r, rAcc); glitchFold (l' .>>. 1) (r' .>>. 1) lAcc' rAcc'}};_propOpMonoidsToLeaf :: (HasCallStack, GM.MVector v a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> m ();_propOpMonoidsToLeaf (LazySegmentTree !as !ops !height) !iLeaf = do { let { !leafVertex = iLeaf + nVerts `div` 2}; forM_ [height - 1, height - 2 .. 1] $ \ iParent -> do { let { !vertex = nthParent leafVertex iParent}; !op <- UM.read ops vertex; when (op /= mempty) $ do { UM.modify ops (op <>) $! childL vertex; UM.modify ops (op <>) $! childR vertex; GM.modify as (mact op) vertex; UM.write ops vertex mempty}}} where { !nVerts = GM.length as; nthParent !leafVertex !nth = leafVertex .>>. nth; childL !vertex = vertex .<<. 1; childR !vertex = vertex .<<. 1 .|. 1};_evalToRoot :: (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> m ();_evalToRoot (LazySegmentTree !as !ops !height) !iLeaf = do { let { !leafVertex = iLeaf + nVerts `div` 2}; forM_ [1 .. pred height] $ \ iParent -> do { let { !vertex = nthParent leafVertex iParent}; let { !_ = dbgAssert (vertex > 0) "_evalToRoot"}; !aL' <- mact <$!> UM.read ops (childL vertex) <*> GM.read as (childL vertex); !aR' <- mact <$!> UM.read ops (childR vertex) <*> GM.read as (childR vertex); GM.write as vertex $! aL' <> aR'}} where { !nVerts = GM.length as; nthParent !leafVertex !nth = leafVertex .>>. nth; childL !vertex = vertex .<<. 1; childR !vertex = vertex .<<. 1 .|. 1};{-# INLINE bisectLazySTree #-};bisectLazySTree :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> (a -> Bool) -> m (Maybe Int, Maybe Int);bisectLazySTree stree@(LazySegmentTree !as !_ !_) l r f = do { bisectM l r $ \ r' -> do { !acc <- queryLazySTree stree l r'; return $! f acc}} where { !_ = dbgAssert (inRange (0, nLeaves - 1) l && inRange (0, nLeaves - 1) r) $ "bisectLazySTree: giveninvalid range " ++ show (l, r) where { nLeaves = GM.length as `div` 2}};{-# INLINE bisectLazySTreeL #-};bisectLazySTreeL :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bisectLazySTreeL stree l r f = fst <$> bisectLazySTree stree l r f;{-# INLINE bisectLazySTreeR #-};bisectLazySTreeR :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bisectLazySTreeR stree l r f = snd <$> bisectLazySTree stree l r f;data SegmentTree v s a = SegmentTree{unSegmentTree :: !(v s a), nValidLeavesSegmentTree :: !Int};newSTree :: (U.Unbox a, Monoid a, PrimMonad m) => Int -> m (SegmentTree UM.MVector (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 UM.MVector (PrimState m) a);buildSTree leaves = do { verts <- GM.unsafeNew nVerts; G.unsafeCopy (GM.unsafeSlice nLeaves (G.length leaves) verts) leaves; 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};readSTree :: (HasCallStack, GM.MVector v a, PrimMonad m) => SegmentTree v (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 :: (Monoid a, GM.MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> m ();_unsafeUpdateParentNodes vec v0 = 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)}};writeSTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (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 ++ " out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};modifySTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (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 ++ " out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};foldSTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (PrimState m) a -> Int -> Int -> m a;foldSTree (SegmentTree vec nValidLeaves) l0 r0 = 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); !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'}};foldMaySTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (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};foldWholeSTree :: (HasCallStack, GM.MVector v a, PrimMonad m) => SegmentTree v (PrimState m) a -> m a;foldWholeSTree (SegmentTree vec _) = GM.read vec 1;type CapacityMCF c = c;type FlowMCF c = c;type CostMCF c = c;data MinCostFlow s c = MinCostFlow{nVertsMCF :: !Int, nEdgesMCF :: !Int, offsetsMCF :: !(U.Vector Int), edgeDstMCF :: !(U.Vector Int), edgeRevIndexMCF :: !(U.Vector Int), edgeCapMCF :: !(UM.MVector s (CapacityMCF c)), edgeCostMCF :: !(U.Vector (CostMCF c))};data MinCostFlowBuffer r s c = MinCostFlowBuffer{distsMCF :: !(UM.MVector s r), prevVertMCF :: !(UM.MVector s Vertex), prevEdgeMCF :: !(UM.MVector s EdgeId)};relaxedCostFlow' :: (Show (f (CostMCF c)), Num (f (CostMCF c)), Monoid (f (CostMCF c)), U.Unbox (f (CostMCF c)), Ord (f (CostMCF c)), Num (f (CostMCF c)), PrimMonad m, Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => (CostMCF c -> f (CostMCF c)) -> Int -> Int -> Int -> CapacityMCF c -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> m (Maybe (f (CostMCF c)), MinCostFlow (PrimState m) c);relaxedCostFlow' toRelax !nVerts !src !sink !targetFlow !edges = do { !container <- buildMinCostFlow nVerts edges; !minCost <- runMinCostFlow toRelax src sink targetFlow container; return (minCost, container)};relaxedCostFlow :: (Show (f (CostMCF c)), Num (f (CostMCF c)), Monoid (f (CostMCF c)), U.Unbox (f (CostMCF c)), Ord (f (CostMCF c)), Num (f (CostMCF c)), Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => (CostMCF c -> f (CostMCF c)) -> Int -> Int -> Int -> CapacityMCF c -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> Maybe (f (CostMCF c));relaxedCostFlow toRelax !nVerts !src !sink !targetFlow !edges = runST $ do { fst <$> relaxedCostFlow' toRelax nVerts src sink targetFlow edges};minCostFlow :: (Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => Int -> Int -> Int -> CapacityMCF c -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> Maybe (Min (CostMCF c));minCostFlow = relaxedCostFlow Min;minCostFlow' :: (PrimMonad m, Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => Int -> Int -> Int -> CapacityMCF c -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> m (Maybe (Min (CostMCF c)), MinCostFlow (PrimState m) c);minCostFlow' = relaxedCostFlow' Min;maxCostFlow :: (Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => Int -> Int -> Int -> CapacityMCF c -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> Maybe (Max (CostMCF c));maxCostFlow = relaxedCostFlow Max;maxCostFlow' :: (PrimMonad m, Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => Int -> Int -> Int -> CapacityMCF c -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> m (Maybe (Max (CostMCF c)), MinCostFlow (PrimState m) c);maxCostFlow' = relaxedCostFlow' Max;edgesMCF :: (PrimMonad m, Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => MinCostFlow (PrimState m) c -> m (U.Vector (Int, Int, CapacityMCF c, FlowMCF c, CostMCF c));edgesMCF MinCostFlow{..} = do { !edgeCap <- U.unsafeFreeze edgeCapMCF; let { next (!i12, !v1) | i12 == offsetsMCF U.! (v1 + 1) = next (i12, v1 + 1) | otherwise = ((v1, v2, cap, flow, cost), (i12 + 1, v1)) where { v2 = edgeDstMCF U.! i12; i21 = edgeRevIndexMCF U.! i12; flow = edgeCap U.! i21; cap = edgeCap U.! i12 + edgeCap U.! i21; cost = edgeCostMCF U.! i12}}; return $ U.unfoldrExactN nEdgesMCF next (0 :: EdgeId, 0 :: Vertex)};undefMCF :: Int;undefMCF = -1;buildMinCostFlow :: forall c m . (PrimMonad m, Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => Int -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> m (MinCostFlow (PrimState m) c);buildMinCostFlow !nVertsMCF !edges = do { let { !offsetsMCF = U.scanl' (+) (0 :: Int) $ U.create $ do { !degs <- UM.replicate nVertsMCF (0 :: Int); G.forM_ edges $ \ (!v1, !v2, !_, !_) -> do { GM.modify degs (+ 1) v1; GM.modify degs (+ 1) v2}; return degs}}; (!edgeDstMCF, !edgeRevIndexMCF, !edgeCostMCF, !edgeCapMCF) <- do { !edgeDst <- UM.replicate nEdgesMCF undefMCF; !edgeRevIndex <- UM.replicate nEdgesMCF undefMCF; !edgeCost <- UM.replicate nEdgesMCF (0 :: CostMCF c); !edgeCap <- UM.replicate nEdgesMCF (0 :: CapacityMCF c); !edgeCounter <- U.thaw offsetsMCF; G.forM_ edges $ \ (!v1, !v2, !cap, !cost) -> do { let { !_ = dbgAssert (cost >= 0) $ "costs must be zero or positive" ++ show (v1, v2)}; let { !_ = dbgAssert (v1 /= v2) $ "cannot use self loop edge: " ++ show (v1, v2)}; !i1 <- GM.read edgeCounter v1; !i2 <- GM.read edgeCounter v2; GM.modify edgeCounter (+ 1) v1; GM.modify edgeCounter (+ 1) v2; GM.write edgeRevIndex i1 i2; GM.write edgeRevIndex i2 i1; GM.write edgeDst i1 v2; GM.write edgeDst i2 v1; GM.write edgeCap i1 cap; GM.write edgeCost i1 cost; GM.write edgeCost i2 (-cost)}; (, , , edgeCap) <$> G.unsafeFreeze edgeDst <*> G.unsafeFreeze edgeRevIndex <*> G.unsafeFreeze edgeCost}; return MinCostFlow{..}} where { !nEdgesMCF = G.length edges * 2};runMinCostFlow :: forall f c m . (Show (f (CostMCF c)), Num (f (CostMCF c)), Monoid (f (CostMCF c)), U.Unbox (f (CostMCF c)), Ord (f (CostMCF c)), Num (f (CostMCF c)), PrimMonad m, Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => (CostMCF c -> f (CostMCF c)) -> Vertex -> Vertex -> FlowMCF c -> MinCostFlow (PrimState m) c -> m (Maybe (f (CostMCF c)));runMinCostFlow !toRelax !src !sink !targetFlow container@MinCostFlow{..} = do { bufs@MinCostFlowBuffer{..} <- MinCostFlowBuffer <$> UM.unsafeNew nVertsMCF <*> UM.unsafeNew nVertsMCF <*> UM.unsafeNew nVertsMCF; let { run !accCost !restFlow | restFlow <= 0 = let { !_ = dbgAssert (restFlow == 0) "flew too much?"} in return $ Just accCost | otherwise = do { GM.set distsMCF mempty; GM.set prevVertMCF undefMCF; GM.set prevEdgeMCF undefMCF; let { !_ = dbg ("short")}; runMinCostFlowShortests toRelax src container bufs; let { !_ = dbg ("let's DFS")}; !distSink <- UM.read distsMCF sink; if distSink == mempty then do { let { !_ = dbg ("failure")}; return Nothing} else do { !deltaFlow <- flip fix (restFlow, sink) $ \ loop (!flow, !v2) -> do { if v2 == src then return flow else do { !v1 <- UM.read prevVertMCF v2; !i12 <- UM.read prevEdgeMCF v2; let { !_ = dbg ("read", v1, v2, i12)}; !cap12 <- UM.read edgeCapMCF i12; loop (min flow cap12, v1)}}; let { !_ = dbg (deltaFlow)}; let { !_ = dbgAssert (deltaFlow >= 0) $ "negative delta flow?"}; let { accCost' = accCost + toRelax deltaFlow * distSink}; let { restFlow' = restFlow - deltaFlow}; flip fix sink $ \ loop v2 -> do { if v2 == src then return () else do { !v1 <- UM.read prevVertMCF v2; !i12 <- UM.read prevEdgeMCF v2; let { !i21 = edgeRevIndexMCF U.! i12}; UM.modify edgeCapMCF (subtract deltaFlow) i12; UM.modify edgeCapMCF (+ deltaFlow) i21; loop v1}}; run accCost' restFlow'}}}; run (toRelax 0) targetFlow};runMinCostFlowShortests :: (Show (f (CostMCF c)), U.Unbox (f (CostMCF c)), Monoid (f (CostMCF c)), Ord (f (CostMCF c)), Num (f (CostMCF c)), Show c, U.Unbox c, Num c, Ord c, Bounded c, PrimMonad m) => (CostMCF c -> f (CostMCF c)) -> Vertex -> MinCostFlow (PrimState m) c -> MinCostFlowBuffer (f (CostMCF c)) (PrimState m) c -> m ();runMinCostFlowShortests !toRelax !src MinCostFlow{..} MinCostFlowBuffer{..} = do { UM.write distsMCF src (toRelax 0); fix $ \ loop -> do { !b <- (\ f -> U.foldM' f False (U.generate nVertsMCF id)) $ \ !anyUpdate v1 -> do { !d1 <- UM.read distsMCF v1; if d1 == mempty then do { return anyUpdate} else do { let { !iStart = offsetsMCF U.! v1; !iEnd = offsetsMCF U.! (v1 + 1)}; (\ f -> U.foldM' f anyUpdate (U.generate (iEnd - iStart) (+ iStart))) $ \ !anyUpdate i12 -> do { let { !v2 = edgeDstMCF U.! i12}; !cap12 <- UM.read edgeCapMCF i12; let { !cost12 = edgeCostMCF U.! i12}; !d2 <- UM.read distsMCF v2; let { d2' = d1 + toRelax cost12}; let { !_ = dbg ((v1, v2), (d1, d2, d2'), d2 /= d2' && (d2 <> d2' == d2'))}; if cap12 > 0 && d2 /= d2' && (d2 <> d2' == d2') then do { UM.write distsMCF v2 d2'; UM.write prevVertMCF v2 v1; UM.write prevEdgeMCF v2 i12; return True} else do { return anyUpdate}}}}; when b $ do { loop}}};data IxVector i v = IxVector{boundsIV :: !(i, i), vecIV :: !v} deriving (Show, Eq);type IxUVector i a = IxVector i (U.Vector a);type IxMUVector s i a = IxVector i (UM.MVector s a);{-# INLINE (@!) #-};(@!) :: (HasCallStack, Ix i, G.Vector v a) => IxVector i (v a) -> i -> a;(@!) IxVector{..} i = vecIV G.! index boundsIV i;{-# INLINE (@!!) #-};(@!!) :: (Ix i, G.Vector v a) => IxVector i (v a) -> i -> a;(@!!) IxVector{..} i = G.unsafeIndex vecIV (unsafeIndex boundsIV i);{-# INLINE (@!?) #-};(@!?) :: (HasCallStack, Ix i, G.Vector v a) => IxVector i (v a) -> i -> Maybe a;(@!?) IxVector{..} i | inRange boundsIV i = Just (vecIV G.! index boundsIV i) | otherwise = Nothing;{-# INLINE (@!!?) #-};(@!!?) :: (Ix i, G.Vector v a) => IxVector i (v a) -> i -> Maybe a;(@!!?) IxVector{..} i | inRange boundsIV i = Just (G.unsafeIndex vecIV (unsafeIndex boundsIV i)) | otherwise = Nothing;{-# INLINE lengthIV #-};lengthIV :: (G.Vector v a) => IxVector i (v a) -> Int;lengthIV = G.length . vecIV;{-# INLINE findIndexIV #-};findIndexIV :: (G.Vector v a, Unindex i) => IxVector i (v a) -> (a -> Bool) -> Maybe i;findIndexIV IxVector{..} f = unindex boundsIV <$> G.findIndex f vecIV;{-# INLINE mapIV #-};mapIV :: (U.Unbox a, U.Unbox b) => (a -> b) -> IxVector i (U.Vector a) -> IxVector i (U.Vector b);mapIV !f IxVector{..} = IxVector boundsIV $ U.map f vecIV;{-# INLINE imapIV #-};imapIV :: (Unindex i, U.Unbox a, U.Unbox b) => (i -> a -> b) -> IxVector i (U.Vector a) -> IxVector i (U.Vector b);imapIV !f IxVector{..} = IxVector boundsIV $ U.imap (f . unindex boundsIV) vecIV;{-# INLINE zipWithIV #-};zipWithIV :: (U.Unbox a, U.Unbox b, U.Unbox c) => (a -> b -> c) -> IxVector i (U.Vector a) -> IxVector i (U.Vector b) -> IxVector i (U.Vector c);zipWithIV !f !vec1 !vec2 = IxVector bnd $ U.zipWith f (vecIV vec1) (vecIV vec2) where { !bnd = boundsIV vec1};{-# INLINE accumulateIV #-};accumulateIV :: (Ix i, U.Unbox i, U.Unbox a, U.Unbox b) => (a -> b -> a) -> IxVector i (U.Vector a) -> IxVector i (U.Vector (i, b)) -> IxVector i (U.Vector a);accumulateIV !f !vec0 !commands = let { !input1d = U.map (first (index bnd)) (vecIV commands); !vec1d = U.accumulate f (vecIV vec0) input1d} in IxVector bnd vec1d where { !bnd = boundsIV vec0; !_ = dbgAssert (boundsIV vec0 == boundsIV commands)};{-# INLINE createIV #-};createIV :: (G.Vector v a) => (forall s . ST s (IxVector i (G.Mutable v s a))) -> IxVector i (v a);createIV st = runST $ do { iv <- st; let { bnd = boundsIV iv}; IxVector bnd <$> G.unsafeFreeze (vecIV iv)};{-# INLINE generateIV #-};generateIV :: (Unindex i, U.Unbox a) => (i, i) -> (i -> a) -> IxUVector i a;generateIV bnd f = IxVector bnd $ U.generate (rangeSize bnd) (f . unindex bnd);{-# INLINE constructIV #-};constructIV :: (Unindex i, U.Unbox a) => (i, i) -> (IxUVector i a -> i -> a) -> IxUVector i a;constructIV bnd f = IxVector bnd $ U.constructN (rangeSize bnd) $ \ sofar -> f (IxVector bnd sofar) $! unindex bnd (G.length sofar);{-# INLINE constructMIV #-};constructMIV :: forall i a m . (Unindex i, PrimMonad m, U.Unbox a) => (i, i) -> (IxUVector i a -> i -> m a) -> m (U.Vector a);constructMIV bnd@(!_, !_) f = do { v <- GM.new n; v' <- G.unsafeFreeze v; fill v' 0} where { !n = rangeSize bnd; fill :: U.Vector a -> Int -> m (U.Vector a); fill !v i | i < n = do { x <- f (IxVector bnd (G.unsafeTake i v)) (unindex bnd i); G.elemseq v x $ do { v' <- G.unsafeThaw v; GM.unsafeWrite v' i x; v'' <- G.unsafeFreeze v'; fill v'' (i + 1)}}; fill v _ = return v};{-# INLINE thawIV #-};thawIV :: (PrimMonad m, G.Vector v a) => IxVector i (v a) -> m (IxVector i (G.Mutable v (PrimState m) a));thawIV iv = IxVector (boundsIV iv) <$> G.thaw (vecIV iv);{-# INLINE unsafeThawIV #-};unsafeThawIV :: (PrimMonad m, G.Vector v a) => IxVector i (v a) -> m (IxVector i (G.Mutable v (PrimState m) a));unsafeThawIV iv = IxVector (boundsIV iv) <$> G.thaw (vecIV iv);{-# INLINE freezeIV #-};freezeIV :: (PrimMonad m, G.Vector v a) => IxVector i (G.Mutable v (PrimState m) a) -> m (IxVector i (v a));freezeIV iv = IxVector (boundsIV iv) <$> G.freeze (vecIV iv);{-# INLINE unsafeFreezeIV #-};unsafeFreezeIV :: (PrimMonad m, G.Vector v a) => IxVector i (G.Mutable v (PrimState m) a) -> m (IxVector i (v a));unsafeFreezeIV iv = IxVector (boundsIV iv) <$> G.unsafeFreeze (vecIV iv);{-# INLINE newIV #-};newIV :: (Ix i, PrimMonad m, U.Unbox a) => (i, i) -> a -> m (IxMUVector (PrimState m) i a);newIV bnd e0 = IxVector bnd <$> UM.replicate (rangeSize bnd) e0;{-# INLINE readIV #-};readIV :: (HasCallStack, Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> m a;readIV IxVector{..} i = GM.read vecIV (index boundsIV i);{-# INLINE readMayIV #-};readMayIV :: (HasCallStack, Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> m (Maybe a);readMayIV IxVector{..} i | not (inRange boundsIV i) = return Nothing | otherwise = Just <$> GM.read vecIV (index boundsIV i);{-# INLINE unsafeReadIV #-};unsafeReadIV :: (Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> m a;unsafeReadIV IxVector{..} i = GM.unsafeRead vecIV (unsafeIndex boundsIV i);{-# INLINE writeIV #-};writeIV :: (HasCallStack, Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> a -> m ();writeIV IxVector{..} i = GM.write vecIV (index boundsIV i);{-# INLINE unsafeWriteIV #-};unsafeWriteIV :: (Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> a -> m ();unsafeWriteIV IxVector{..} i = GM.unsafeWrite vecIV (unsafeIndex boundsIV i);{-# INLINE modifyIV #-};modifyIV :: (HasCallStack, Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> (a -> a) -> i -> m ();modifyIV IxVector{..} !alter i = GM.modify vecIV alter (index boundsIV i);{-# INLINE unsafeModifyIV #-};unsafeModifyIV :: (Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> (a -> a) -> i -> m ();unsafeModifyIV IxVector{..} !alter i = GM.unsafeModify vecIV alter (unsafeIndex boundsIV i);{-# INLINE modifyMIV #-};modifyMIV :: (HasCallStack, Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> (a -> m a) -> i -> m ();modifyMIV IxVector{..} !alter i = GM.modifyM vecIV alter (index boundsIV i);{-# INLINE unsafeModifyMIV #-};unsafeModifyMIV :: (Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> (a -> m a) -> i -> m ();unsafeModifyMIV IxVector{..} !alter i = GM.unsafeModifyM vecIV alter (unsafeIndex boundsIV i);{-# INLINE swapIV #-};swapIV :: (HasCallStack, Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> i -> m ();swapIV IxVector{..} !i1 !i2 = GM.swap vecIV (index boundsIV i1) (index boundsIV i2);{-# INLINE unsafeSwapIV #-};unsafeSwapIV :: (Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> i -> m ();unsafeSwapIV IxVector{..} !i1 !i2 = GM.unsafeSwap vecIV (unsafeIndex boundsIV i1) (unsafeIndex boundsIV i2);{-# INLINE exchangeIV #-};exchangeIV :: (HasCallStack, Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> a -> m a;exchangeIV IxVector{..} i = GM.exchange vecIV (index boundsIV i);{-# INLINE unsafeExchangeIV #-};unsafeExchangeIV :: (Ix i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> a -> m a;unsafeExchangeIV IxVector{..} i = GM.unsafeExchange vecIV (index boundsIV i);{-# INLINE csum2D #-};csum2D :: (HasCallStack, Num a, U.Unbox a) => IxUVector (Int, Int) a -> IxUVector (Int, Int) a;csum2D !gr = IxVector bnd $ U.constructN (rangeSize bnd) $ \ sofar -> case unindex bnd (G.length sofar) of { (0, _) -> 0; (_, 0) -> 0; (!y, !x) -> v0 + fromY + fromX - fromD where { v0 = gr @! (y - 1, x - 1); fromY = IxVector bnd sofar @! (y - 1, x); fromX = IxVector bnd sofar @! (y, x - 1); fromD = IxVector bnd sofar @! (y - 1, x - 1)}} where { !bnd = second (both (+ 1)) (boundsIV gr)};{-# INLINE (@+!) #-};(@+!) :: (HasCallStack, Num a, U.Unbox a) => IxUVector (Int, Int) a -> ((Int, Int), (Int, Int)) -> a;(@+!) !csum ((!y1, !x1), (!y2, !x2)) = s1 + s4 - s2 - s3 where { !s1 = csum @! (y2 + 1, x2 + 1); !s2 = csum @! (y1, x2 + 1); !s3 = csum @! (y2 + 1, x1); !s4 = csum @! (y1, x1)};data SparseGraph i w = SparseGraph{boundsSG :: !(i, i), nVertsSG :: !Int, nEdgesSG :: !Int, offsetsSG :: !(U.Vector Int), adjacentsSG :: !(U.Vector Vertex), edgeWeightsSG :: !(U.Vector w)} deriving (Show);{-# INLINE buildSG #-};buildSG :: (Unindex i) => (i, i) -> U.Vector (i, i) -> SparseGraph i ();buildSG !boundsSG !edges = buildRawSG boundsSG $ U.map (\ (!i1, !i2) -> (ix i1, ix i2, ())) edges where { ix = index boundsSG};{-# INLINE buildWSG #-};buildWSG :: (Unindex i, UM.Unbox w) => (i, i) -> U.Vector (i, i, w) -> SparseGraph i w;buildWSG !boundsSG !edges = buildRawSG boundsSG $ U.map (\ (!i1, !i2, !w) -> (ix i1, ix i2, w)) edges where { ix = index boundsSG};{-# INLINE buildRawSG #-};buildRawSG :: (Unindex i, UM.Unbox w) => (i, i) -> U.Vector (Vertex, Vertex, w) -> SparseGraph i w;buildRawSG !boundsSG !edges = let { !nEdgesSG = U.length edges; !nVertsSG = rangeSize boundsSG; !offsetsSG = U.scanl' (+) 0 $ U.create $ do { !outDegs <- UM.replicate nVertsSG (0 :: Int); U.forM_ edges $ \ (!v1, !_, !_) -> do { UM.modify outDegs (+ 1) v1}; return outDegs}; !_ = dbgAssert (U.last offsetsSG == nEdgesSG); (!adjacentsSG, !edgeWeightsSG) = runST $ do { !mOffsets <- U.thaw offsetsSG; !mAdjacents <- UM.unsafeNew nEdgesSG; !mWeights <- UM.unsafeNew nEdgesSG; U.forM_ edges $ \ (!v1, !v2, !w) -> do { !iEdgeFlatten <- UM.unsafeRead mOffsets v1; UM.unsafeWrite mOffsets v1 (iEdgeFlatten + 1); UM.unsafeWrite mAdjacents iEdgeFlatten v2; UM.unsafeWrite mWeights iEdgeFlatten w}; (,) <$> U.unsafeFreeze mAdjacents <*> U.unsafeFreeze mWeights}} in SparseGraph{..};{-# INLINE adj #-};adj :: SparseGraph i w -> Vertex -> U.Vector Vertex;adj SparseGraph{..} v = U.unsafeSlice o1 (o2 - o1) adjacentsSG where { !o1 = U.unsafeIndex offsetsSG v; !o2 = U.unsafeIndex offsetsSG (v + 1)};{-# INLINE eAdj #-};eAdj :: SparseGraph i w -> Vertex -> U.Vector (EdgeId, Vertex);eAdj SparseGraph{..} v = U.imap ((,) . (+ o1)) vs where { !o1 = U.unsafeIndex offsetsSG v; !o2 = U.unsafeIndex offsetsSG (v + 1); !vs = U.unsafeSlice o1 (o2 - o1) adjacentsSG};{-# INLINE adjIx #-};adjIx :: (Unindex i) => SparseGraph i w -> i -> U.Vector i;adjIx gr i = U.map (unindex (boundsSG gr)) $ adj gr v where { !v = index (boundsSG gr) i};{-# INLINE adjW #-};adjW :: (U.Unbox w) => SparseGraph i w -> Vertex -> U.Vector (Vertex, w);adjW SparseGraph{..} v = U.zip vs ws where { !o1 = U.unsafeIndex offsetsSG v; !o2 = U.unsafeIndex offsetsSG (v + 1); !vs = U.unsafeSlice o1 (o2 - o1) adjacentsSG; !ws = U.unsafeSlice o1 (o2 - o1) edgeWeightsSG};{-# INLINE adjIxW #-};adjIxW :: (Unindex i, U.Unbox w) => SparseGraph i w -> i -> U.Vector (i, w);adjIxW gr i = U.map (first (unindex (boundsSG gr))) $ adjW gr v where { !v = index (boundsSG gr) i};dfsSG :: (Unindex i) => SparseGraph i w -> i -> IxVector i (U.Vector Int);dfsSG gr@SparseGraph{..} !sourceIx = IxVector boundsSG $ U.create $ do { let { !undef = -1 :: Int}; !dist <- UM.replicate nVertsSG undef; flip fix (0 :: Int, index boundsSG sourceIx) $ \ loop (!depth, !v1) -> do { UM.write dist v1 depth; U.forM_ (gr `adj` v1) $ \ v2 -> do { !d <- UM.read dist v2; when (d == undef) $ do { loop (succ depth, v2)}}}; return dist};dfsEveryPathSG :: SparseGraph Int Int -> Int -> Int;dfsEveryPathSG gr@SparseGraph{..} !source = runST $ do { !vis <- UM.replicate nVertsSG False; flip fix (0 :: Int, source) $ \ loop (!d1, !v1) -> do { UM.write vis v1 True; !v2s <- U.filterM (fmap not . UM.read vis . fst) $ gr `adjW` v1; !maxDistance <- fmap (U.foldl' max (0 :: Int)) . U.forM v2s $ \ (!v2, !w) -> do { loop (d1 + w, v2)}; UM.write vis v1 False; return $ max d1 maxDistance}};nonGenericDfs :: (PrimMonad m) => Int -> (Vertex -> m (U.Vector Vertex)) -> (Vertex -> m ()) -> Vertex -> m ();nonGenericDfs !nVerts !gr !visit !v0 = do { !vis <- UM.replicate nVerts False; UM.write vis v0 True; flip fix v0 $ \ loop v1 -> do { !vs <- gr v1; U.forM_ vs $ \ v2 -> do { !b <- UM.read vis v2; unless b $ do { UM.write vis v2 True; visit v2; loop v2; return ()}}}};componentsVecSG :: (Ix i) => SparseGraph i w -> i -> IxVector i (U.Vector Bool);componentsVecSG gr@SparseGraph{..} !sourceIx = IxVector boundsSG $ U.create $ do { !vis <- UM.replicate nVertsSG False; flip fix source $ \ loop v1 -> do { UM.write vis v1 True; let { !v2s = gr `adj` v1}; U.forM_ v2s $ \ v2 -> do { !visited <- UM.read vis v2; unless visited $ do { loop v2}}}; return vis} where { !source = index boundsSG sourceIx :: Vertex};bfsSG :: (Ix i) => SparseGraph i w -> i -> IxVector i (U.Vector Int);bfsSG gr@SparseGraph{..} !sourceIx = IxVector boundsSG $ genericBfs (gr `adj`) nVertsSG (index boundsSG sourceIx);genericBfs :: (Int -> U.Vector Int) -> Int -> Vertex -> U.Vector Int;genericBfs !gr !nVerts !source = U.create $ do { let { !undef = -1 :: Int}; !dist <- UM.replicate nVerts undef; !queue <- newBufferAsQueue nVerts; pushBack queue source; UM.unsafeWrite dist source (0 :: Int); fix $ \ loop -> do { popFront queue >>= \case { Nothing -> return (); Just !v1 -> do { !d1 <- UM.unsafeRead dist v1; U.forM_ (gr v1) $ \ v2 -> do { !lastD <- UM.unsafeRead dist v2; when (lastD == undef) $ do { UM.unsafeWrite dist v2 (d1 + 1); pushBack queue v2}}; loop}}}; return dist};genericBfs01 :: (Ix i, U.Unbox i) => (i, i) -> (i -> U.Vector (i, Int)) -> Int -> U.Vector i -> IxUVector i Int;genericBfs01 !bndExt !gr !nEdges !sources = IxVector bndExt $ U.create $ do { let { !undef = -1 :: Int}; let { !nVertsExt = rangeSize bndExt}; !vec <- IxVector bndExt <$> UM.replicate nVertsExt undef; !deque <- newBufferAsDeque (nEdges + 1); U.forM_ sources $ \ vExt -> do { pushFront deque (0 :: Int, vExt); writeIV vec vExt (0 :: Int)}; let { step !w0 !vExt0 = do { !wReserved0 <- readIV vec vExt0; when (w0 == wReserved0) $ do { U.forM_ (gr vExt0) $ \ (!vExt, !dw) -> do { let { !w = w0 + dw}; !wReserved <- readIV vec vExt; when (wReserved == undef || w < wReserved) $ do { writeIV vec vExt w; if dw == 0 then pushFront deque (w, vExt) else pushBack deque (w, vExt)}}}}}; fix $ \ loop -> popFront deque >>= \case { Nothing -> return (); Just (!w, !vExt) -> do { step w vExt; loop}}; return $ vecIV vec};djSG :: forall i w . (Ix i, U.Unbox i, Num w, Ord w, U.Unbox w) => SparseGraph i w -> w -> U.Vector i -> IxUVector i w;djSG gr@SparseGraph{..} !undef !is0 = IxVector boundsSG $ genericDj (gr `adjW`) nVertsSG nEdgesSG undef (U.map (index boundsSG) is0);genericDj :: forall w . (U.Unbox w, Num w, Ord w) => (Int -> U.Vector (Int, w)) -> Int -> Int -> w -> U.Vector Vertex -> U.Vector w;genericDj !gr !nVerts !nEdges !undef !vs0 = U.create $ do { !dist <- UM.replicate nVerts undef; !heap <- newMinBinaryHeap (nEdges + 1); U.forM_ vs0 $ \ v -> do { UM.write dist v 0; insertBH heap (0, v)}; fix $ \ loop -> deleteFindTopBH heap >>= \case { Nothing -> return (); Just (!w1, !v1) -> do { !newVisit <- (== w1) <$> UM.read dist v1; when newVisit $ do { U.forM_ (gr v1) $ \ (!v2, !dw2) -> do { !w2 <- UM.read dist v2; let { !w2' = merge w1 dw2}; when (w2 == undef || w2' < w2) $ do { UM.write dist v2 w2'; insertBH heap (w2', v2)}}}; loop}}; return dist} where { {-# INLINE merge #-}; merge :: w -> w -> w; merge = (+)};genericSparseDj :: forall w . (U.Unbox w, Num w, Ord w) => (Int -> U.Vector (Int, w)) -> w -> U.Vector Vertex -> IM.IntMap w;genericSparseDj !gr !undef !vs0 = (`execState` IM.empty) $ do { U.forM_ vs0 $ \ v -> do { modify' $ IM.insert v 0}; let { !heap0 = H.fromList $ V.toList $ V.map (H.Entry 0) $ U.convert vs0}; flip fix heap0 $ \ loop !heap -> case H.uncons heap of { Nothing -> return (); Just (H.Entry !w1 !v1, !heap') -> do { !newVisit <- (\case { Just w | w == w1 -> True; _ -> False}) <$> gets (IM.lookup v1); !nextHeap <- if newVisit then do { (\ f -> U.foldM' f heap' (gr v1)) $ \ h (!v2, !dw2) -> do { !w2 <- fromMaybe undef <$> gets (IM.lookup v2); let { !w2' = merge w1 dw2}; if w2 == undef || w2' < w2 then do { modify' $ IM.insert v2 w2'; return $ H.insert (H.Entry w2' v2) h} else do { return h}}} else do { return heap'}; loop nextHeap}}} where { {-# INLINE merge #-}; merge :: w -> w -> w; merge = (+)};dfsPathSG :: (Unindex i) => SparseGraph i w -> i -> i -> Maybe [Vertex];dfsPathSG gr@SparseGraph{..} !sourceIx !sinkIx = runST $ do { let { !undef = -1 :: Int}; !dist <- UM.replicate nVertsSG undef; let { loop !depth !v1 !stack = do { !lastD1 <- UM.read dist v1; if lastD1 /= undef then return Nothing else do { UM.write dist v1 depth; if v1 == sink then return $ Just (v1 : stack) else do { flip fix (gr `adj` v1) $ \ visitNeighbors v2s -> case G.uncons v2s of { Nothing -> return Nothing; Just (!v2, !v2s') -> do { (<|>) <$> loop (succ depth) v2 (v1 : stack) <*> visitNeighbors v2s'}}}}}}; loop (0 :: Int) source []} where { !source = index boundsSG sourceIx; !sink = index boundsSG sinkIx};treeDfsPathSG :: (HasCallStack, Unindex i) => SparseGraph i w -> i -> i -> [Vertex];treeDfsPathSG gr@SparseGraph{..} !sourceIx !sinkIx = fromJust $ runST $ do { let { !undef = -1 :: Int}; let { loop !parent !v1 !stack | v1 == sink = do { return $ Just (v1 : stack)} | otherwise = do { flip fix (U.filter (/= parent) $ gr `adj` v1) $ \ visitNeighbors v2s -> case G.uncons v2s of { Nothing -> return Nothing; Just (!v2, !v2s') -> do { (<|>) <$> loop v1 v2 (v1 : stack) <*> visitNeighbors v2s'}}}}; loop undef source []} where { !source = index boundsSG sourceIx; !sink = index boundsSG sinkIx};createDfsTreeSG :: (Unindex i) => SparseGraph i w -> i -> U.Vector Vertex;createDfsTreeSG gr@SparseGraph{..} !sourceIx = U.create $ do { let { !undef = -1 :: Int}; !prev <- UM.replicate nVertsSG undef; !queue <- newBufferAsQueue nVertsSG; pushBack queue source; fix $ \ loop -> do { popFront queue >>= \case { Nothing -> return (); Just !v1 -> do { U.forM_ (gr `adj` v1) $ \ v2 -> do { !p <- UM.unsafeRead prev v2; when (p == undef) $ do { UM.unsafeWrite prev v2 v1; pushBack queue v2}}; loop}}}; return prev} where { !source = index boundsSG sourceIx};createBfsTreeSG :: (Unindex i) => SparseGraph i w -> i -> U.Vector Vertex;createBfsTreeSG gr@SparseGraph{..} !sourceIx = U.create $ do { let { !undef = -1 :: Int}; !prev <- UM.replicate nVertsSG undef; !queue <- newBufferAsQueue nVertsSG; pushBack queue source; fix $ \ loop -> do { popFront queue >>= \case { Nothing -> return (); Just !v1 -> do { U.forM_ (gr `adj` v1) $ \ v2 -> do { !p <- UM.unsafeRead prev v2; when (p == undef) $ do { UM.unsafeWrite prev v2 v1; pushBack queue v2}}; loop}}}; return prev} where { !source = index boundsSG sourceIx};restorePath :: U.Vector Vertex -> Vertex -> U.Vector Vertex;restorePath !toParent !sink = U.reverse $ U.unfoldr f sink where { f !v | v == (-2) = Nothing | v' == (-1) = Just (v, -2) | otherwise = Just (v, v') where { v' = toParent U.! v}};topSortSG :: SparseGraph i w -> [Vertex];topSortSG gr@SparseGraph{..} = runST $ do { !vis <- UM.replicate nVertsSG False; let { dfsM !acc !v = do { UM.unsafeRead vis v >>= \case { True -> return acc; False -> do { UM.unsafeWrite vis v True; !vs <- U.filterM (fmap not . UM.unsafeRead vis) $ gr `adj` v; (v :) <$> U.foldM' dfsM acc vs}}}}; U.foldM' dfsM [] (U.generate nVertsSG id)};revTopScc1SG :: forall i w m . (PrimMonad m) => SparseGraph i w -> UM.MVector (PrimState m) Bool -> Vertex -> m [Vertex];revTopScc1SG !gr' !vis !v0 = do { flip fix ([], v0) $ \ loop (!acc, !v) -> do { UM.unsafeRead vis v >>= \case { True -> return acc; False -> do { UM.unsafeWrite vis v True; !vs <- U.filterM (fmap not . UM.unsafeRead vis) $ gr' `adj` v; (v :) <$> U.foldM' (curry loop) acc vs}}}};revSG :: (Unindex i, U.Unbox w) => SparseGraph i w -> SparseGraph i w;revSG SparseGraph{..} = buildRawSG boundsSG edges' where { !vws = U.zip adjacentsSG edgeWeightsSG; !edges' = flip U.concatMap (U.generate nVertsSG id) $ \ v1 -> let { !o1 = U.unsafeIndex offsetsSG v1; !o2 = U.unsafeIndex offsetsSG (v1 + 1); !vw2s = U.unsafeSlice o1 (o2 - o1) vws} in U.map (\ (v2, !w2) -> (v2, v1, w2)) vw2s};revTopSccSG :: (Unindex i, U.Unbox w) => SparseGraph i w -> [[Int]];revTopSccSG gr = collectSccPreorderSG $ topSortSG gr where { !gr' = revSG gr; collectSccPreorderSG :: [Int] -> [[Int]]; collectSccPreorderSG !topVerts = runST $ do { !vis <- UM.replicate (nVertsSG gr) False; filter (not . null) <$> mapM (revTopScc1SG gr' vis) topVerts}};topSccSG :: (Unindex i, U.Unbox w) => SparseGraph i w -> [[Int]];topSccSG = map reverse . revTopSccSG;{-# INLINE collectMST #-};collectMST :: (Ord w, U.Unbox w) => Int -> U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);collectMST nVerts edges = runST $ do { uf <- newMUF nVerts; flip U.unfoldrM edges' $ \ es0 -> flip fix es0 $ \ loop es -> case U.uncons es of { Nothing -> return Nothing; Just (e@(!v1, !v2, !_), !es') -> do { unifyMUF uf v1 v2 >>= \case { False -> loop es'; True -> return $ Just (e, es')}}}} where { edges' = U.modify (VAI.sortBy (comparing thd3)) edges};{-# INLINE buildMST #-};buildMST :: (Ord w, U.Unbox w) => Int -> U.Vector (Int, Int, w) -> SparseGraph Int w;buildMST nVerts edges = buildWSG (0, nVerts - 1) $ U.concatMap expand $ collectMST nVerts edges where { {-# INLINE expand #-}; expand (!v1, !v2, !w) = U.fromListN 2 [(v1, v2, w), (v2, v1, w)]};distsNN :: (U.Unbox w, Num w, Ord w) => Int -> w -> U.Vector (Int, Int, w) -> IxUVector (Int, Int) w;distsNN !nVerts !undef !wEdges = IxVector bnd $ U.create $ do { !vec <- UM.replicate (nVerts * nVerts) undef; U.forM_ wEdges $ \ (!v1, !v2, !w) -> do { UM.write vec (index bnd (v1, v2)) w}; forM_ [0 .. nVerts - 1] $ \ k -> do { forM_ [0 .. nVerts - 1] $ \ i -> do { forM_ [0 .. nVerts - 1] $ \ j -> do { !x1 <- UM.read vec (index bnd (i, j)); !x2 <- do { !tmp1 <- UM.read vec (index bnd (i, k)); !tmp2 <- UM.read vec (index bnd (k, j)); return $! bool (tmp1 + tmp2) undef $ tmp1 == undef || tmp2 == undef}; UM.write vec (index bnd (i, j)) $! min x1 x2}}}; return vec} where { bnd :: ((Int, Int), (Int, Int)); bnd = ((0, 0), (nVerts - 1, nVerts - 1))};data TF a = T !a | F !a;asTF :: a -> Bool -> TF a;asTF x True = T x; asTF x False = F x;data TwoSatBuilder s = TwoSatBuilder{nVarsTSB :: !Int, bufTSB :: !(Buffer s (Int, Int))};newTSB :: (PrimMonad m) => Int -> Int -> m (TwoSatBuilder (PrimState m));newTSB !nVarsTSB !nMaxEdges = do { !bufTSB <- newBufferAsQueue nMaxEdges; return TwoSatBuilder{..}};addOrClauseTSB :: (PrimMonad m) => TwoSatBuilder (PrimState m) -> TF Int -> TF Int -> m ();addOrClauseTSB !ts (T !x1) (T !x2) = addOrClauseTSB' ts x1 True x2 True; addOrClauseTSB !ts (T !x1) (F !x2) = addOrClauseTSB' ts x1 True x2 False; addOrClauseTSB !ts (F !x1) (T !x2) = addOrClauseTSB' ts x1 False x2 True; addOrClauseTSB !ts (F !x1) (F !x2) = addOrClauseTSB' ts x1 False x2 False;addOrClauseTSB' :: (PrimMonad m) => TwoSatBuilder (PrimState m) -> Int -> Bool -> Int -> Bool -> m ();addOrClauseTSB' TwoSatBuilder{..} x1 b1 x2 b2 = case (b1, b2) of { (True, True) -> do { pushBack bufTSB (x1', x2); pushBack bufTSB (x2', x1)}; (True, False) -> do { pushBack bufTSB (x1', x2'); pushBack bufTSB (x2, x1)}; (False, True) -> do { pushBack bufTSB (x1, x2); pushBack bufTSB (x2', x1')}; (False, False) -> do { pushBack bufTSB (x1, x2'); pushBack bufTSB (x2, x1')}} where { !_ = dbgAssert (inRange (0, nVarsTSB - 1) x1) $ "invalid var index: " ++ show x1; !_ = dbgAssert (inRange (0, nVarsTSB - 1) x2) $ "invalid var index: " ++ show x2; !x1' = x1 + nVarsTSB; !x2' = x2 + nVarsTSB};solveTS :: Int -> U.Vector (Int, Int) -> Maybe (U.Vector Bool);solveTS !nVars !constraints = do { let { gr = buildSG (0, 2 * nVars - 1) constraints}; let { !sccs = revTopSccSG gr}; let { !groups = U.create $ do { !vec <- UM.replicate (2 * nVars) (-1 :: Int); forM_ (zip [0 :: Int ..] sccs) $ \ (!iScc, !scc) -> do { forM_ scc $ \ v -> do { UM.write vec v iScc}}; return vec}}; let { !saturatable = U.all (\ x -> groups U.! x /= groups U.! (x + nVars)) (U.generate nVars id)}; if not saturatable then Nothing else Just $ U.map (== 1) $ U.create $ do { !vec <- UM.replicate nVars (-1 :: Int); forM_ sccs $ \ scc -> do { forM_ scc $ \ v -> do { !prev <- UM.read vec (v `mod` nVars); when (prev == (-1)) $ do { UM.write vec (v `mod` nVars) $ bool 1 0 (v < nVars)}}}; return vec}};twoSat :: Int -> Int -> (forall s . TwoSatBuilder s -> ST s ()) -> Maybe (U.Vector Bool);twoSat !nVars !nEdges f = runST $ do { !tsb <- newTSB nVars nEdges; f tsb; !constraints <- unsafeFreezeBuffer (bufTSB tsb); return $ solveTS nVars constraints};int :: IO Int;int = readLn;ints :: IO [Int];ints = unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine;class ReadBS a where { {-# INLINE convertBS #-}; convertBS :: BS.ByteString -> a; default convertBS :: (Read a) => BS.ByteString -> a; convertBS = read . BS.unpack; {-# INLINE readBS #-}; readBS :: BS.ByteString -> (a, BS.ByteString); readBS !bs = let { (!bs1, !bs2) = BS.break isSpace bs} in (convertBS bs1, bs2); {-# INLINE readMayBS #-}; readMayBS :: BS.ByteString -> Maybe (a, BS.ByteString); readMayBS !bs | BS.null bs = Nothing | otherwise = let { (!bs1, !bs2) = BS.break isSpace bs} in Just (convertBS bs1, bs2)};instance ReadBS Int where { {-# INLINE convertBS #-}; convertBS = fst . readBS; {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS = BS.readInt};instance ReadBS Integer where { {-# INLINE convertBS #-}; convertBS = fst . readBS; {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS = BS.readInteger};instance ReadBS Float;instance ReadBS Double;instance ReadBS Char where { {-# INLINE convertBS #-}; convertBS = BS.head};instance ReadBS String where { {-# INLINE convertBS #-}; convertBS = BS.unpack};instance ReadBS BS.ByteString where { {-# INLINE convertBS #-}; convertBS = id};instance (ReadBS a, U.Unbox a) => ReadBS (U.Vector a) where { {-# INLINE convertBS #-}; convertBS = convertG; readBS = (, BS.empty) . convertG; readMayBS !bs | BS.null bs = Nothing | otherwise = Just (readBS bs)};instance (ReadBS a) => ReadBS (V.Vector a) where { {-# INLINE convertBS #-}; convertBS = convertG; readBS = (, BS.empty) . convertG; readMayBS !bs | BS.null bs = Nothing | otherwise = Just (readBS bs)};instance (ReadBS a1, ReadBS a2) => ReadBS (a1, a2) where { {-# INLINE convertBS #-}; convertBS !bs0 = let { (!a1, !bs1) = readBS (BS.dropWhile isSpace bs0); !a2 = convertBS (BS.dropWhile isSpace bs1)} in (a1, a2); {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS !bs0 = do { (!x1, !bs1) <- readMayBS bs0; (!x2, !bs2) <- readMayBS bs1; Just ((x1, x2), bs2)}};instance (ReadBS a1, ReadBS a2, ReadBS a3) => ReadBS (a1, a2, a3) where { {-# INLINE convertBS #-}; convertBS !bs0 = let { (!a1, !bs1) = readBS (BS.dropWhile isSpace bs0); (!a2, !bs2) = readBS (BS.dropWhile isSpace bs1); !a3 = convertBS (BS.dropWhile isSpace bs2)} in (a1, a2, a3); {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS !bs0 = do { (!x1, !bs1) <- readMayBS bs0; (!x2, !bs2) <- readMayBS bs1; (!x3, !bs3) <- readMayBS bs2; Just ((x1, x2, x3), bs3)}};instance (ReadBS a1, ReadBS a2, ReadBS a3, ReadBS a4) => ReadBS (a1, a2, a3, a4) where { {-# INLINE convertBS #-}; convertBS !bs0 = let { (!a1, !bs1) = readBS (BS.dropWhile isSpace bs0); (!a2, !bs2) = readBS (BS.dropWhile isSpace bs1); (!a3, !bs3) = readBS (BS.dropWhile isSpace bs2); !a4 = convertBS (BS.dropWhile isSpace bs3)} in (a1, a2, a3, a4); {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS !bs0 = do { (!x1, !bs1) <- readMayBS bs0; (!x2, !bs2) <- readMayBS bs1; (!x3, !bs3) <- readMayBS bs2; (!x4, !bs4) <- readMayBS bs3; Just ((x1, x2, x3, x4), bs4)}};instance (ReadBS a1, ReadBS a2, ReadBS a3, ReadBS a4, ReadBS a5) => ReadBS (a1, a2, a3, a4, a5) where { {-# INLINE convertBS #-}; convertBS !bs0 = let { (!a1, !bs1) = readBS (BS.dropWhile isSpace bs0); (!a2, !bs2) = readBS (BS.dropWhile isSpace bs1); (!a3, !bs3) = readBS (BS.dropWhile isSpace bs2); (!a4, !bs4) = readBS (BS.dropWhile isSpace bs3); !a5 = convertBS (BS.dropWhile isSpace bs4)} in (a1, a2, a3, a4, a5); {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS !bs0 = do { (!x1, !bs1) <- readMayBS bs0; (!x2, !bs2) <- readMayBS bs1; (!x3, !bs3) <- readMayBS bs2; (!x4, !bs4) <- readMayBS bs3; (!x5, !bs5) <- readMayBS bs4; Just ((x1, x2, x3, x4, x5), bs5)}};instance (ReadBS a1, ReadBS a2, ReadBS a3, ReadBS a4, ReadBS a5, ReadBS a6) => ReadBS (a1, a2, a3, a4, a5, a6) where { {-# INLINE convertBS #-}; convertBS !bs0 = let { (!a1, !bs1) = readBS (BS.dropWhile isSpace bs0); (!a2, !bs2) = readBS (BS.dropWhile isSpace bs1); (!a3, !bs3) = readBS (BS.dropWhile isSpace bs2); (!a4, !bs4) = readBS (BS.dropWhile isSpace bs3); (!a5, !bs5) = readBS (BS.dropWhile isSpace bs4); !a6 = convertBS (BS.dropWhile isSpace bs5)} in (a1, a2, a3, a4, a5, a6); {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS !bs0 = do { (!x1, !bs1) <- readMayBS bs0; (!x2, !bs2) <- readMayBS bs1; (!x3, !bs3) <- readMayBS bs2; (!x4, !bs4) <- readMayBS bs3; (!x5, !bs5) <- readMayBS bs4; (!x6, !bs6) <- readMayBS bs5; Just ((x1, x2, x3, x4, x5, x6), bs6)}};convertG :: (ReadBS a, G.Vector v a) => BS.ByteString -> v a;convertG = G.unfoldr (readMayBS . BS.dropWhile isSpace);convertNG :: (ReadBS a, G.Vector v a) => Int -> BS.ByteString -> v a;convertNG !n = G.unfoldrExactN n (readBS . BS.dropWhile isSpace);auto :: (ReadBS a) => IO a;auto = convertBS <$> BS.getLine;ints1 :: IO Int;ints1 = auto;ints2 :: IO (Int, Int);ints2 = auto;ints3 :: IO (Int, Int, Int);ints3 = auto;ints4 :: IO (Int, Int, Int, Int);ints4 = auto;ints5 :: IO (Int, Int, Int, Int, Int);ints5 = auto;ints6 :: IO (Int, Int, Int, Int, Int, Int);ints6 = auto;ints11 :: IO (Int, Int);ints11 = (\ (!v1, !v2) -> (v1 - 1, v2 - 1)) <$> ints2;ints110 :: IO (Int, Int, Int);ints110 = (\ (!v1, !v2, !w) -> (v1 - 1, v2 - 1, w)) <$> ints3;intsN :: (G.Vector v Int) => Int -> IO (v Int);intsN !w = G.unfoldrExactN w (fromJust . BS.readInt . BS.dropWhile isSpace) <$> BS.getLine;intsG :: (G.Vector v Int) => IO (v Int);intsG = G.unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine;intsV :: IO (V.Vector Int);intsV = intsG;intsU :: IO (U.Vector Int);intsU = intsG;digitsU :: IO (U.Vector Int);digitsU = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> BS.getLine;convertNBS :: forall a . (U.Unbox a, ReadBS a) => Int -> V.Vector BS.ByteString -> U.Vector a;convertNBS !n !bss = U.unfoldrExactN n step $ fromJust (V.uncons bss) where { step :: (BS.ByteString, V.Vector BS.ByteString) -> (a, (BS.ByteString, V.Vector BS.ByteString)); step (!cur, !rest) | BS.null cur' = step $ fromJust (V.uncons rest) | otherwise = let { (!x, !cur'') = readBS cur'} in (x, (cur'', rest)) where { !cur' = BS.dropWhile isSpace cur}};getHW :: (U.Unbox a, ReadBS a) => Int -> Int -> IO (U.Vector a);getHW !h !w = convertNBS (h * w) <$> V.replicateM h BS.getLine;getMat :: Int -> Int -> IO (IxVector (Int, Int) (U.Vector Int));getMat !h !w = IxVector ((0, 0), (h - 1, w - 1)) <$> getHW h w;convertCharsHW :: V.Vector BS.ByteString -> U.Vector Char;convertCharsHW !bss = U.create $ do { !vec <- UM.unsafeNew (h * w); V.iforM_ bss $ \ y bs -> forM_ [0 .. w - 1] $ \ x -> do { let { !char = BS.index bs x}; UM.unsafeWrite vec (w * y + x) char}; return vec} where { !w = BS.length (V.head bss); !h = V.length bss};getGrid :: Int -> Int -> IO (IxUVector (Int, Int) Char);getGrid !h !w = IxVector ((0, 0), (h - 1, w - 1)) . convertCharsHW <$> V.replicateM h BS.getLine;{-# INLINE endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';putBSB :: BSB.Builder -> IO ();putBSB = BSB.hPutBuilder stdout;putLnBSB :: BSB.Builder -> IO ();putLnBSB = BSB.hPutBuilder stdout . (<> endlBSB);class ShowBSB a where { showBSB :: a -> BSB.Builder; default showBSB :: (Show a) => a -> BSB.Builder; showBSB = BSB.string8 . show};instance ShowBSB Int where { showBSB = BSB.intDec};instance ShowBSB Integer where { showBSB = BSB.integerDec};instance ShowBSB Float where { showBSB = BSB.floatDec};instance ShowBSB Double where { showBSB = BSB.doubleDec};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;printBSB :: (ShowBSB a) => a -> IO ();printBSB = putBSB . showBSB;concatBSB :: (G.Vector v a) => (a -> BSB.Builder) -> v a -> BSB.Builder;concatBSB f = G.foldr' ((<>) . f) mempty;unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = concatBSB ((<> BSB.string7 " ") . showBSB);unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = concatBSB showLnBSB;yn :: Bool -> String;yn = bool "No" "Yes";ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");printYn :: Bool -> IO ();printYn = putLnBSB . ynBSB;printList :: (Show a) => [a] -> IO ();printList = putStrLn . unwords . map show;putList :: (Show a) => [a] -> IO ();putList = putStr . unwords . map show;boundsSize2 :: ((Int, Int), (Int, Int)) -> (Int, Int);boundsSize2 ((!y1, !x1), (!y2, !x2)) = (y2 - y1 + 1, x2 - x1 + 1);printGrid :: IxUVector (Int, Int) Char -> IO ();printGrid gr = do { let { !rows = V.unfoldrExactN h (U.splitAt w) (vecIV gr)}; V.forM_ rows $ putStrLn . U.toList} where { (!h, !w) = boundsSize2 (boundsIV gr)};data T2 a b = T2 !a !b deriving (Eq, Show);instance Bifunctor T2 where { {-# INLINE bimap #-}; bimap f g (T2 a b) = let { !a' = f a; !b' = g b} in T2 a' b'; {-# INLINE first #-}; first f (T2 a b) = let { !a' = f a} in T2 a' b; {-# INLINE second #-}; second g (T2 a b) = let { !b' = g b} in T2 a b'};instance (ReadBS a1, ReadBS a2) => ReadBS (T2 a1 a2) where { {-# INLINE convertBS #-}; convertBS !bs0 = let { (!a1, !bs1) = readBS (BS.dropWhile isSpace bs0); !a2 = convertBS (BS.dropWhile isSpace bs1)} in T2 a1 a2; {-# INLINE readBS #-}; readBS = fromJust . readMayBS; {-# INLINE readMayBS #-}; readMayBS !bs0 = do { (!x1, !bs1) <- readMayBS bs0; (!x2, !bs2) <- readMayBS bs1; Just (T2 x1 x2, bs2)}};ints2T :: IO (T2 Int Int);ints2T = auto;ints11T :: IO (T2 Int Int);ints11T = (\ (T2 v1 v2) -> T2 (v1 - 1) (v2 - 1)) <$> ints2T;data instance  UM.MVector s (T2 a b) = MV_T2 !(UM.MVector s a) !(UM.MVector s b);data instance  U.Vector (T2 a b) = V_T2 !(U.Vector a) !(U.Vector b);instance (U.Unbox a, U.Unbox b) => U.Unbox (T2 a b);instance (U.Unbox a, U.Unbox b) => GM.MVector UM.MVector (T2 a b) where { {-# INLINE basicLength #-}; basicLength (MV_T2 as _) = GM.basicLength as; {-# INLINE basicUnsafeSlice #-}; basicUnsafeSlice i n (MV_T2 as bs) = MV_T2 (GM.basicUnsafeSlice i n as) (GM.basicUnsafeSlice i n bs); {-# INLINE basicOverlaps #-}; basicOverlaps (MV_T2 as1 bs1) (MV_T2 as2 bs2) = GM.basicOverlaps as1 as2 || GM.basicOverlaps bs1 bs2; {-# INLINE basicUnsafeNew #-}; basicUnsafeNew n = liftM2 MV_T2 (GM.basicUnsafeNew n) (GM.basicUnsafeNew n); {-# INLINE basicInitialize #-}; basicInitialize (MV_T2 as bs) = do { GM.basicInitialize as; GM.basicInitialize bs}; {-# INLINE basicUnsafeReplicate #-}; basicUnsafeReplicate n (T2 a b) = liftM2 MV_T2 (GM.basicUnsafeReplicate n a) (GM.basicUnsafeReplicate n b); {-# INLINE basicUnsafeRead #-}; basicUnsafeRead (MV_T2 as bs) i = liftM2 T2 (GM.basicUnsafeRead as i) (GM.basicUnsafeRead bs i); {-# INLINE basicUnsafeWrite #-}; basicUnsafeWrite (MV_T2 as bs) i (T2 a b) = do { GM.basicUnsafeWrite as i a; GM.basicUnsafeWrite bs i b}; {-# INLINE basicClear #-}; basicClear (MV_T2 as bs) = do { GM.basicClear as; GM.basicClear bs}; {-# INLINE basicSet #-}; basicSet (MV_T2 as bs) (T2 a b) = do { GM.basicSet as a; GM.basicSet bs b}; {-# INLINE basicUnsafeCopy #-}; basicUnsafeCopy (MV_T2 as1 bs1) (MV_T2 as2 bs2) = do { GM.basicUnsafeCopy as1 as2; GM.basicUnsafeCopy bs1 bs2}; {-# INLINE basicUnsafeMove #-}; basicUnsafeMove (MV_T2 as1 bs1) (MV_T2 as2 bs2) = do { GM.basicUnsafeMove as1 as2; GM.basicUnsafeMove bs1 bs2}; {-# INLINE basicUnsafeGrow #-}; basicUnsafeGrow (MV_T2 as bs) n = liftM2 MV_T2 (GM.basicUnsafeGrow as n) (GM.basicUnsafeGrow bs n)};instance (U.Unbox a, U.Unbox b) => G.Vector U.Vector (T2 a b) where { {-# INLINE basicUnsafeFreeze #-}; basicUnsafeFreeze (MV_T2 as bs) = liftM2 V_T2 (G.basicUnsafeFreeze as) (G.basicUnsafeFreeze bs); {-# INLINE basicUnsafeThaw #-}; basicUnsafeThaw (V_T2 as bs) = liftM2 MV_T2 (G.basicUnsafeThaw as) (G.basicUnsafeThaw bs); {-# INLINE basicLength #-}; basicLength (V_T2 as _) = G.basicLength as; {-# INLINE basicUnsafeSlice #-}; basicUnsafeSlice i n (V_T2 as bs) = V_T2 (G.basicUnsafeSlice i n as) (G.basicUnsafeSlice i n bs); {-# INLINE basicUnsafeIndexM #-}; basicUnsafeIndexM (V_T2 as bs) i = liftM2 T2 (G.basicUnsafeIndexM as i) (G.basicUnsafeIndexM bs i); {-# INLINE basicUnsafeCopy #-}; basicUnsafeCopy (MV_T2 as1 bs1) (V_T2 as2 bs2) = do { G.basicUnsafeCopy as1 as2; G.basicUnsafeCopy bs1 bs2}; {-# INLINE elemseq #-}; elemseq _ (T2 a b) = G.elemseq (undefined :: U.Vector a) a . G.elemseq (undefined :: U.Vector b) b};dbgSTree :: (Show (v a), G.Vector v a, PrimMonad m) => SegmentTree (G.Mutable v) (PrimState m) a -> m ();dbgSTree (SegmentTree mVec nValidLeaves) | debug = do { !vec <- G.unsafeFreeze mVec; let { !leaves = G.take nValidLeaves $ G.drop (G.length vec `div` 2) vec}; let { !_ = dbg leaves}; return ()} | otherwise = return ();dbgSTreeAll :: (Show (v a), G.Vector v a, PrimMonad m) => SegmentTree (G.Mutable v) (PrimState m) a -> m ();dbgSTreeAll (SegmentTree mVec _) | debug = do { !vec <- G.unsafeFreeze mVec; flip fix (0 :: Int, 1 :: Int) $ \ loop (!n, !len) -> do { unless (G.length vec <= len) $ do { let { !vec' = G.take len . G.drop (len - 1) $ vec}; let { !_ = dbgS $ "> " ++ show vec'}; loop (n + 1, 2 * len)}}} | otherwise = return ();dbgLazySTree :: (Show a, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> m ();dbgLazySTree stree@(LazySegmentTree !vec _ _) = dbgSM $ do { let { !nLeaves = GM.length vec `div` 2}; ss <- forM [0 .. nLeaves - 1] $ \ i -> do { !x <- queryLazySTree stree i i; return $ show x}; return $ unwords ss};or1 :: (Monad m) => Bool -> m Bool -> m Bool;or1 True _ = return True; or1 False b = b;and1 :: (Monad m) => Bool -> m Bool -> m Bool;and1 False _ = return False; and1 True b = b;or2 :: (Monad m) => m Bool -> m Bool -> m Bool;or2 x y = do { b <- x; or1 b y};and2 :: (Monad m) => m Bool -> m Bool -> m Bool;and2 x y = do { b <- x; and1 b y};class ShowGrid a where { showGrid :: a -> String; showGridN :: Int -> a -> String};instance (G.Vector v a, Show a) => ShowGrid (IxVector (Int, Int) (v a)) where { showGrid = showGridN 0; showGridN !len !grid = unlines $ map f [y0 .. y1] where { ((!y0, !x0), (!y1, !x1)) = boundsIV grid; f !y = unwords $ map (showN . (grid @!) . (y,)) [x0 .. x1]; showN x = let { !s = show x; !lenX = length s} in replicate (len - lenX) ' ' ++ s}};dbgGrid :: (ShowGrid a) => a -> ();dbgGrid gr = dbgS (showGrid gr);dbgGridM :: (PrimMonad m, G.Vector v a, Show a, ShowGrid (IxVector (Int, Int) (v a))) => IxVector (Int, Int) (G.Mutable v (PrimState m) a) -> m ();dbgGridM gr = when debug $ do { !gr' <- unsafeFreezeIV gr; let { !_ = trace (showGridN 4 gr') ()}; return ()};dbgGridId :: (ShowGrid a) => a -> a;dbgGridId gr = let { !_ = dbgS (showGrid gr)} in gr;dbgGridN :: (ShowGrid a) => Int -> a -> ();dbgGridN len gr = dbgS (showGridN len gr);dbgGridNId :: (ShowGrid a) => Int -> a -> a;dbgGridNId len gr = let { !_ = dbgS (showGridN len gr)} in gr;{-# INLINE flipOrder #-};flipOrder :: Ordering -> Ordering;flipOrder = \case { GT -> LT; LT -> GT; EQ -> EQ};{-# INLINE square #-};square :: (Num a) => a -> a;square !x = x * x;{-# INLINE isqrt #-};isqrt :: Int -> Int;isqrt = round @Double . sqrt . fromIntegral;{-# INLINE modifyArray #-};modifyArray :: (MArray a e m, Ix i) => a i e -> (e -> e) -> i -> m ();modifyArray !ary !f !i = do { !v <- f <$> readArray ary i; writeArray ary i v};{-# INLINE (.:) #-};(.:) :: (b -> c) -> (a1 -> a2 -> b) -> (a1 -> a2 -> c);(.:) = (.) . (.);{-# INLINE swapDupeU #-};swapDupeU :: U.Vector (Int, Int) -> U.Vector (Int, Int);swapDupeU = U.concatMap (\ vs -> U.fromListN 2 [vs, swap vs]);{-# INLINE swapDupeW #-};swapDupeW :: U.Vector (Int, Int, Int) -> U.Vector (Int, Int, Int);swapDupeW = U.concatMap (\ (!v1, !v2, !d) -> U.fromListN 2 [(v1, v2, d), (v2, v1, 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 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 repM_ #-};repM_ :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ();repM_ !l !r !act = inner l where { inner !i | i > r = return () | otherwise = act i >> inner (succ i)};{-# INLINE repRM_ #-};repRM_ :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ();repRM_ !l !r !act = inner r where { inner !i | i < l = return () | otherwise = act i >> inner (pred i)};{-# 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;{-# INLINE sortMo #-};sortMo :: Int -> U.Vector (Int, Int) -> U.Vector Int;sortMo !maxL !lrs = U.modify (VAI.sortBy compareF) (G.generate (G.length lrs) id) where { !q = G.length lrs; !blockLength = max 1 . ceiling @Double $ (fromIntegral maxL / sqrt (fromIntegral q)); compareF !i1 !i2 = let { (!l1, !r1) = lrs U.! i1; (!l2, !r2) = lrs U.! i2; !b1 = l1 `div` blockLength; !b2 = l2 `div` blockLength; !res = compare b1 b2 <> bool (compare r2 r1) (compare r1 r2) (even b1)} in res};runMoG :: (PrimMonad m, U.Unbox x, G.Vector v b) => U.Vector x -> U.Vector (Int, Int) -> (a -> x -> m a) -> (a -> x -> m a) -> (a -> x -> m a) -> (a -> x -> m a) -> (a -> b) -> a -> m (v b);runMoG !xs !lrs !onInsL !onInsR !onRemL !onRemR !extract !state0 = do { !result <- GM.unsafeNew q; U.foldM'_ (step result) ((0 :: Int, -1 :: Int), state0) (sortMo maxL lrs); G.unsafeFreeze result} where { !q = G.length lrs; !maxL = U.maximum (U.map fst lrs); step result ((!l0, !r0), !s0) iLrs = do { let { (!l, !r) = lrs U.! iLrs}; !s' <- do { !s1 <- U.foldM' onInsL s0 (slice l (l0 - 1) xs); !s2 <- U.foldM' onInsR s1 (slice (r0 + 1) r xs); !s3 <- U.foldM' onRemL s2 (slice l0 (l - 1) xs); !s4 <- U.foldM' onRemR s3 (slice (r + 1) r0 xs); return s4}; GM.unsafeWrite result iLrs $! extract s'; return ((l, r), s')}};runMoPureG :: (U.Unbox x, G.Vector v b) => U.Vector x -> U.Vector (Int, Int) -> (a -> x -> a) -> (a -> x -> a) -> (a -> x -> a) -> (a -> x -> a) -> (a -> b) -> a -> v b;runMoPureG !xs !lrs !onInsL !onInsR !onRemL !onRemR !extract !state0 = runST $ do { runMoG xs lrs (return .: onInsL) (return .: onInsR) (return .: onRemL) (return .: onRemR) extract state0};runMo :: (PrimMonad m, U.Unbox x, U.Unbox b) => U.Vector x -> U.Vector (Int, Int) -> (a -> x -> m a) -> (a -> x -> m a) -> (a -> x -> m a) -> (a -> x -> m a) -> (a -> b) -> a -> m (U.Vector b);runMo = runMoG;runMoPure :: (U.Unbox x, U.Unbox b) => U.Vector x -> U.Vector (Int, Int) -> (a -> x -> a) -> (a -> x -> a) -> (a -> x -> a) -> (a -> x -> a) -> (a -> b) -> a -> U.Vector b;runMoPure = runMoPureG;simpleRunMo :: (PrimMonad m, U.Unbox x, U.Unbox a) => U.Vector x -> U.Vector (Int, Int) -> (a -> x -> m a) -> (a -> x -> m a) -> a -> m (U.Vector a);simpleRunMo !xs !lrs !onIns !onRem !state0 = runMo xs lrs onIns onIns onRem onRem id state0;simpleRunMoPure :: (U.Unbox x, U.Unbox a) => U.Vector x -> U.Vector (Int, Int) -> (a -> x -> a) -> (a -> x -> a) -> a -> U.Vector a;simpleRunMoPure !xs !lrs !onIns !onRem !state0 = runMoPure xs lrs onIns onIns onRem onRem id state0;exgcd :: (Integral a) => a -> a -> (a, a, a);exgcd a b = f $ go a b 1 0 0 1 where { go r0 r1 s0 s1 t0 t1 | r1 == 0 = (r0, s0, t0) | otherwise = go r1 r2 s1 s2 t1 t2 where { (!q, !r2) = r0 `divMod` r1; s2 = s0 - q * s1; t2 = t0 - q * t1}; f (!g, !u, !v) | g < 0 = (-g, -u, -v) | otherwise = (g, u, v)};invModGcd :: (Integral a) => a -> a -> Maybe a;invModGcd a m = case exgcd a m of { (1, na, _) -> Just na; (-1, na, _) -> Just (-na); _ -> Nothing};{-# INLINE msbOf #-};msbOf :: Int -> Int;msbOf !x = 63 - countLeadingZeros x;{-# INLINE lsbOf #-};lsbOf :: Int -> Int;lsbOf = countTrailingZeros;{-# INLINE bitsOf #-};bitsOf :: Int -> U.Vector Int;bitsOf x0 = U.unfoldrExactN (popCount x0) f x0 where { f x = let { !lsb = countTrailingZeros x} in (lsb, clearBit x lsb)};{-# INLINE log2 #-};log2 :: (FiniteBits b) => b -> Int;log2 !x = finiteBitSize x - 1 - countLeadingZeros x;{-# INLINE log2CeilInt #-};log2CeilInt :: Int -> Int;log2CeilInt !x = msb + ceiling_ where { !msb = log2 x; !ceiling_ = if clearBit x msb > 0 then 1 else 0};{-# INLINE bitCeil #-};bitCeil :: Int -> Int;bitCeil = bit . log2CeilInt;{-# INLINE powersetM_ #-};powersetM_ :: (Bits a, Num a, Monad m) => a -> (a -> m ()) -> m ();powersetM_ !is0 !act = act2 is0 where { act2 !is = do { act is; unless (is == 0) (act2 (is0 .&. (is - 1)))}};{-# INLINE powerset #-};powerset :: (Bits a, Num a) => a -> [a];powerset !a = a : unfoldr f a where { f 0 = Nothing; f !x = Just . dupe $! a .&. (x - 1)};{-# INLINE powersetU #-};powersetU :: (Bits a, Num a, U.Unbox a) => a -> U.Vector a;powersetU !x0 = U.unfoldrExactN n f x0 where { !n = bit (popCount x0); f !x = (x, (x - 1) .&. x0)};{-# INLINE unBitSet #-};unBitSet :: Int -> Int -> U.Vector Int;unBitSet n bits = U.filter (testBit bits) (U.generate n id);class BinaryLifting a where { type VecBL a; cacheBL :: a -> VecBL a};{-# INLINE cacheBLU #-};cacheBLU :: (Semigroup a, U.Unbox a) => a -> U.Vector a;cacheBLU = U.iterateN 63 (\ x -> x <> x);{-# INLINE cacheBLV #-};cacheBLV :: (Semigroup a) => a -> V.Vector a;cacheBLV = V.iterateN 63 (\ x -> x <> x);{-# INLINE stimesBL #-};stimesBL :: (Semigroup a, G.Vector v a) => v a -> Int -> a -> a;stimesBL cache n !s0 = U.foldl' step s0 (bitsOf n) where { {-# INLINE step #-}; step !s i = let { !s' = s <> cache G.! i} in s'};{-# INLINE mtimesBL #-};mtimesBL :: (Monoid a, G.Vector v a) => v a -> Int -> a;mtimesBL cache n = stimesBL cache n mempty;{-# INLINE sactBL #-};sactBL :: (SemigroupAction a b, G.Vector v a) => v a -> Int -> b -> b;sactBL cache n !b0 = U.foldl' step b0 (bitsOf n) where { {-# INLINE step #-}; step !b i = let { !b' = cache G.! i `sact` b} in b'};instance SemigroupAction (Product Int) Int where { {-# INLINE sact #-}; sact (Product !x1) !x2 = x1 * x2};instance (Num a, U.Unbox a) => BinaryLifting (Product a) where { type VecBL (Product a) = U.Vector (Product a); {-# INLINE cacheBL #-}; cacheBL = cacheBLU};type Permutation = TransitionalSemigroup ();{-# INLINE idPerm #-};idPerm :: Int -> Permutation;idPerm = TransitionalSemigroup . (`U.generate` (, ()));newtype TransitionalSemigroup a = TransitionalSemigroup (U.Vector (Int, a)) deriving (Show, Eq);{-# INLINE unTransitionalSemigroup #-};unTransitionalSemigroup :: TransitionalSemigroup a -> U.Vector (Int, a);unTransitionalSemigroup (TransitionalSemigroup vec) = vec;instance (U.Unbox a, Semigroup a) => Semigroup (TransitionalSemigroup a) where { {-# INLINE (<>) #-}; TransitionalSemigroup r2 <> TransitionalSemigroup r1 = TransitionalSemigroup $ U.map f r1 where { {-# INLINE f #-}; f (-1, !a) = (-1, a); f (!i, !a) = let { (!i', !a') = r2 U.! i; !a'' = a' <> a} in (i', a'')}};instance (U.Unbox a) => SemigroupAction (TransitionalSemigroup a) Int where { {-# INLINE sact #-}; sact (TransitionalSemigroup _) (-1) = -1; sact (TransitionalSemigroup vec) i = let { (!i', !_) = vec U.! i} in i'};instance (U.Unbox a, SemigroupAction a b) => SemigroupAction (TransitionalSemigroup a) (Int, b) where { {-# INLINE sact #-}; sact (TransitionalSemigroup _) (-1, !b) = (-1, b); sact (TransitionalSemigroup vec) (!i, !b) = let { (!i', !a) = vec U.! i; !b' = a `sact` b} in (i', b')};{-# INLINE idTransitionalSemigroup #-};idTransitionalSemigroup :: (U.Unbox a) => Int -> a -> TransitionalSemigroup a;idTransitionalSemigroup !n !ident = TransitionalSemigroup $ U.generate n (, ident);instance (U.Unbox a, Semigroup a) => BinaryLifting (TransitionalSemigroup a) where { type VecBL (TransitionalSemigroup a) = V.Vector (TransitionalSemigroup a); {-# INLINE cacheBL #-}; cacheBL = cacheBLV};type LcaCache a = (U.Vector Int, TransitionalSemigroup a, VecBL (TransitionalSemigroup a));{-# INLINE lca #-};lca :: (HasCallStack, U.Unbox a) => LcaCache a -> Vertex -> Vertex -> (Vertex, Int);lca (!depths, !_, !toParentN) !v1 !v2 = (vLCA, depths U.! vLCA) where { !d1 = depths U.! v1; !d2 = depths U.! v2; parentN = sactBL toParentN; !v1' = if d1 <= d2 then v1 else v2; !v2' = parentN (abs $ d1 - d2) (if d1 > d2 then v1 else v2); !dLCA = fromJust . snd $ bisect 0 (min d1 d2) $ \ d -> parentN d v1' /= parentN d v2'; !vLCA = parentN dLCA v1'};{-# INLINE lcaLen #-};lcaLen :: (HasCallStack, U.Unbox a) => LcaCache a -> Int -> Int -> Int;lcaLen cache@(!depths, !_, !_) !v1 !v2 = let { (!_, !d) = lca cache v1 v2; !d1 = depths U.! v1; !d2 = depths U.! v2} in (d1 - d) + (d2 - d);{-# INLINE foldPathViaLca #-};foldPathViaLca :: forall a . (HasCallStack, U.Unbox a, Semigroup a) => LcaCache a -> (Vertex, a) -> (Vertex, a) -> a;foldPathViaLca cache@(!depths, !_, !toParentBL) (!v1, !a1) (!v2, !a2) = a' where { (!_, !d) = lca cache v1 v2; d1 = depths U.! v1; d2 = depths U.! v2; (!_, !a1') = sactBL toParentBL (d1 - d) (v1, a1); (!_, !a2') = sactBL toParentBL (d2 - d) (v2, a2); !a' = a1' <> a2'};treeDepthInfoSG :: (Monoid w, U.Unbox w) => SparseGraph Int w -> Int -> (U.Vector Int, TransitionalSemigroup w);treeDepthInfoSG gr@SparseGraph{..} !root = runST $ do { !parents <- UM.unsafeNew nVerts; !depths <- UM.unsafeNew nVerts; flip fix (0 :: Int, -1 :: Int, U.singleton (root, mempty)) $ \ loop (!depth, !parent, !vs) -> do { U.forM_ vs $ \ (!v, !w) -> do { UM.unsafeWrite depths v depth; UM.unsafeWrite parents v (parent, w); let { !vs' = U.filter ((/= parent) . fst) $ gr `adjW` v}; loop (depth + 1, v, vs')}}; (,) <$> U.unsafeFreeze depths <*> (TransitionalSemigroup <$> U.unsafeFreeze parents)} where { !nVerts = rangeSize boundsSG};lcaCacheSG :: (Monoid w, U.Unbox w) => SparseGraph Int w -> Vertex -> LcaCache w;lcaCacheSG !gr !root = (depths, toParent, cacheBL toParent) where { (!depths, !toParent) = treeDepthInfoSG gr root};foldTreeImpl :: forall m op a w . (Monad m) => SparseGraph Int w -> Vertex -> (op -> a -> a) -> (Vertex -> a) -> (a -> op) -> (Vertex -> a -> m ()) -> m a;foldTreeImpl !tree !root !sact_ !acc0At !toOp !memo = inner (-1) root where { inner :: Vertex -> Vertex -> m a; inner !parent !v1 = do { let { !acc0 = acc0At v1}; !res <- U.foldM' (\ acc v2 -> (`sact_` acc) . toOp <$> inner v1 v2) acc0 v2s; memo v1 res; return res} where { !v2s = U.filter (/= parent) $ tree `adj` v1}};foldTree :: SparseGraph Int w -> Vertex -> (op -> a -> a) -> (Vertex -> a) -> (a -> op) -> a;foldTree !tree !root !sact_ !acc0At !toOp = runIdentity $ foldTreeImpl tree root sact_ acc0At toOp (\ _ _ -> return ());scanTree :: (G.Vector v a) => SparseGraph Int w -> Vertex -> (op -> a -> a) -> (Vertex -> a) -> (a -> op) -> v a;scanTree !tree !root !sact_ !acc0At !toOp = G.create $ do { dp <- GM.unsafeNew nVerts; !_ <- foldTreeImpl tree root sact_ acc0At toOp $ \ v a -> do { GM.unsafeWrite dp v a}; return dp} where { !nVerts = rangeSize $! boundsSG tree};scanTreeU :: (U.Unbox a) => SparseGraph Int w -> Vertex -> (op -> a -> a) -> (Vertex -> a) -> (a -> op) -> U.Vector a;scanTreeU = scanTree;scanTreeV :: SparseGraph Int w -> Vertex -> (op -> a -> a) -> (Vertex -> a) -> (a -> op) -> V.Vector a;scanTreeV = scanTree;foldTreeAllSG :: forall a op w . (U.Unbox a, U.Unbox op, MonoidAction op a) => SparseGraph Int w -> (Vertex -> a) -> (a -> op) -> U.Vector a;foldTreeAllSG !tree !acc0At !toOp = let { !treeDp = scanTreeU tree root0 mact acc0At toOp; !rootDp = U.create $ do { !dp <- UM.unsafeNew nVerts; let { reroot parent parentOp v1 = do { let { !children = U.filter (/= parent) $ tree `adj` v1}; let { !opL = U.scanl' (\ op v2 -> (op <>) . toOp $ treeDp U.! v2) op0 children}; let { !opR = U.scanr' (\ v2 op -> (<> op) . toOp $ treeDp U.! v2) op0 children}; let { !x1 = (parentOp <> U.last opL) `mact` acc0At v1}; UM.unsafeWrite dp v1 x1; U.iforM_ children $ \ i2 v2 -> do { let { !lrOp = (opL U.! i2) <> (opR U.! succ i2)}; let { !v1Acc = (parentOp <> lrOp) `mact` acc0At v2}; let { !op' = toOp v1Acc}; reroot v1 op' v2}}}; reroot (-1 :: Vertex) op0 root0; return dp}} in rootDp where { !nVerts = rangeSize $ boundsSG tree; !root0 = 0 :: Int; !op0 = mempty @op};constructFor :: (U.Unbox a, U.Unbox b) => a -> U.Vector b -> (U.Vector a -> b -> a) -> U.Vector a;constructFor !x0 !input !f = U.create $ do { !vec <- UM.unsafeNew (U.length input + 1); UM.unsafeWrite vec 0 x0; flip U.imapM_ input $ \ lenS1 x -> do { !vec' <- U.take (succ lenS1) <$> U.unsafeFreeze vec; UM.unsafeWrite vec (succ lenS1) $! f vec' x}; return vec};relaxMany :: (HasCallStack, G.Vector v a, G.Vector v (Int, a), G.Vector v b) => (a -> a -> a) -> v a -> v b -> (b -> v (Int, a)) -> v a;relaxMany !relax !vec0 !input !expander = G.create $ do { !vec <- G.unsafeThaw vec0; G.forM_ input $ \ x -> do { G.forM_ (expander x) $ \ (!i, !x') -> do { GM.modify vec (`relax` x') i}}; return vec};irelaxMany :: (HasCallStack, G.Vector v a, G.Vector v (Int, a), G.Vector v b) => (a -> a -> a) -> v a -> v b -> (Int -> b -> v (Int, a)) -> v a;irelaxMany !relax !vec0 !input !expander = G.create $ do { !vec <- G.unsafeThaw vec0; G.iforM_ input $ \ ix x -> do { G.forM_ (expander ix x) $ \ (!i, !x') -> do { GM.modify vec (`relax` x') i}}; return vec};relaxMany' :: (Monoid m, U.Unbox m, U.Unbox a) => U.Vector m -> U.Vector a -> (a -> U.Vector (Int, m)) -> U.Vector m;relaxMany' !vec0 !input !expander = U.create $ do { !vec <- U.unsafeThaw vec0; U.forM_ input $ \ x -> do { U.forM_ (expander x) $ \ (!i, !x') -> do { UM.modify vec (<> x') i}}; return vec};{-# INLINE pushBasedConstructN #-};pushBasedConstructN :: (HasCallStack, G.Vector v a, G.Vector v (Int, a)) => (a -> a -> a) -> v a -> (Int -> v a -> v (Int, a)) -> v a;pushBasedConstructN !relax !vec0 !expander = G.create $ do { !vec <- G.unsafeThaw vec0; forM_ [0 .. GM.length vec - 1] $ \ iFrom -> do { !freezed <- G.unsafeFreeze (GM.take (iFrom + 1) vec); G.forM_ (expander iFrom freezed) $ \ (!iTo, !x') -> do { GM.modify vec (`relax` x') iTo}}; return vec};type Span = (Int, Int);{-# INLINE twoSplits #-};twoSplits :: Int -> Int -> U.Vector (Span, Span);twoSplits !l !r = U.map (\ len -> ((l, l + len - 1), (l + len, r))) $ rangeU 1 (r - l);{-# INLINE iwiSpansU #-};iwiSpansU :: Int -> Int -> U.Vector (Span, Span);iwiSpansU !l !r = U.map (\ len -> ((l, l + len - 1), (l + len + 1, r))) $ rangeU 0 (r - l);{-# INLINE iwiSpansU' #-};iwiSpansU' :: Int -> Int -> U.Vector (Span, Int, Span);iwiSpansU' !l !r = U.map (\ len -> ((l, l + len - 1), l + len, (l + len + 1, r))) $ rangeU 0 (r - l);spanDP :: (U.Unbox a) => Int -> a -> (Int -> a) -> (IxVector (Int, Int) (U.Vector a) -> (Int, Int) -> a) -> IxVector (Int, Int) (U.Vector a);spanDP !n !undef !onOne !f = constructIV ((0, 0), (n + 1, n)) $ \ vec (!spanLen, !spanL) -> if spanLen == 0 || spanL >= (n + 1 - spanLen) then undef else if spanLen == 1 then onOne spanL else f vec (spanLen, spanL);tspDP :: Int -> IxUVector (Int, Int) Int -> U.Vector Int;tspDP !nVerts !gr = U.constructN (nSets * nVerts) $ \ vec -> case G.length vec `divMod` nVerts of { (!s, !vTo) | s == bit vTo -> 0 :: Int; (!s, !vTo) | not (testBit s vTo) -> undef; (!s, !vTo) -> let { !s' = clearBit s vTo; !candidates = (U.take nVerts . U.drop (nVerts * s')) vec} in U.maximum $ flip U.imap candidates $ \ vFrom w0 -> let { !dw = gr @! (vFrom, vTo)} in bool (w0 + dw) undef (dw == undef || w0 == undef)} where { !nSets = bit nVerts; !undef = -1 :: Int};partitionsOf :: Int -> [[Int]];partitionsOf = inner [] [] where { inner :: [[Int]] -> [Int] -> Int -> [[Int]]; inner !results !acc 0 = acc : results; inner !results !acc !rest = U.foldl' step results (powersetU rest') where { !lsb = countTrailingZeros rest; !rest' = clearBit rest lsb; step !res !set = let { !set' = set .|. bit lsb} in inner res (set' : acc) (rest' .&. complement set')}};partitionsOfK :: Int -> Int -> [[Int]];partitionsOfK set0 k0 = inner [] k0 [] set0 where { inner :: [[Int]] -> Int -> [Int] -> Int -> [[Int]]; inner !results 0 acc 0 = acc : results; inner !results 0 _ _ = results; inner !results !k !acc !rest | k > popCount rest = results | otherwise = U.foldl' step results (powersetU rest') where { !lsb = countTrailingZeros rest; !rest' = clearBit rest lsb; step !res !set = let { !set' = set .|. bit lsb} in inner res (k - 1) (set' : acc) (rest' .&. complement set')}};ordPowerset :: Int -> U.Vector Int;ordPowerset 0 = U.empty; ordPowerset set0 = U.map (.|. lsb) . U.init $ powersetU set' where { lsb = countTrailingZeros set0; set' = clearBit set0 lsb};lisOf :: (HasCallStack) => U.Vector Int -> Int;lisOf !xs = runST $ do { !stree <- buildSTree (U.replicate (G.length xs) (Max (0 :: Int))); U.forM_ xs $ \ x -> do { !n0 <- maybe 0 getMax <$> foldMaySTree stree 0 (x - 1); writeSTree stree x (Max (n0 + 1))}; getMax <$> foldWholeSTree stree};lcsOf :: BS.ByteString -> BS.ByteString -> Int;lcsOf !s !t = U.last . vecIV . constructIV bnd $ \ sofar i -> case i of { (0, 0) -> 0 :: Int; (0, _) -> 0 :: Int; (_, 0) -> 0 :: Int; (!ls, !lt) -> n1 `max` n2 `max` n3 where { n1 = sofar @! (ls - 1, lt); n2 = sofar @! (ls, lt - 1); n3 | BS.index s (ls - 1) == BS.index t (lt - 1) = sofar @! (ls - 1, lt - 1) + 1 | otherwise = 0}} where { bnd = ((0, 0), (BS.length s, BS.length t))};addMod, subMod, mulMod :: Int -> Int -> Int -> Int;{-# INLINE addMod #-};addMod !modulo !x !a = (x + a) `mod` modulo;{-# INLINE subMod #-};subMod !modulo !x !s = (x - s) `mod` modulo;{-# INLINE mulMod #-};mulMod !modulo !b !p = (b * p) `mod` modulo;factMod :: Int -> Int -> Int;factMod 0 _ = 1; factMod 1 _ = 1; factMod !n !m = n * factMod (n - 1) m `rem` m;{-# INLINE powModConst #-};powModConst :: Int -> Int -> Int -> Int;powModConst !modulo !base !power = powModByCache (powModCache modulo (base `mod` modulo)) power;{-# INLINE invModF #-};invModF :: Int -> Int -> Int;invModF !modulo !d = invModFC (powModCache modulo d) modulo;{-# INLINE divModF #-};divModF :: Int -> Int -> Int -> Int;divModF !modulo !x !d = divModFC (powModCache modulo d) x `rem` modulo;powModCache :: Int -> Int -> (Int, U.Vector Int);powModCache !modulo !base = (modulo, U.iterateN 63 (\ x -> x * x `rem` modulo) base);{-# INLINE powModByCache #-};powModByCache :: (Int, U.Vector Int) -> Int -> Int;powModByCache (!modulo, !cache) power = U.foldl' step 1 (bitsOf power) where { step !acc nBit = acc * (cache U.! nBit) `rem` modulo};{-# INLINE invModFC #-};invModFC :: (Int, U.Vector Int) -> Int -> Int;invModFC context primeModulo = powModByCache context (primeModulo - 2);{-# INLINE divModFC #-};divModFC :: (Int, U.Vector Int) -> Int -> Int;divModFC context@(!modulo, !_) x = x * invModFC context modulo `rem` modulo;{-# INLINE factModsN #-};factModsN :: Int -> Int -> U.Vector Int;factModsN !modulo !n = U.scanl' (mulMod modulo) (1 :: Int) $ U.generate n (+ 1);{-# INLINE bcMod #-};bcMod :: Int -> Int -> Int -> Int;bcMod !n !r !modulo = foldl' (divModF modulo) (facts U.! n) [facts U.! r, facts U.! (n - r)] where { facts = factModsN modulo n};{-# INLINE compressU #-};compressU :: (HasCallStack) => U.Vector Int -> (U.Vector Int, U.Vector Int);compressU xs = (dict, U.map (bindex dict) xs) where { !dict = U.uniq $ U.modify (VAI.sortBy (comparing id)) xs};{-# INLINE bindex #-};bindex :: (HasCallStack, G.Vector v a, Ord a) => v a -> a -> Int;bindex !dict !xref = fromJust $ bsearchL dict (<= xref);chunksOfG :: (G.Vector v a) => Int -> v a -> V.Vector (v a);chunksOfG k xs0 = V.unfoldrExactN n step xs0 where { n = (G.length xs0 + k - 1) `div` k; step xs = (G.take k xs, G.drop k xs)};{-# INLINE slideMinIndicesOn #-};slideMinIndicesOn :: (G.Vector v a, Ord b) => (a -> b) -> Int -> v a -> U.Vector Int;slideMinIndicesOn wrap len xs = runST $ do { !buf <- newBufferAsQueue (G.length xs); G.generateM (G.length xs) $ \ i -> do { fix $ \ loop -> do { whenM (maybe False (<= i - len) <$> viewFront buf) $ do { void $ popFront buf; loop}}; fix $ \ loop -> do { whenM (maybe False ((< wrap (xs G.! i)) . wrap . (xs G.!)) <$> viewBack buf) $ do { void $ popBack buf; loop}}; pushBack buf i; fromJust <$> viewFront buf}};{-# INLINE slideMinIndices #-};slideMinIndices :: Int -> U.Vector Int -> U.Vector Int;slideMinIndices = slideMinIndicesOn id;{-# INLINE slideMaxIndices #-};slideMaxIndices :: Int -> U.Vector Int -> U.Vector Int;slideMaxIndices = slideMinIndicesOn Down;{-# INLINE constructNM #-};constructNM :: forall a m . (PrimMonad m, U.Unbox a) => Int -> (U.Vector a -> m a) -> m (U.Vector a);constructNM !n f = do { v <- GM.new n; v' <- G.unsafeFreeze v; fill v' 0} where { fill :: U.Vector a -> Int -> m (U.Vector a); fill !v i | i < n = do { x <- f (G.unsafeTake i v); G.elemseq v x $ do { v' <- G.unsafeThaw v; GM.unsafeWrite v' i x; v'' <- G.unsafeFreeze v'; fill v'' (i + 1)}}; fill v _ = return v};{-# INLINE constructrNM #-};constructrNM :: forall a m . (PrimMonad m, U.Unbox a) => Int -> (U.Vector a -> m a) -> m (U.Vector a);constructrNM !n f = do { v <- n `seq` GM.new n; v' <- G.unsafeFreeze v; fill v' 0} where { fill :: U.Vector a -> Int -> m (U.Vector a); fill !v i | i < n = do { x <- f (G.unsafeSlice (n - i) i v); G.elemseq v x $ do { v' <- G.unsafeThaw v; GM.unsafeWrite v' (n - i - 1) x; v'' <- G.unsafeFreeze v'; fill v'' (i + 1)}}; fill v _ = return v};prevPermutation :: (Ord e, G.Vector v e, G.Vector v (Down e)) => v e -> v e;prevPermutation = G.map (\case { Down !x -> x}) . G.modify (void . GM.nextPermutation) . G.map Down;invNumG :: (HasCallStack) => Int -> (G.Vector v Int) => v Int -> Int;invNumG xMax xs = runST $ do { !stree <- newSTree @(Sum Int) (xMax + 1); fmap getSum . (\ f -> G.foldM' f mempty xs) $ \ acc x -> do { !s <- if x == xMax then return (Sum 0) else foldSTree stree (succ x) xMax; modifySTree stree (+ 1) x; return $! acc + s}};compressInvNumG :: (HasCallStack) => U.Vector Int -> Int;compressInvNumG xs = invNumG (pred (U.length xs')) xs' where { !xs' = snd $ compressU xs};lexOrderMod :: (HasCallStack, G.Vector v Int) => v Int -> Int -> Int;lexOrderMod xs modulo = runST $ do { !stree <- newSTree @(Sum Int) (G.length xs + 1); let { !facts = factModsN modulo (G.length xs)}; !counts <- G.iforM xs $ \ i x -> do { Sum !nUsed <- foldSTree stree 0 x; let { !nUnused = x - nUsed}; let { !factMod = facts G.! (G.length xs - (i + 1))}; let { !inc = nUnused * factMod `rem` modulo}; writeSTree stree x (Sum 1); return inc}; return $ (+ 1) $ G.foldl1' (\ !acc x -> (acc + x) `rem` modulo) counts};newtype ModInt p = ModInt{unModInt :: Int} deriving (Eq, P.Prim)                                           deriving newtype (Ord, Read, Show);deriving newtype instance (KnownNat p) => Real (ModInt p);instance (KnownNat p) => Num (ModInt p) where { (ModInt !x1) + (ModInt !x2) = ModInt $! (x1 + x2) `mod` fromInteger (natVal' (proxy# @p)); (ModInt !x1) * (ModInt !x2) = ModInt $! (x1 * x2) `mod` fromInteger (natVal' (proxy# @p)); negate (ModInt !v) = ModInt $ (-v) `mod` fromInteger (natVal' (proxy# @p)); abs = id; signum _ = 1; fromInteger = ModInt . fromInteger};instance (KnownNat p) => Fractional (ModInt p) where { recip (ModInt !x) = ModInt $! invModF (fromInteger (natVal' (proxy# @p))) x; fromRational !r = ModInt n / ModInt d where { n = fromInteger $! Ratio.numerator r; d = fromInteger $! Ratio.denominator r}};instance (KnownNat p) => Enum (ModInt p) where { toEnum = ModInt . (`mod` fromInteger (natVal' (proxy# @p))); fromEnum = coerce};instance (KnownNat p) => SemigroupAction (Product (ModInt p)) (ModInt p) where { sact (Product !x1) !x2 = x1 * x2};newtype instance  U.MVector s (ModInt p) = MV_ModInt (P.MVector s (ModInt p));newtype instance  U.Vector (ModInt p) = V_ModInt (P.Vector (ModInt p));deriving via (U.UnboxViaPrim (ModInt p)) instance GM.MVector UM.MVector (ModInt p);deriving via (U.UnboxViaPrim (ModInt p)) instance G.Vector U.Vector (ModInt p);instance U.Unbox (ModInt p);type Mat a = IxUVector (Int, Int) a;type Col a = U.Vector a;mulMatToCol :: (HasCallStack, Num e, U.Unbox e) => Mat e -> Col e -> Col e;mulMatToCol !mat !col = U.convert $ G.map (G.sum . flip (G.zipWith (*)) col) rows where { !n = G.length col; !_ = dbgAssert $ (== n) . succ . fst . snd $ boundsIV mat; rows = chunksOfG n (vecIV mat)};mulMatToColMod :: (HasCallStack, Num e, U.Unbox e, Integral e) => e -> Mat e -> Col e -> Col e;mulMatToColMod !modulus !mat !col = U.convert $ G.map (G.foldl' addMod_ 0 . flip (G.zipWith mulMod_) col) rows where { !n = G.length col; !_ = dbgAssert $ (== n) . succ . fst . snd $ boundsIV mat; rows = chunksOfG n (vecIV mat); addMod_ x y = (x + y) `mod` modulus; mulMod_ x y = (x * y) `mod` modulus};mulMat :: (HasCallStack, Num e, U.Unbox e) => Mat e -> Mat e -> Mat e;mulMat !a !b = generateIV (zero2 w' h) $ \ (!row, !col) -> U.sum $ U.zipWith (*) (rows1 V.! row) (cols2 V.! col) where { ((!x1, !y1), (!x2, !y2)) = boundsIV a; w = x2 + 1 - x1; h = y2 + 1 - y1; ((!x1', !y1'), (!x2', !y2')) = boundsIV a; w' = x2' + 1 - x1'; h' = y2' + 1 - y1'; !_ = dbgAssert (w == h') $ "matrix size mismatch: " ++ show (boundsIV a) ++ " - " ++ show (boundsIV b); rows1 = chunksOfG w (vecIV a); cols2 = V.generate w' $ \ col -> U.generate h' $ \ row -> vecIV b U.! (w' * row + col)};mulMatMod :: (HasCallStack, Num e, U.Unbox e, Integral e) => e -> Mat e -> Mat e -> Mat e;mulMatMod !m !a !b = generateIV (zero2 w' h) $ \ (!row, !col) -> U.foldl' addMod_ 0 $ U.zipWith mulMod_ (rows1 V.! row) (cols2 V.! col) where { ((!x1, !y1), (!x2, !y2)) = boundsIV a; w = x2 + 1 - x1; h = y2 + 1 - y1; ((!x1', !y1'), (!x2', !y2')) = boundsIV a; w' = x2' + 1 - x1'; h' = y2' + 1 - y1'; !_ = dbgAssert (w == h') $ "matrix size mismatch: " ++ show (boundsIV a) ++ " - " ++ show (boundsIV b); rows1 = chunksOfG w (vecIV a); cols2 = V.generate w' $ \ col -> U.generate h' $ \ row -> vecIV b U.! (w' * row + col); addMod_ x y = (x + y) `mod` m; mulMod_ x y = (x * y) `mod` m};{-# INLINE unitMat #-};unitMat :: (U.Unbox e, Num e) => Int -> Mat e;unitMat !n = constructIV (zero2 n n) $ \ _ (!row, !col) -> if col == row then 1 else 0;instance (Num a, U.Unbox a) => Semigroup (Mat a) where { {-# INLINE (<>) #-}; (<>) = mulMat};instance (Num a, U.Unbox a) => SemigroupAction (Mat a) (Col a) where { {-# INLINE sact #-}; sact = mulMatToCol};instance (Num a, U.Unbox a) => BinaryLifting (Mat a) where { type VecBL (Mat a) = V.Vector (Mat a); {-# INLINE cacheBL #-}; cacheBL = cacheBLV};rot45 :: (Int, Int) -> (Int, Int);rot45 (!x, !y) = (x - y, x + y);mDigitsRev :: (Integral n) => n -> n -> Maybe [n];mDigitsRev !base !i = if base < 1 then Nothing else Just $ dr base i where { dr _ 0 = []; dr !b !x = case base of { 1 -> genericTake x $ repeat 1; _ -> let { (!rest, !lastDigit) = quotRem x b} in lastDigit : dr b rest}};mDigits :: (Integral n) => n -> n -> Maybe [n];mDigits !base !i = reverse <$> mDigitsRev base i;digitsRev :: (Integral n) => n -> n -> [n];digitsRev !base = fromJust . mDigitsRev base;digits :: (Integral n) => n -> n -> [n];digits _ 0 = [0]; digits !base !x = reverse $ digitsRev base x;unDigits :: (Integral n) => n -> [n] -> n;unDigits !base = foldl' (\ !a !b -> a * base + b) 0;convertBase :: (Integral a) => a -> a -> [a] -> [a];convertBase !from !to = digits to . unDigits from;toDigitsU :: Int -> Int -> U.Vector Int;toDigitsU !base !x0 | x0 < base = U.singleton x0 | otherwise = U.unfoldr expand x0 where { expand 0 = Nothing; expand x = Just $ swap (x `divMod` base)};toNDigitsU :: Int -> Int -> Int -> U.Vector Int;toNDigitsU !base !nDigits !x0 = U.unfoldrExactN nDigits expand x0 where { expand x = swap (x `divMod` base)};unDigitsU :: Int -> U.Vector Int -> Int;unDigitsU !base !xs = fst $ U.foldl' step (0 :: Int, 1 :: Int) xs where { step (!acc, !d) !i = (acc + d * i, base * d)};primes :: [Int];primes = 2 : 3 : minus [5, 7 ..] (unionAll [[p * p, p * p + 2 * p ..] | p <- tail primes]) where { minus (x : xs) (y : ys) = case compare x y of { LT -> x : minus xs (y : ys); EQ -> minus xs ys; GT -> minus (x : xs) ys}; minus xs _ = xs; union (x : xs) (y : ys) = case compare x y of { LT -> x : union xs (y : ys); EQ -> x : union xs ys; GT -> y : union (x : xs) ys}; union xs [] = xs; union [] ys = ys; unionAll :: (Ord a) => [[a]] -> [a]; unionAll ((x : xs) : t) = x : union xs (unionAll $ pairs t) where { pairs ((x : xs) : (ys : t)) = (x : union xs ys) : pairs t; pairs _ = error "unionAll _ pairs: unreachable"}; unionAll _ = error "unionAll: unreachable"};primeFactors :: Int -> [(Int, Int)];primeFactors !n_ = map (\ !xs -> (head xs, length xs)) . group $ inner n_ input where { input = 2 : 3 : [y | x <- [5, 11 ..], y <- [x, x + 2]]; inner n pps@(p : ps) | n == 1 = [] | n < p * p = [n] | r == 0 = p : inner q pps | otherwise = inner n ps where { (q, r) = divMod n p}; inner _ _ = error "unreachable"};divisorsOf :: Int -> [Int];divisorsOf n = sort $ inner 1 where { inner k | k * k > n = [] | k * k == n = [k] | r == 0 = k : d : inner (succ k) | otherwise = inner (succ k) where { (!d, !r) = n `divMod` k}}
{- ORMOLU_ENABLE -}
-- }}}

-- | \O(N^2 \log N)\) Slow answer with a fast segment tree
main :: IO ()
main = do
  !n <- ints1
  input <- U.replicateM n ints3
  let input' = dbgId $ U.modify (VAI.sortBy (comparing fst3)) input

  -- stree <- newSTree @(Max Int) 5001
  stree <- buildSTree (U.replicate 5001 (Max (0 :: Int)))
  writeSTree stree 0 (Max 0)
  U.forM_ input' $ \(!rMax, !len, !w) -> do
    let lMax = rMax - len + 1
    forM_ [lMax, lMax - 1 .. 1] $ \l -> do
      let r = l + len - 1
      let !_ = dbg (rMax, lMax, (l, r))
      sofar <- foldSTree stree 0 (l - 1)
      modifySTree stree ((sofar + Max w) <>) r

  Max res <- foldSTree stree 0 5000
  print res

Submission Info

Submission Time	2024-03-20 15:06:58+0900
Task	011 - Gravy Jobs（★6）
User	toyboot4e
Language	Haskell (GHC 9.4.5)
Score	6
Code Size	148705 Byte
Status	AC
Exec Time	1621 ms
Memory	12672 KiB

Compile Error

app/Main.hs:15:41992: warning: [-Wname-shadowing]
    This binding for ‘next’ shadows the existing binding
      imported from ‘System.Random.Stateful’ at app/Main.hs:8:1067-1095
      (and originally defined in ‘System.Random.Internal’)
   |
15 | type SparseUnionFind = IM.IntMap Int;newSUF :: SparseUnionFind;newSUF = IM.empty;memberSUF :: Int -> SparseUnionFind -> Bool;memberSUF = IM.member;insertSUF :: Int -> SparseUnionFind -> SparseUnionFind;insertSUF !x !uf = IM.insert x (-1) uf;fromListSUF :: [(Int, Int)] -> SparseUnionFind;fromListSUF = foldl' (\ uf (!i, !j) -> unifySUF i j uf) newSUF;fromVecSUF :: U.Vector (Int, Int) -> SparseUnionFind;fromVecSUF = U.foldl' (\ uf (!i, !j) -> unifySUF i j uf) newSUF;rootSUF :: (HasCallStack) => Int -> SparseUnionFind -> (Int, Int);rootSUF !i !uf | IM.notMember i uf = (i, 1) | j < 0 = (i, -j) | otherwise = rootSUF j uf where { j = uf IM.! i};sameSUF :: (HasCallStack) => Int -> Int -> SparseUnionFind -> Bool;sameSUF !i !j !uf = fst (rootSUF i uf) == fst (rootSUF j uf);unifySUF :: (HasCallStack) => Int -> Int -> SparseUnionFind -> SparseUnionFind;unifySUF !i !j !uf | a == b = uf | r >= s = IM.insert a (negate $! r + s) $ IM.insert b a uf | otherwise = IM.insert b (negate $! r + s) $ IM.insert a b uf where { (!a, !r) = rootSUF i uf; (!b, !s) = rootSUF j uf};newtype MUnionFind s = MUnionFind (UM.MVector s MUFNode);type IOUnionFind = MUnionFind RealWorld;type STUnionFind s = MUnionFind s;data MUFNode = MUFChild {-# UNPACK #-} !Int | MUFRoot {-# UNPACK #-} !Int deriving (Eq, Show);instance U.IsoUnbox MUFNode (Bool, Int) where { {-# INLINE toURepr #-}; toURepr (MUFChild !x) = (True, x); toURepr (MUFRoot !x) = (False, x); {-# INLINE fromURepr #-}; fromURepr (True, !x) = MUFChild x; fromURepr (False, !x) = MUFRoot x};newtype instance  U.MVector s MUFNode = MV_MUFNode (UM.MVector s (Bool, Int));newtype instance  U.Vector MUFNode = V_MUFNode (U.Vector (Bool, Int));deriving via (MUFNode `U.As` (Bool, Int)) instance GM.MVector UM.MVector MUFNode;deriving via (MUFNode `U.As` (Bool, Int)) instance G.Vector U.Vector MUFNode;instance U.Unbox MUFNode;{-# INLINE newMUF #-};newMUF :: (PrimMonad m) => Int -> m (MUnionFind (PrimState m));newMUF !n = MUnionFind <$> UM.replicate n (MUFRoot 1);{-# INLINE rootMUF #-};rootMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> m Int;rootMUF uf@(MUnionFind !vec) i = do { !node <- UM.unsafeRead vec i; case node of { MUFRoot _ -> return i; MUFChild p -> do { !r <- rootMUF uf p; UM.unsafeWrite vec i (MUFChild r); return r}}};{-# INLINE groupsMUF #-};groupsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m IS.IntSet;groupsMUF uf@(MUnionFind !vec) = foldM step IS.empty [0 .. pred (GM.length vec)] where { step !is !i = do { !root <- rootMUF uf i; return $ IS.insert root is}};{-# INLINE sameMUF #-};sameMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> Int -> m Bool;sameMUF !uf !x !y = liftM2 (==) (rootMUF uf x) (rootMUF uf y);_unwrapMUFRoot :: MUFNode -> Int;_unwrapMUFRoot (MUFRoot !s) = s; _unwrapMUFRoot (MUFChild !_) = error "tried to unwrap child as UF root";{-# INLINE unifyMUF #-};unifyMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> Int -> m Bool;unifyMUF uf@(MUnionFind !vec) !x !y = do { !px <- rootMUF uf x; !py <- rootMUF uf y; when (px /= py) $ do { !sx <- _unwrapMUFRoot <$> UM.unsafeRead vec px; !sy <- _unwrapMUFRoot <$> UM.unsafeRead vec py; let { (!par, !chld) = if sx < sy then (px, py) else (py, px)}; UM.unsafeWrite vec chld (MUFChild par); UM.unsafeWrite vec par (MUFRoot $! sx + sy)}; return $ px /= py};{-# INLINE unifyMUF_ #-};unifyMUF_ :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> Int -> m ();unifyMUF_ uf x y = void $ unifyMUF uf x y;{-# INLINE sizeMUF #-};sizeMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> Int -> m Int;sizeMUF uf@(MUnionFind !vec) !x = do { !px <- rootMUF uf x; _unwrapMUFRoot <$> UM.unsafeRead vec px};{-# INLINE clearMUF #-};clearMUF :: (PrimMonad m) => MUnionFind (PrimState m) -> m ();clearMUF (MUnionFind !vec) = do { UM.set vec (MUFRoot 1)};data PUnionFind s = DUnionFind{nodesPUF :: UM.MVector s MUFNode, potencialPUF :: UM.MVector s Int};newPUF :: (PrimMonad m) => Int -> m (PUnionFind (PrimState m));newPUF n = DUnionFind <$> UM.replicate n (MUFRoot 1) <*> UM.replicate n (0 :: Int);rootPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> m Int;rootPUF uf = inner where { inner v = UM.read (nodesPUF uf) v >>= \case { MUFRoot _ -> return v; MUFChild p -> do { !r <- inner p; when (p /= r) $ do { !pp <- UM.read (potencialPUF uf) p; UM.write (nodesPUF uf) v (MUFChild r); UM.modify (potencialPUF uf) (pp +) v}; return r}}};unifyPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> Int -> m Bool;unifyPUF !uf !v1 !v2 !dp = do { !r1 <- rootPUF uf v1; !r2 <- rootPUF uf v2; if r1 == r2 then return False else do { !size1 <- UM.read (potencialPUF uf) v1; !size2 <- UM.read (potencialPUF uf) v2; if size1 < size2 then unifyPUF uf v2 v1 (-dp) else do { !sz1 <- _unwrapMUFRoot <$> UM.read (nodesPUF uf) r1; !sz2 <- _unwrapMUFRoot <$> UM.read (nodesPUF uf) r2; UM.write (nodesPUF uf) r1 (MUFRoot (sz1 + sz2)); !p1 <- UM.read (potencialPUF uf) v1; !p2 <- UM.read (potencialPUF uf) v2; let { !pr2 = p1 - p2 - dp}; UM.write (nodesPUF uf) r2 (MUFChild r1); UM.write (potencialPUF uf) r2 pr2; return True}}};sizePUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> m Int;sizePUF !uf !v = fmap _unwrapMUFRoot . UM.read (nodesPUF uf) =<< rootPUF uf v;samePUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> m Bool;samePUF !uf !v1 !v2 = (==) <$> rootPUF uf v1 <*> rootPUF uf v2;canUnifyPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> Int -> m Bool;canUnifyPUF !uf !v1 !v2 !d = do { !r1 <- rootPUF uf v1; !r2 <- rootPUF uf v2; !p1 <- UM.read (potencialPUF uf) v1; !p2 <- UM.read (potencialPUF uf) v2; return $ r1 /= r2 || p1 - p2 == d};potPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> m Int;potPUF !uf !v1 = do { void $ rootPUF uf v1; UM.read (potencialPUF uf) v1};diffPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> Int -> Int -> m Int;diffPUF !uf !v1 !v2 = (-) <$> potPUF uf v1 <*> potPUF uf v2;clearPUF :: (PrimMonad m) => PUnionFind (PrimState m) -> m ();clearPUF !uf = do { UM.set (potencialPUF uf) (0 :: Int); UM.set (nodesPUF uf) (MUFRoot 1)};class SemigroupAction s a where { sact :: s -> a -> a};instance (Semigroup a) => SemigroupAction a a where { sact x y = x <> y};class (SemigroupAction m a, Monoid m) => MonoidAction m a where { mact :: m -> a -> a; {-# INLINE mact #-}; mact = sact};class Semiring s where { (<+>) :: s -> s -> s; szero :: s; (<.>) :: s -> s -> s; sone :: s};foldP :: (Semiring a, G.Vector v a) => v a -> a;foldP = G.foldl' (<+>) szero;foldT :: (Semiring a, G.Vector v a) => v a -> a;foldT = G.foldl' (<.>) sone;newtype MaxPlus a = MaxPlus{getMaxPlus :: a} deriving (P.Prim)                                             deriving newtype (Eq, Ord, Show);newtype instance  U.MVector s (MaxPlus a) = MV_MaxPlus (P.MVector s (MaxPlus a));newtype instance  U.Vector (MaxPlus a) = V_MaxPlus (P.Vector (MaxPlus a));deriving via (U.UnboxViaPrim (MaxPlus a)) instance (P.Prim a) => GM.MVector UM.MVector (MaxPlus a);deriving via (U.UnboxViaPrim (MaxPlus a)) instance (P.Prim a) => G.Vector U.Vector (MaxPlus a);instance (P.Prim a) => U.Unbox (MaxPlus a);instance (Num a, Bounded a, Ord a) => Semiring (MaxPlus a) where { {-# INLINE (<+>) #-}; (MaxPlus x1) <+> (MaxPlus x2) = MaxPlus (x1 `max` x2); {-# INLINE szero #-}; szero = MaxPlus minBound; {-# INLINE (<.>) #-}; (MaxPlus x1) <.> (MaxPlus x2) = MaxPlus (x1 + x2); {-# INLINE sone #-}; sone = MaxPlus 0};newtype MinPlus a = MinPlus{getMinPlus :: a} deriving (P.Prim)                                             deriving newtype (Eq, Ord, Show);newtype instance  U.MVector s (MinPlus a) = MV_MinPlus (P.MVector s (MinPlus a));newtype instance  U.Vector (MinPlus a) = V_MinPlus (P.Vector (MinPlus a));deriving via (U.UnboxViaPrim (MinPlus a)) instance (P.Prim a) => GM.MVector UM.MVector (MinPlus a);deriving via (U.UnboxViaPrim (MinPlus a)) instance (P.Prim a) => G.Vector U.Vector (MinPlus a);instance (P.Prim a) => U.Unbox (MinPlus a);instance (Num a, Bounded a, Ord a) => Semiring (MinPlus a) where { {-# INLINE (<+>) #-}; (MinPlus x1) <+> (MinPlus x2) = MinPlus (x1 `min` x2); {-# INLINE szero #-}; szero = MinPlus maxBound; {-# INLINE (<.>) #-}; (MinPlus x1) <.> (MinPlus x2) = MinPlus (x1 + x2); {-# INLINE sone #-}; sone = MinPlus 0};newtype Boolean = Boolean{getBoolean :: Bool} deriving newtype (Eq, Ord, Show);instance U.IsoUnbox Boolean Bool where { {-# INLINE toURepr #-}; toURepr (Boolean b) = b; {-# INLINE fromURepr #-}; fromURepr = Boolean};newtype instance  U.MVector s Boolean = MV_Foo (U.MVector s Bool);newtype instance  U.Vector Boolean = V_Foo (U.Vector Bool);deriving via (Boolean `U.As` Bool) instance GM.MVector UM.MVector Boolean;deriving via (Boolean `U.As` Bool) instance G.Vector U.Vector Boolean;instance U.Unbox Boolean;instance Semiring Boolean where { {-# INLINE (<+>) #-}; (Boolean x1) <+> (Boolean x2) = Boolean (x1 || x2); {-# INLINE szero #-}; szero = Boolean False; {-# INLINE (<.>) #-}; (Boolean x1) <.> (Boolean x2) = Boolean (x1 && x2); {-# INLINE sone #-}; sone = Boolean True};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))};type Vertex = Int;type EdgeId = Int;newtype Mat2x2 a = Mat2x2 (Mat2x2Repr a) deriving newtype (Eq, Ord, Show);type Mat2x2Repr a = (a, a, a, a);{-# INLINE unMat2x2 #-};unMat2x2 :: Mat2x2 a -> Mat2x2Repr a;unMat2x2 (Mat2x2 x) = x;instance (Num a) => Semigroup (Mat2x2 a) where { {-# INLINE (<>) #-}; (<>) = mulM22M22};{-# INLINE mulM22M22 #-};mulM22M22 :: (Num a) => Mat2x2 a -> Mat2x2 a -> Mat2x2 a;mulM22M22 (Mat2x2 (!a11, !a12, !a21, !a22)) (Mat2x2 (!b11, !b12, !b21, !b22)) = Mat2x2 (c11, c12, c21, c22) where { !c11 = a11 * b11 + a12 * b21; !c12 = a11 * b12 + a12 * b22; !c21 = a21 * b11 + a22 * b21; !c22 = a21 * b12 + a22 * b22};instance (Num a) => Monoid (Mat2x2 a) where { {-# INLINE mempty #-}; mempty = Mat2x2 (1, 0, 0, 1)};instance (Num a) => SemigroupAction (Mat2x2 a) (V2 a) where { {-# INLINE sact #-}; sact = mulM22V2};{-# INLINE mulM22V2 #-};mulM22V2 :: (Num a) => Mat2x2 a -> V2 a -> V2 a;mulM22V2 (Mat2x2 (!a11, !a12, !a21, !a22)) (V2 (!x1, !x2)) = V2 (a11 * x1 + a12 * x2, a21 * x1 + a22 * x2);newtype V2 a = V2 (V2Repr a) deriving newtype (Eq, Ord, Show);type V2Repr a = (a, a);{-# INLINE unV2 #-};unV2 :: V2 a -> V2Repr a;unV2 (V2 x) = x;instance (Num a) => Semigroup (V2 a) where { {-# INLINE (<>) #-}; (V2 (!a1, !a2)) <> (V2 (!b1, !b2)) = V2 (a1 + b1, a2 + b2)};instance (Num a) => Monoid (V2 a) where { {-# INLINE mempty #-}; mempty = V2 (0, 0)};newtype instance  U.MVector s (Mat2x2 a) = MV_Mat2x2 (U.MVector s (Mat2x2Repr a));newtype instance  U.Vector (Mat2x2 a) = V_Mat2x2 (U.Vector (Mat2x2Repr a));deriving instance (U.Unbox a) => GM.MVector UM.MVector (Mat2x2 a);deriving instance (U.Unbox a) => G.Vector U.Vector (Mat2x2 a);instance (U.Unbox a) => U.Unbox (Mat2x2 a);newtype instance  U.MVector s (V2 a) = MV_V2 (U.MVector s (V2Repr a));newtype instance  U.Vector (V2 a) = V_V2 (U.Vector (V2Repr a));deriving instance (U.Unbox a) => GM.MVector UM.MVector (V2 a);deriving instance (U.Unbox a) => G.Vector U.Vector (V2 a);instance (U.Unbox a) => U.Unbox (V2 a);instance (Num a) => MonoidAction (Mat2x2 a) (V2 a);data A3 a = A3 !a !a !a deriving (Eq, Show);newtype instance  UM.MVector s (A3 a) = MV_A3 (UM.MVector s a);newtype instance  U.Vector (A3 a) = V_A3 (U.Vector a);instance (U.Unbox a) => U.Unbox (A3 a);instance (U.Unbox a) => GM.MVector UM.MVector (A3 a) where { basicLength (MV_A3 v) = GM.basicLength v `div` 3; {-# INLINE basicLength #-}; basicUnsafeSlice i n (MV_A3 v) = MV_A3 $ GM.basicUnsafeSlice (3 * i) (3 * n) v; {-# INLINE basicUnsafeSlice #-}; basicOverlaps (MV_A3 v1) (MV_A3 v2) = GM.basicOverlaps v1 v2; {-# INLINE basicOverlaps #-}; basicUnsafeNew n = MV_A3 `liftM` GM.basicUnsafeNew (3 * n); {-# INLINE basicUnsafeNew #-}; basicInitialize (MV_A3 v) = GM.basicInitialize v; {-# INLINE basicInitialize #-}; basicUnsafeRead (MV_A3 v) i = liftM3 A3 (GM.basicUnsafeRead v (3 * i)) (GM.basicUnsafeRead v (3 * i + 1)) (GM.basicUnsafeRead v (3 * i + 2)); {-# INLINE basicUnsafeRead #-}; basicUnsafeWrite (MV_A3 v) i (A3 x y z) = GM.basicUnsafeWrite v (3 * i) x >> GM.basicUnsafeWrite v (3 * i + 1) y >> GM.basicUnsafeWrite v (3 * i + 2) z; {-# INLINE basicUnsafeWrite #-}; basicClear (MV_A3 v) = GM.basicClear v; {-# INLINE basicClear #-}; basicUnsafeCopy (MV_A3 v1) (MV_A3 v2) = GM.basicUnsafeCopy v1 v2; {-# INLINE basicUnsafeCopy #-}; basicUnsafeMove (MV_A3 v1) (MV_A3 v2) = GM.basicUnsafeMove v1 v2; {-# INLINE basicUnsafeMove #-}; basicUnsafeGrow (MV_A3 v) n = MV_A3 `liftM` GM.basicUnsafeGrow v (3 * n); {-# INLINE basicUnsafeGrow #-}};instance (U.Unbox a) => G.Vector U.Vector (A3 a) where { basicUnsafeFreeze (MV_A3 v) = V_A3 `liftM` G.basicUnsafeFreeze v; {-# INLINE basicUnsafeFreeze #-}; basicUnsafeThaw (V_A3 v) = MV_A3 `liftM` G.basicUnsafeThaw v; {-# INLINE basicUnsafeThaw #-}; basicLength (V_A3 v) = G.basicLength v `div` 3; {-# INLINE basicLength #-}; basicUnsafeSlice i n (V_A3 v) = V_A3 $ G.basicUnsafeSlice (3 * i) (3 * n) v; {-# INLINE basicUnsafeSlice #-}; basicUnsafeIndexM (V_A3 v) i = liftM3 A3 (G.basicUnsafeIndexM v (3 * i)) (G.basicUnsafeIndexM v (3 * i + 1)) (G.basicUnsafeIndexM v (3 * i + 2)); {-# INLINE basicUnsafeIndexM #-}; basicUnsafeCopy (MV_A3 mv) (V_A3 v) = G.basicUnsafeCopy mv v; elemseq _ = seq; {-# INLINE elemseq #-}};data A2 a = A2 !a !a deriving (Eq, Show);newtype instance  UM.MVector s (A2 a) = MV_A2 (UM.MVector s a);newtype instance  U.Vector (A2 a) = V_A2 (U.Vector a);instance (U.Unbox a) => U.Unbox (A2 a);instance (U.Unbox a) => GM.MVector UM.MVector (A2 a) where { basicLength (MV_A2 v) = unsafeShiftR (GM.basicLength v) 1; {-# INLINE basicLength #-}; basicUnsafeSlice i n (MV_A2 v) = MV_A2 $ GM.basicUnsafeSlice (2 * i) (2 * n) v; {-# INLINE basicUnsafeSlice #-}; basicOverlaps (MV_A2 v1) (MV_A2 v2) = GM.basicOverlaps v1 v2; {-# INLINE basicOverlaps #-}; basicUnsafeNew n = MV_A2 `liftM` GM.basicUnsafeNew (2 * n); {-# INLINE basicUnsafeNew #-}; basicInitialize (MV_A2 v) = GM.basicInitialize v; {-# INLINE basicInitialize #-}; basicUnsafeRead (MV_A2 v) i = liftM2 A2 (GM.basicUnsafeRead v (2 * i)) (GM.basicUnsafeRead v (2 * i + 1)); {-# INLINE basicUnsafeRead #-}; basicUnsafeWrite (MV_A2 v) i (A2 x y) = GM.basicUnsafeWrite v (2 * i) x >> GM.basicUnsafeWrite v (2 * i + 1) y; {-# INLINE basicUnsafeWrite #-}; basicClear (MV_A2 v) = GM.basicClear v; {-# INLINE basicClear #-}; basicUnsafeCopy (MV_A2 v1) (MV_A2 v2) = GM.basicUnsafeCopy v1 v2; {-# INLINE basicUnsafeCopy #-}; basicUnsafeMove (MV_A2 v1) (MV_A2 v2) = GM.basicUnsafeMove v1 v2; {-# INLINE basicUnsafeMove #-}; basicUnsafeGrow (MV_A2 v) n = MV_A2 `liftM` GM.basicUnsafeGrow v (2 * n); {-# INLINE basicUnsafeGrow #-}};instance (U.Unbox a) => G.Vector U.Vector (A2 a) where { basicUnsafeFreeze (MV_A2 v) = V_A2 `liftM` G.basicUnsafeFreeze v; {-# INLINE basicUnsafeFreeze #-}; basicUnsafeThaw (V_A2 v) = MV_A2 `liftM` G.basicUnsafeThaw v; {-# INLINE basicUnsafeThaw #-}; basicLength (V_A2 v) = unsafeShiftR (G.basicLength v) 1; {-# INLINE basicLength #-}; basicUnsafeSlice i n (V_A2 v) = V_A2 $ G.basicUnsafeSlice (2 * i) (2 * n) v; {-# INLINE basicUnsafeSlice #-}; basicUnsafeIndexM (V_A2 v) i = liftM2 A2 (G.basicUnsafeIndexM v (2 * i)) (G.basicUnsafeIndexM v (2 * i + 1)); {-# INLINE basicUnsafeIndexM #-}; basicUnsafeCopy (MV_A2 mv) (V_A2 v) = G.basicUnsafeCopy mv v; elemseq _ = seq; {-# INLINE elemseq #-}};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum U.! (r + 1) - csum U.! l;{-# 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 snocCSum #-};snocCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();snocCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};type SizedList = (Int, [Int]);compareSL :: SizedList -> SizedList -> Ordering;compareSL (!len1, !xs1) (!len2, !xs2) | len1 > len2 = GT | len1 < len2 = LT | otherwise = inner xs1 xs2 where { inner [] [] = EQ; inner (y1 : ys1) (y2 : ys2) = case compare y1 y2 of { EQ -> inner ys1 ys2; c -> c}; inner _ [] = error "unreachable: `compareSL`"; inner [] _ = error "unreachable: `compareSL`"};maxSL :: SizedList -> SizedList -> SizedList;maxSL sl1 sl2 = case compareSL sl1 sl2 of { GT -> sl1; _ -> sl2};nullSL :: SizedList -> Bool;nullSL = null . snd;emptySL :: SizedList;emptySL = (0, []);consSL :: SizedList -> Int -> SizedList;consSL (!len, !xs) !x = (len + 1, x : xs);class SafeList v where { type SafeListElem v; headMay :: v -> Maybe (SafeListElem v); lastMay :: v -> Maybe (SafeListElem v); headOr :: SafeListElem v -> v -> SafeListElem v; lastOr :: SafeListElem v -> v -> SafeListElem v; minimumMay :: v -> Maybe (SafeListElem v); maximumMay :: v -> Maybe (SafeListElem v); minimumOr :: SafeListElem v -> v -> SafeListElem v; maximumOr :: SafeListElem v -> v -> SafeListElem v};instance (Ord a) => SafeList [a] where { type SafeListElem [a] = a; headMay [] = Nothing; headMay (x : _) = Just x; lastMay [] = Nothing; lastMay xs = Just $ last xs; headOr x0 [] = x0; headOr _ xs = head xs; lastOr x0 [] = x0; lastOr _ xs = last xs; minimumMay [] = Nothing; minimumMay xs = Just $ minimum xs; maximumMay [] = Nothing; maximumMay xs = Just $ maximum xs; minimumOr x0 [] = x0; minimumOr _ xs = minimum xs; maximumOr x0 [] = x0; maximumOr _ xs = maximum xs};instance (Ord a) => SafeList (V.Vector a) where { type SafeListElem (V.Vector a) = a; headMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeHead xs; lastMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeLast xs; headOr x0 xs | G.null xs = x0 | otherwise = G.unsafeHead xs; lastOr x0 xs | G.null xs = x0 | otherwise = G.unsafeLast xs; minimumMay xs | G.null xs = Nothing | otherwise = Just $ G.minimum xs; maximumMay xs | G.null xs = Nothing | otherwise = Just $ G.maximum xs; minimumOr x0 xs | G.null xs = x0 | otherwise = G.minimum xs; maximumOr x0 xs | G.null xs = x0 | otherwise = G.maximum xs};instance (U.Unbox a, Ord a) => SafeList (U.Vector a) where { type SafeListElem (U.Vector a) = a; headMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeHead xs; lastMay xs | G.null xs = Nothing | otherwise = Just $ G.unsafeLast xs; headOr x0 xs | G.null xs = x0 | otherwise = G.unsafeHead xs; lastOr x0 xs | G.null xs = x0 | otherwise = G.unsafeLast xs; minimumMay xs | G.null xs = Nothing | otherwise = Just $ G.minimum xs; maximumMay xs | G.null xs = Nothing | otherwise = Just $ G.maximum xs; minimumOr x0 xs | G.null xs = x0 | otherwise = G.minimum xs; maximumOr x0 xs | G.null xs = x0 | otherwise = G.maximum xs};data BinaryHeap (f :: Type -> Type) s a = BinaryHeap{priorityBH :: !(a -> f a), intVarsBH :: !(UM.MVector s Int), internalVecBH :: !(UM.MVector s a)};_sizeBH :: Int;_sizeBH = 0;{-# INLINE _sizeBH #-};type MinBinaryHeap s a = BinaryHeap Identity s a;type MaxBinaryHeap s a = BinaryHeap Down s a;newBinaryHeap :: (U.Unbox a, PrimMonad m) => (a -> f a) -> Int -> m (BinaryHeap f (PrimState m) a);newBinaryHeap prio n = BinaryHeap prio <$> UM.replicate 1 0 <*> UM.unsafeNew n;newMinBinaryHeap :: (U.Unbox a, PrimMonad m) => Int -> m (MinBinaryHeap (PrimState m) a);newMinBinaryHeap = newBinaryHeap Identity;newMaxBinaryHeap :: (U.Unbox a, PrimMonad m) => Int -> m (MaxBinaryHeap (PrimState m) a);newMaxBinaryHeap = newBinaryHeap Down;getBinaryHeapSize :: (PrimMonad m) => BinaryHeap f (PrimState m) a -> m Int;getBinaryHeapSize BinaryHeap{..} = UM.unsafeRead intVarsBH _sizeBH;{-# INLINE getBinaryHeapSize #-};siftUpBy :: (U.Unbox a, PrimMonad m) => (a -> a -> Ordering) -> Int -> UM.MVector (PrimState m) a -> m ();siftUpBy cmp k vec = do { x <- UM.unsafeRead vec k; flip fix k $ \ loop !i -> if i > 0 then do { let { parent = (i - 1) `unsafeShiftR` 1}; p <- UM.unsafeRead vec parent; case cmp p x of { GT -> UM.unsafeWrite vec i p >> loop parent; _ -> UM.unsafeWrite vec i x}} else UM.unsafeWrite vec 0 x};{-# INLINE siftUpBy #-};siftDownBy :: (U.Unbox a, PrimMonad m) => (a -> a -> Ordering) -> Int -> UM.MVector (PrimState m) a -> m ();siftDownBy cmp k vec = do { x <- UM.unsafeRead vec k; let { !n = UM.length vec}; flip fix k $ \ loop !i -> do { let { l = unsafeShiftL i 1 .|. 1}; let { r = l + 1}; if n <= l then UM.unsafeWrite vec i x else do { vl <- UM.unsafeRead vec l; if r < n then do { vr <- UM.unsafeRead vec r; case cmp vr vl of { LT -> case cmp x vr of { GT -> UM.unsafeWrite vec i vr >> loop r; _ -> UM.unsafeWrite vec i x}; _ -> case cmp x vl of { GT -> UM.unsafeWrite vec i vl >> loop l; _ -> UM.unsafeWrite vec i x}}} else case cmp x vl of { GT -> UM.unsafeWrite vec i vl >> loop l; _ -> UM.unsafeWrite vec i x}}}};{-# INLINE siftDownBy #-};heapifyBy :: (U.Unbox a, PrimMonad m) => (a -> a -> Ordering) -> UM.MVector (PrimState m) a -> m ();heapifyBy cmp vec = do { let { n = UM.length vec `quot` 2}; forM_ [n - 1, n - 2 .. 0] $ \ i -> do { siftDownBy cmp i vec}};{-# INLINE heapifyBy #-};class OrdVia f a where { compareVia :: (a -> f a) -> a -> a -> Ordering};instance (Ord a) => OrdVia Identity a where { compareVia _ = coerce (compare :: Identity a -> Identity a -> Ordering); {-# INLINE compareVia #-}};instance (Ord a) => OrdVia Down a where { compareVia _ = coerce (compare :: Down a -> Down a -> Ordering); {-# INLINE compareVia #-}};buildBinaryHeapVia :: (OrdVia f a, U.Unbox a, PrimMonad m) => (a -> f a) -> U.Vector a -> m (BinaryHeap f (PrimState m) a);buildBinaryHeapVia priorityBH vec = do { intVarsBH <- UM.replicate 1 $ U.length vec; internalVecBH <- U.thaw vec; heapifyBy (compareVia priorityBH) internalVecBH; return $! BinaryHeap{..}};{-# INLINE buildBinaryHeapVia #-};buildMinBinaryHeap :: (Ord a, U.Unbox a, PrimMonad m) => U.Vector a -> m (BinaryHeap Identity (PrimState m) a);buildMinBinaryHeap = buildBinaryHeapVia Identity;{-# INLINE buildMinBinaryHeap #-};buildMaxBinaryHeap :: (Ord a, U.Unbox a, PrimMonad m) => U.Vector a -> m (BinaryHeap Down (PrimState m) a);buildMaxBinaryHeap = buildBinaryHeapVia Down;{-# INLINE buildMaxBinaryHeap #-};unsafeViewBH :: (U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m a;unsafeViewBH BinaryHeap{..} = UM.unsafeRead internalVecBH 0;{-# INLINE unsafeViewBH #-};viewBH :: (U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m (Maybe a);viewBH bh = do { size <- getBinaryHeapSize bh; if size > 0 then Just <$!> unsafeViewBH bh else return Nothing};{-# INLINE viewBH #-};insertBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> a -> m ();insertBH BinaryHeap{..} x = do { size <- UM.unsafeRead intVarsBH _sizeBH; UM.unsafeWrite intVarsBH _sizeBH (size + 1); UM.unsafeWrite internalVecBH size x; siftUpBy (compareVia priorityBH) size internalVecBH};{-# INLINE insertBH #-};unsafeDeleteBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m ();unsafeDeleteBH BinaryHeap{..} = do { size' <- subtract 1 <$!> UM.unsafeRead intVarsBH _sizeBH; UM.unsafeWrite intVarsBH _sizeBH size'; UM.unsafeSwap internalVecBH 0 size'; siftDownBy (compareVia priorityBH) 0 (UM.unsafeTake size' internalVecBH)};{-# INLINE unsafeDeleteBH #-};modifyTopBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> (a -> a) -> m ();modifyTopBH BinaryHeap{..} f = do { UM.unsafeModify internalVecBH f 0; size <- UM.unsafeRead intVarsBH _sizeBH; siftDownBy (compareVia priorityBH) 0 (UM.unsafeTake size internalVecBH)};{-# INLINE modifyTopBH #-};deleteFindTopBH :: (OrdVia f a, U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m (Maybe a);deleteFindTopBH bh = do { size <- getBinaryHeapSize bh; if size > 0 then do { !top <- unsafeViewBH bh <* unsafeDeleteBH bh; return $ Just top} else return Nothing};{-# INLINE deleteFindTopBH #-};clearBH :: (PrimMonad m) => BinaryHeap f (PrimState m) a -> m ();clearBH BinaryHeap{..} = UM.unsafeWrite intVarsBH 0 0;freezeInternalVecBH :: (U.Unbox a, PrimMonad m) => BinaryHeap f (PrimState m) a -> m (U.Vector a);freezeInternalVecBH BinaryHeap{..} = do { size <- UM.unsafeRead intVarsBH _sizeBH; U.unsafeFreeze (UM.unsafeTake size internalVecBH)};type MultiSet = (Int, IM.IntMap Int);{-# INLINE emptyMS #-};emptyMS :: MultiSet;emptyMS = (0, IM.empty);{-# INLINE singletonMS #-};singletonMS :: Int -> MultiSet;singletonMS !x = (1, IM.singleton x 1);{-# INLINE fromListMS #-};fromListMS :: [Int] -> MultiSet;fromListMS = foldl' (flip incMS) emptyMS;{-# INLINE incMS #-};incMS :: Int -> MultiSet -> MultiSet;incMS !k (!nKeys, !im) = case IM.lookup k im of { Just !n -> (nKeys, IM.insert k (n + 1) im); Nothing -> (nKeys + 1, IM.insert k 1 im)};{-# INLINE decMS #-};decMS :: Int -> MultiSet -> MultiSet;decMS !k (!nKeys, !im) = case IM.lookup k im of { Just 1 -> (nKeys - 1, IM.delete k im); Just n -> (nKeys, IM.insert k (n - 1) im); Nothing -> (nKeys, im)};{-# INLINE addMS #-};addMS :: Int -> Int -> MultiSet -> MultiSet;addMS !k !dn (!nKeys, !im) = case IM.lookup k im of { Just n -> (nKeys, IM.insert k (n + dn) im); Nothing -> (nKeys + 1, IM.insert k dn im)};{-# INLINE subMS #-};subMS :: Int -> Int -> MultiSet -> MultiSet;subMS !k !dn (!nKeys, !im) = case IM.lookup k im of { Just n | n > dn -> (nKeys, IM.insert k (n - dn) im) | n == dn -> (nKeys - 1, IM.delete k im) | otherwise -> (nKeys - 1, IM.delete k im); Nothing -> (nKeys, im)};{-# INLINE memberMS #-};memberMS :: Int -> MultiSet -> Bool;memberMS !k (!_, !im) = IM.member k im;{-# INLINE notMemberMS #-};notMemberMS :: Int -> MultiSet -> Bool;notMemberMS !k (!_, !im) = IM.notMember k im;{-# INLINE decFindMinMS #-};decFindMinMS :: MultiSet -> (Int, MultiSet);decFindMinMS ms@(!_, !im) = let { !key = fst $ IM.findMin im} in (key, decMS key ms);{-# INLINE lookupMS #-};lookupMS :: Int -> MultiSet -> Maybe Int;lookupMS !k = IM.lookup k . innerMS;{-# INLINE getMS #-};getMS :: (HasCallStack) => Int -> MultiSet -> Int;getMS !k !ms = case lookupMS k ms of { Just x -> x; Nothing -> error $ "getMS: panic with key: " ++ show k};{-# INLINE innerMS #-};innerMS :: MultiSet -> IM.IntMap Int;innerMS (!_, !im) = im;data MultiSetVec s = MultiSetVec (MutVar s Int) (UM.MVector s Int);showMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m String;showMSV (MultiSetVec !nRef !mVec) = do { !n <- readMutVar nRef; !vec <- G.unsafeFreeze mVec; return $ show (n, vec)};newMSV :: (PrimMonad m) => Int -> m (MultiSetVec (PrimState m));newMSV !capacity = MultiSetVec <$> newMutVar (0 :: Int) <*> UM.replicate capacity (0 :: Int);clearMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m ();clearMSV (MultiSetVec !nRef !mVec) = do { writeMutVar nRef 0; GM.set mVec 0};fromVecMSV :: (PrimMonad m) => Int -> U.Vector Int -> m (MultiSetVec (PrimState m));fromVecMSV !capacity !xs = do { !msv <- newMSV capacity; U.forM_ xs (incMSV msv); return msv};countMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m Int;countMSV (MultiSetVec !nRef !_) = readMutVar nRef;nullMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m Bool;nullMSV = fmap (== 0) . countMSV;readMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> Int -> m Int;readMSV (MultiSetVec !_ !mVec) = GM.read mVec;incMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> Int -> m ();incMSV (MultiSetVec !nRef !mVec) k = GM.read mVec k >>= \case { 0 -> do { modifyMutVar' nRef succ; GM.write mVec k 1}; !nk -> do { GM.write mVec k (nk + 1)}};decMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> Int -> m ();decMSV (MultiSetVec !nRef !mVec) k = GM.read mVec k >>= \case { 0 -> return (); 1 -> do { modifyMutVar' nRef pred; GM.write mVec k 0}; !nk -> do { GM.write mVec k (nk - 1)}};minMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m (Maybe (Int, Int));minMSV (MultiSetVec !nRef !mVec) = readMutVar nRef >>= \case { 0 -> return Nothing; _ -> do { !vec <- G.unsafeFreeze mVec; return . fmap (\ i -> (i, vec G.! i)) $ G.findIndex (> 0) vec}};maxMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m (Maybe (Int, Int));maxMSV (MultiSetVec !nRef !mVec) = readMutVar nRef >>= \case { 0 -> return Nothing; _ -> do { !vec <- G.unsafeFreeze mVec; return . fmap (\ i -> (i, vec G.! i)) $ G.findIndexR (> 0) vec}};unsafeFreezeMSV :: (PrimMonad m) => MultiSetVec (PrimState m) -> m (Int, U.Vector Int);unsafeFreezeMSV (MultiSetVec !nRef !mVec) = (,) <$> readMutVar nRef <*> U.unsafeFreeze mVec;data RH b p = RH{nextDigitRH :: {-# UNPACK #-} !Int, hashRH :: {-# UNPACK #-} !Int} deriving (Eq, Ord, Show);{-# INLINE rh1 #-};rh1 :: forall b p . (KnownNat b) => Int -> RH b p;rh1 = RH (fromInteger (natVal' (proxy# @b)));instance (KnownNat b, KnownNat p) => Semigroup (RH b p) where { {-# INLINE (<>) #-}; (RH !digit1 !hash1) <> (RH !digit2 !hash2) = RH digit' hash' where { !p = fromInteger $ natVal' (proxy# @p); !digit' = digit1 * digit2 `mod` p; !hash' = (hash1 * digit2 + hash2) `mod` p}};instance (KnownNat b, KnownNat p) => Monoid (RH b p) where { {-# INLINE mempty #-}; mempty = RH 1 0};type RHRepr = A2 Int;instance U.IsoUnbox (RH b p) RHRepr where { {-# INLINE toURepr #-}; toURepr (RH a b) = A2 a b; {-# INLINE fromURepr #-}; fromURepr (A2 a b) = RH a b};newtype instance  U.MVector s (RH b p) = MV_RH (UM.MVector s RHRepr);newtype instance  U.Vector (RH b p) = V_RH (U.Vector RHRepr);deriving via (RH b p `U.As` RHRepr) instance GM.MVector UM.MVector (RH b p);deriving via (RH b p `U.As` RHRepr) instance G.Vector U.Vector (RH b p);instance U.Unbox (RH b p);data RollingHash b p = RollingHash{sourceLength :: !Int, dimensions :: !(U.Vector Int), hashSum :: !(U.Vector Int)} deriving (Show, Eq);type HashInt = (100 :: Nat);newRH :: forall p . (KnownNat p) => String -> RollingHash HashInt p;newRH !source = RollingHash n bn hashSum_ where { !p = fromInteger $ natVal (Proxy @p) :: Int; !b = fromInteger $ natVal (Proxy @HashInt) :: Int; !n = length source; !bn = U.iterateN (succ n) (\ lastB -> b * lastB `mod` p) (1 :: Int); !hashSum_ = evalState (U.mapM (\ !ch -> state $ \ !acc -> f ch acc) $ U.fromList source) (0 :: Int) where { f :: Char -> Int -> (Int, Int); f !ch !lastX = dupe $! (lastX * b + ord ch) `mod` p}};lengthRH :: RollingHash b p -> Int;lengthRH (RollingHash !len !_ !_) = len;data HashSlice p = HashSlice{hashValue :: {-# UNPACK #-} !Int, hashLength :: {-# UNPACK #-} !Int} deriving (Show, Eq);sliceRH :: forall b p . (KnownNat p) => RollingHash b p -> Int -> Int -> HashSlice p;sliceRH (RollingHash !_ !bn !s) !i0 !i1 | i0 > i1 = emptyHS | otherwise = let { !len = i1 - i0 + 1; !s1 = s U.! i1; !s0 = fromMaybe 0 $ s U.!? pred i0; !value = (s1 - (bn U.! len) * s0) `mod` p} in HashSlice value len where { !p = fromInteger $ natVal (Proxy @p) :: Int};consHS :: forall b p . (KnownNat p) => RollingHash b p -> HashSlice p -> HashSlice p -> HashSlice p;consHS (RollingHash !_ !bn !_) (HashSlice !v0 !l0) (HashSlice !v1 !l1) = HashSlice value len where { !p = fromInteger $ natVal (Proxy @p) :: Int; !value = ((bn U.! l1) * v0 + v1) `mod` p; !len = l0 + l1};emptyHS :: HashSlice p;emptyHS = HashSlice 0 0;concatHS :: forall b p t . (KnownNat p, Foldable t) => RollingHash b p -> t (HashSlice p) -> HashSlice p;concatHS !rhash !slices = foldl' (consHS rhash) emptyHS slices;data Buffer s a = Buffer{bufferVars :: !(UM.MVector s Int), internalBuffer :: !(UM.MVector s a), internalBufferSize :: !Int};_bufferFrontPos :: Int;_bufferFrontPos = 0;_bufferBackPos :: Int;_bufferBackPos = 1;newBuffer :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBuffer n = Buffer <$> UM.replicate 2 0 <*> UM.unsafeNew n <*> pure n;type Stack s a = Buffer s a;newBufferAsStack :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBufferAsStack n = Buffer <$> UM.replicate 2 0 <*> UM.unsafeNew n <*> pure n;createBuffer :: (U.Unbox a) => (forall s . ST s (Buffer s a)) -> U.Vector a;createBuffer f = runST $ do { !buf <- f; unsafeFreezeBuffer buf};type Queue s a = Buffer s a;newBufferAsQueue :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBufferAsQueue n = Buffer <$> UM.replicate 2 0 <*> UM.unsafeNew n <*> pure n;type Deque s a = Buffer s a;newBufferAsDeque :: (U.Unbox a, PrimMonad m) => Int -> m (Buffer (PrimState m) a);newBufferAsDeque n = Buffer <$> UM.replicate 2 n <*> UM.unsafeNew (2 * n) <*> pure (2 * n);lengthBuffer :: (PrimMonad m) => Buffer (PrimState m) a -> m Int;lengthBuffer Buffer{bufferVars} = liftA2 (-) (UM.unsafeRead bufferVars _bufferBackPos) (UM.unsafeRead bufferVars _bufferFrontPos);{-# INLINE lengthBuffer #-};nullBuffer :: (PrimMonad m) => Buffer (PrimState m) a -> m Bool;nullBuffer = fmap (== 0) . lengthBuffer;{-# INLINE nullBuffer #-};clearBuffer :: (PrimMonad m) => Buffer (PrimState m) a -> m ();clearBuffer Buffer{bufferVars} = do { UM.unsafeWrite bufferVars _bufferFrontPos 0; UM.unsafeWrite bufferVars _bufferBackPos 0};freezeBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);freezeBuffer Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; U.freeze $ UM.unsafeSlice f (b - f) internalBuffer};unsafeFreezeBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);unsafeFreezeBuffer Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; U.unsafeFreeze $ UM.unsafeSlice f (b - f) internalBuffer};freezeInternalBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);freezeInternalBuffer Buffer{bufferVars, internalBuffer} = do { b <- UM.unsafeRead bufferVars _bufferBackPos; U.freeze $ UM.unsafeSlice 0 b internalBuffer};unsafeFreezeInternalBuffer :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (U.Vector a);unsafeFreezeInternalBuffer Buffer{bufferVars, internalBuffer} = do { b <- UM.unsafeRead bufferVars _bufferBackPos; U.unsafeFreeze $ UM.unsafeSlice 0 b internalBuffer};popFront :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);popFront Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then do { UM.unsafeWrite bufferVars _bufferFrontPos (f + 1); pure <$> UM.unsafeRead internalBuffer f} else return Nothing};{-# INLINE popFront #-};popFront_ :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m ();popFront_ = void . popFront;{-# INLINE popFront_ #-};popFrontN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe (U.Vector a));popFrontN Buffer{bufferVars, internalBuffer} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { res <- U.freeze (UM.slice f len internalBuffer); UM.unsafeWrite bufferVars _bufferFrontPos (f + len); pure $ Just res} else return Nothing};{-# INLINE popFrontN #-};popBackN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe (U.Vector a));popBackN Buffer{bufferVars, internalBuffer} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { res <- U.freeze (UM.slice (b - len) len internalBuffer); UM.unsafeWrite bufferVars _bufferBackPos (b - len); pure $ Just res} else pure Nothing};{-# INLINE popBackN #-};popFrontN_ :: (PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe ());popFrontN_ Buffer{bufferVars} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { UM.unsafeWrite bufferVars _bufferFrontPos (f + len); pure $ Just ()} else pure Nothing};{-# INLINE popFrontN_ #-};popBackN_ :: (PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe ());popBackN_ Buffer{bufferVars} len = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if b - f >= len then do { UM.unsafeWrite bufferVars _bufferBackPos (b - len); pure $ Just ()} else pure Nothing};{-# INLINE popBackN_ #-};viewFront :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);viewFront Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then pure <$> UM.unsafeRead internalBuffer f else return Nothing};{-# INLINE viewFront #-};popBack :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);popBack Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then do { UM.unsafeWrite bufferVars _bufferBackPos (b - 1); pure <$> UM.unsafeRead internalBuffer (b - 1)} else return Nothing};{-# INLINE popBack #-};popBack_ :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m ();popBack_ = void . popBack;{-# INLINE popBack_ #-};viewBack :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> m (Maybe a);viewBack Buffer{bufferVars, internalBuffer} = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; b <- UM.unsafeRead bufferVars _bufferBackPos; if f < b then pure <$> UM.unsafeRead internalBuffer (b - 1) else return Nothing};{-# INLINE viewBack #-};pushFront :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> a -> m ();pushFront Buffer{bufferVars, internalBuffer} x = do { f <- UM.unsafeRead bufferVars _bufferFrontPos; UM.unsafeWrite bufferVars _bufferFrontPos (f - 1); assert (f > 0) $ do { UM.unsafeWrite internalBuffer (f - 1) x}};{-# INLINE pushFront #-};pushBack :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> a -> m ();pushBack Buffer{bufferVars, internalBuffer, internalBufferSize} x = do { b <- UM.unsafeRead bufferVars _bufferBackPos; UM.unsafeWrite bufferVars _bufferBackPos (b + 1); assert (b < internalBufferSize) $ do { UM.unsafeWrite internalBuffer b x}};{-# INLINE pushBack #-};pushFronts :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> U.Vector a -> m ();pushFronts Buffer{bufferVars, internalBuffer} vec = do { let { n = U.length vec}; f <- UM.unsafeRead bufferVars _bufferFrontPos; UM.unsafeWrite bufferVars _bufferFrontPos (f - n); assert (n <= f) $ do { U.unsafeCopy (UM.unsafeSlice (f - n) n internalBuffer) vec}};{-# INLINE pushFronts #-};pushBacks :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> U.Vector a -> m ();pushBacks Buffer{bufferVars, internalBuffer, internalBufferSize} vec = do { let { n = U.length vec}; b <- UM.unsafeRead bufferVars _bufferBackPos; UM.unsafeWrite bufferVars _bufferBackPos (b + n); assert (b + n - 1 < internalBufferSize) $ do { U.unsafeCopy (UM.unsafeSlice b n internalBuffer) vec}};{-# INLINE pushBacks #-};viewFrontN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe a);viewFrontN Buffer{..} i = do { !f <- UM.unsafeRead bufferVars _bufferFrontPos; !b <- UM.unsafeRead bufferVars _bufferBackPos; if inRange (f, b - 1) (f + i) then Just <$> UM.read internalBuffer (f + i) else return Nothing};{-# INLINE viewFrontN #-};viewBackN :: (U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m (Maybe a);viewBackN Buffer{..} i = do { !f <- UM.unsafeRead bufferVars _bufferFrontPos; !b <- UM.unsafeRead bufferVars _bufferBackPos; if inRange (f, b - 1) (b - 1 - i) then Just <$> UM.read internalBuffer (b - 1 - i) else return Nothing};{-# INLINE viewBackN #-};readFront :: (HasCallStack, U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m a;readFront = (fmap fromJust .) . viewFrontN;{-# INLINE readFront #-};readBack :: (HasCallStack, U.Unbox a, PrimMonad m) => Buffer (PrimState m) a -> Int -> m a;readBack = (fmap fromJust .) . viewBackN;{-# INLINE readBack #-};data MaxFlow s c = MaxFlow{nVertsMF :: !Int, nEdgesMF :: !Int, offsetsMF :: !(U.Vector Int), edgeDstMF :: !(U.Vector Int), edgeRevIndexMF :: !(U.Vector Int), edgeCapMF :: !(UM.MVector s c)};data MaxFlowBuffer s c = MaxFlowBuffer{distsMF :: !(UM.MVector s Int), queueMF :: !(Buffer s Vertex), iterMF :: !(UM.MVector s Int)};maxFlow :: (U.Unbox c, Num c, Ord c, Bounded c) => Int -> Int -> Int -> U.Vector (Vertex, Vertex, c) -> c;maxFlow !nVerts !src !sink !edges = runST $ do { fst <$> maxFlow' nVerts src sink edges};maxFlow' :: (PrimMonad m, U.Unbox c, Num c, Ord c, Bounded c) => Int -> Int -> Int -> U.Vector (Vertex, Vertex, c) -> m (c, MaxFlow (PrimState m) c);maxFlow' !nVerts !src !sink !edges = do { !container <- buildMaxFlow nVerts edges; !flow <- runMaxFlow src sink container; return (flow, container)};edgesMF :: (PrimMonad m, U.Unbox c, Num c, Ord c, Bounded c) => MaxFlow (PrimState m) c -> m (U.Vector (Int, Int, c, c));edgesMF MaxFlow{..} = do { !edgeCap <- U.unsafeFreeze edgeCapMF; let { next (!i12, !v1) | i12 == offsetsMF U.! (v1 + 1) = next (i12, v1 + 1) | otherwise = ((v1, v2, cap, flow), (i12 + 1, v1)) where { v2 = edgeDstMF U.! i12; i21 = edgeRevIndexMF U.! i12; flow = edgeCap U.! i21; cap = edgeCap U.! i12 + edgeCap U.! i21}}; return $ U.unfoldrExactN nEdgesMF next ((0 :: Vertex), 0 :: Int)};undefMF :: Int;undefMF = -1;buildMaxFlow :: forall c m . (U.Unbox c, Num c, PrimMonad m) => Int -> U.Vector (Vertex, Vertex, c) -> m (MaxFlow (PrimState m) c);buildMaxFlow !nVertsMF !edges = do { let { !offsetsMF = U.scanl' (+) (0 :: Int) $ U.create $ do { !degs <- UM.replicate nVertsMF (0 :: Int); G.forM_ edges $ \ (!v1, !v2, !_) -> do { GM.modify degs (+ 1) v1; GM.modify degs (+ 1) v2}; return degs}}; (!edgeDstMF, !edgeRevIndexMF, !edgeCapMF) <- do { !edgeDst <- UM.replicate nEdgesMF undefMF; !edgeRevIndex <- UM.replicate nEdgesMF undefMF; !edgeCap <- UM.replicate nEdgesMF (0 :: c); !edgeCounter <- U.thaw offsetsMF; G.forM_ edges $ \ (!v1, !v2, !cap) -> do { !i1 <- GM.read edgeCounter v1; !i2 <- GM.read edgeCounter v2; GM.modify edgeCounter (+ 1) v1; GM.modify edgeCounter (+ 1) v2; GM.write edgeRevIndex i1 i2; GM.write edgeRevIndex i2 i1; GM.write edgeDst i1 v2; GM.write edgeDst i2 v1; GM.write edgeCap i1 cap}; (, , edgeCap) <$> G.unsafeFreeze edgeDst <*> G.unsafeFreeze edgeRevIndex}; return MaxFlow{..}} where { !nEdgesMF = G.length edges * 2};runMaxFlow :: forall c m . (U.Unbox c, Num c, Ord c, Bounded c, PrimMonad m) => Vertex -> Vertex -> MaxFlow (PrimState m) c -> m c;runMaxFlow !src !sink container@MaxFlow{..} = do { bufs@MaxFlowBuffer{..} <- MaxFlowBuffer <$> UM.unsafeNew nVertsMF <*> newBufferAsQueue nVertsMF <*> U.thaw offsetsMF; flip fix 0 $ \ loopBfs !flow -> do { GM.set distsMF undefMF; clearBuffer queueMF; runMaxFlowBfs src sink container bufs; !distSink <- UM.read distsMF sink; if distSink == undefMF then return flow else do { U.unsafeCopy iterMF offsetsMF; flip fix flow $ \ loopDfs f -> do { !df <- runMaxFlowDfs src sink maxBound container bufs; if df > 0 then loopDfs $! f + df else loopBfs f}}}};runMaxFlowBfs :: forall c m . (U.Unbox c, Num c, Ord c, PrimMonad m) => Vertex -> Vertex -> MaxFlow (PrimState m) c -> MaxFlowBuffer (PrimState m) c -> m ();runMaxFlowBfs !src !sink MaxFlow{..} MaxFlowBuffer{..} = do { UM.write distsMF src 0; pushBack queueMF src; fix $ \ loop -> popFront queueMF >>= \case { Nothing -> return (); Just !v1 -> do { !notEnd <- (== undefMF) <$> UM.read distsMF sink; when notEnd $ do { let { !iStart = offsetsMF U.! v1; !iEnd = offsetsMF U.! (v1 + 1)}; !dist1 <- UM.read distsMF v1; U.forM_ (U.generate (iEnd - iStart) (+ iStart)) $ \ i12 -> do { let { !v2 = edgeDstMF U.! i12}; !cap12 <- UM.read edgeCapMF i12; !notVisited <- (== undefMF) <$> UM.read distsMF v2; when (cap12 > 0 && notVisited) $ do { UM.write distsMF v2 (dist1 + 1); pushBack queueMF v2}}; loop}}}};runMaxFlowDfs :: forall c m . (U.Unbox c, Num c, Ord c, PrimMonad m) => Vertex -> Vertex -> c -> MaxFlow (PrimState m) c -> MaxFlowBuffer (PrimState m) c -> m c;runMaxFlowDfs !v0 !sink !flow0 MaxFlow{..} MaxFlowBuffer{..} = runDfs v0 flow0 where { runDfs !v1 !flow | v1 == sink = return flow | otherwise = fix $ \ visitNeighbor -> do { !i1 <- UM.read iterMF v1; if i1 >= offsetsMF U.! (v1 + 1) then do { return 0} else do { UM.write iterMF v1 (i1 + 1); let { !v2 = edgeDstMF U.! i1}; !cap12 <- UM.read edgeCapMF i1; !connected <- (<) <$> UM.read distsMF v1 <*> UM.read distsMF v2; if cap12 > 0 && connected then do { !flow' <- runDfs v2 $! min flow cap12; if flow' > 0 then do { modifyFlow i1 flow'; return flow'} else visitNeighbor} else visitNeighbor}}; modifyFlow !i1 !flow = do { UM.modify edgeCapMF (subtract flow) i1; UM.modify edgeCapMF (+ flow) (edgeRevIndexMF U.! i1)}};{-# INLINE bisect #-};bisect :: Int -> Int -> (Int -> Bool) -> (Maybe Int, Maybe Int);bisect !l !r = runIdentity . bisectM l r . (return .);{-# INLINE bisectL #-};bisectL :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectL !a !b !c = fst $! bisect a b c;{-# INLINE bisectR #-};bisectR :: Int -> Int -> (Int -> Bool) -> Maybe Int;bisectR !a !b !c = snd $! bisect a b c;{-# INLINE bisectM #-};bisectM :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int, Maybe Int);bisectM !low !high !isOk = both wrap <$> inner (low - 1) (high + 1) where { inner :: Int -> Int -> m (Int, Int); inner !ok !ng | abs (ok - ng) == 1 = return (ok, ng); inner !ok !ng = isOk m >>= \case { True -> inner m ng; False -> inner ok m} where { !m = (ok + ng) `div` 2}; wrap :: Int -> Maybe Int; wrap !x | inRange (low, high) x = Just x | otherwise = Nothing};{-# INLINE bisectML #-};bisectML :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectML !a !b !c = fst <$> bisectM a b c;{-# INLINE bisectMR #-};bisectMR :: forall m . (Monad m) => Int -> Int -> (Int -> m Bool) -> m (Maybe Int);bisectMR !a !b !c = snd <$> bisectM a b c;{-# INLINE bisectF32 #-};bisectF32 :: Float -> Float -> Float -> (Float -> Bool) -> (Maybe Float, Maybe Float);bisectF32 !low !high !diff !isOk = both wrap (inner (low - diff) (high + diff)) where { inner :: Float -> Float -> (Float, Float); inner !ok !ng | abs (ok - ng) <= diff = (ok, ng); inner !ok !ng | isOk m = inner m ng | otherwise = inner ok m where { !m = (ok + ng) / 2}; wrap :: Float -> Maybe Float; wrap !x | x == (low - diff) || x == (high + diff) = Nothing | otherwise = Just x};{-# INLINE bisectF32L #-};bisectF32L :: Float -> Float -> Float -> (Float -> Bool) -> Maybe Float;bisectF32L !a !b !c !d = fst $! bisectF32 a b c d;{-# INLINE bisectF32R #-};bisectF32R :: Float -> Float -> Float -> (Float -> Bool) -> Maybe Float;bisectF32R !a !b !c !d = snd $! bisectF32 a b c d;{-# INLINE bisectF64 #-};bisectF64 :: Double -> Double -> Double -> (Double -> Bool) -> (Maybe Double, Maybe Double);bisectF64 !low !high !diff !isOk = both wrap (inner (low - diff) (high + diff)) where { inner :: Double -> Double -> (Double, Double); inner !ok !ng | abs (ok - ng) < diff = (ok, ng); inner !ok !ng | isOk m = inner m ng | otherwise = inner ok m where { !m = (ok + ng) / 2}; wrap :: Double -> Maybe Double; wrap !x | x == (low - diff) || x == (high + diff) = Nothing | otherwise = Just x};{-# INLINE bisectF64L #-};bisectF64L :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectF64L !a !b !c !d = fst $! bisectF64 a b c d;{-# INLINE bisectF64R #-};bisectF64R :: Double -> Double -> Double -> (Double -> Bool) -> Maybe Double;bisectF64R !a !b !c !d = snd $! bisectF64 a b c d;{-# 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};{-# 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};isqrtSlow :: Int -> Int;isqrtSlow n = fromJust $ bisectR 0 n ((< n) . (^ (2 :: Int)));twoPointers :: Int -> (Int -> Int -> Bool) -> [(Int, Int)];twoPointers !n !p = unfoldr (uncurry f) s0 where { !s0 = (0, 0) :: (Int, Int); f l r | l == n = Nothing | not (p l r) = f (l + 1) (max (l + 1) r) | otherwise = Just ((l, r'), (l + 1, max (l + 1) r')) where { r' = until ((||) <$> (== n - 1) <*> not . p l . succ) succ r}};twoPointersU :: Int -> (Int -> Int -> Bool) -> U.Vector (Int, Int);twoPointersU !n !p = U.unfoldr (uncurry f) s0 where { !s0 = (0, 0) :: (Int, Int); f l r | l == n = Nothing | not (p l r) = f (l + 1) (max (l + 1) r) | otherwise = Just ((l, r'), (l + 1, max (l + 1) r')) where { r' = until ((||) <$> (== n - 1) <*> not . p l . succ) succ r}};{-# INLINE twoPtrM #-};twoPtrM :: forall acc m v a . (Monad m, G.Vector v a) => acc -> (acc -> a -> m Bool) -> (acc -> a -> m acc) -> (acc -> a -> m acc) -> v a -> m [(Int, Int)];twoPtrM acc0 p onNext onPop xs0 = inner acc0 xs0 xs0 (0 :: Int) (0 :: Int) where { inner :: acc -> v a -> v a -> Int -> Int -> m [(Int, Int)]; inner acc pops nexts l r = case G.uncons pops of { Nothing -> return []; Just (!y, !pops') -> case G.uncons nexts of { Just (!x, !nexts') -> do { b <- (r - l == 0 ||) <$> p acc x; if b then do { !acc' <- onNext acc x; inner acc' pops nexts' l (r + 1)} else do { !acc' <- onPop acc y; ((l, r) :) <$> inner acc' pops' nexts (l + 1) r}}; Nothing -> do { !acc' <- onPop acc y; ((l, r) :) <$> inner acc' pops' nexts (l + 1) r}}}};{-# INLINE twoPtr #-};twoPtr :: (G.Vector v a) => acc -> (acc -> a -> Bool) -> (acc -> a -> acc) -> (acc -> a -> acc) -> v a -> [(Int, Int)];twoPtr acc0 p onNext onPop = runIdentity . twoPtrM acc0 ((pure .) . p) ((pure .) . onNext) ((pure .) . onPop);rolls :: (RandomGen g, UniformRange a, U.Unbox a) => Int -> (a, a) -> g -> U.Vector a;rolls n rng = U.unfoldrExactN n (uniformR rng);rollsM :: (StatefulGen g m, UniformRange a, U.Unbox a) => Int -> (a, a) -> g -> m (U.Vector a);rollsM n rng = U.replicateM n . uniformRM rng;uniformRSt :: (RandomGen g, UniformRange a, MonadState g m) => (a, a) -> m a;uniformRSt !rng = state (uniformR rng);dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();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 ();dbgUF :: (PrimMonad m, Show (U.Vector MUFNode)) => MUnionFind (PrimState m) -> m ();dbgUF (MUnionFind vec) = dbgVec vec;data LazySegmentTree v a op s = LazySegmentTree !(v s a) !(UM.MVector s op) !Int;newLazySTree :: forall v a op m . (GM.MVector v a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> m (LazySegmentTree v a op (PrimState m));newLazySTree !n = do { !as <- GM.replicate n2 mempty; !ops <- UM.replicate n2 mempty; return $ LazySegmentTree as ops h} where { (!h, !n2) = until ((>= 2 * n) . snd) (bimap succ (* 2)) (0 :: Int, 1 :: Int)};newLazySTreeV :: forall a op m . (Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> m (LazySegmentTree VM.MVector a op (PrimState m));newLazySTreeV = newLazySTree;newLazySTreeU :: forall a op m . (U.Unbox a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> m (LazySegmentTree UM.MVector a op (PrimState m));newLazySTreeU = newLazySTree;generateLazySTreeG :: forall v a op m . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> (Int -> a) -> m (LazySegmentTree v a op (PrimState m));generateLazySTreeG !n !f = do { !as <- GM.unsafeNew n2; forM_ [1 .. nLeaves] $ \ i -> do { if i <= n then GM.write as (nLeaves + i - 1) $! f (pred i) else GM.write as (nLeaves + i - 1) mempty}; forM_ [nLeaves - 1, nLeaves - 2 .. 1] $ \ i -> do { !l <- GM.read as (childL i); !r <- GM.read as (childR i); GM.write as i $! l <> r}; !ops <- UM.replicate n2 mempty; return $ LazySegmentTree as ops h} where { (!h, !n2) = until ((>= 2 * n) . snd) (bimap succ (* 2)) (0 :: Int, 1 :: Int); !nLeaves = n2 `div` 2; childL !vertex = vertex .<<. 1; childR !vertex = vertex .<<. 1 .|. 1};generateLazySTreeV :: forall a op m . (HasCallStack, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> (Int -> a) -> m (LazySegmentTree VM.MVector a op (PrimState m));generateLazySTreeV = generateLazySTreeG;generateLazySTreeU :: forall a op m . (HasCallStack, U.Unbox a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => Int -> (Int -> a) -> m (LazySegmentTree UM.MVector a op (PrimState m));generateLazySTreeU = generateLazySTreeG;updateLazySTree :: forall v a op m . (GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> op -> m ();updateLazySTree stree@(LazySegmentTree !_ !ops !_) !iLLeaf !iRLeaf !op = do { let { !_ = dbgAssert (inRange (0, nLeaves - 1) iLLeaf && inRange (0, nLeaves - 1) iRLeaf) $ "updateLazySTree: wrong range " ++ show (iLLeaf, iRLeaf)}; _propOpMonoidsToLeaf stree iLLeaf; _propOpMonoidsToLeaf stree iRLeaf; let { !lVertex = iLLeaf + nLeaves; !rVertex = iRLeaf + nLeaves}; glitchLoopUpdate lVertex rVertex; _evalToRoot stree iLLeaf; _evalToRoot stree iRLeaf; return ()} where { !nLeaves = UM.length ops `div` 2; isLeftChild = not . (`testBit` 0); isRightChild = (`testBit` 0); glitchLoopUpdate :: Int -> Int -> m (); glitchLoopUpdate !l !r | l > r = return () | otherwise = do { !l' <- if isRightChild l then do { UM.modify ops (op <>) l; return $ succ l} else return l; !r' <- if isLeftChild r then do { UM.modify ops (op <>) r; return $ pred r} else return r; glitchLoopUpdate (l' .>>. 1) (r' .>>. 1)}};queryLazySTree :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> m a;queryLazySTree stree@(LazySegmentTree !as !ops !_) !iLLeaf !iRLeaf = do { let { !_ = dbgAssert (inRange (0, nLeaves - 1) iLLeaf && inRange (0, nLeaves - 1) iRLeaf) $ "queryLazySTree: wrong range " ++ show (iLLeaf, iRLeaf)}; _propOpMonoidsToLeaf stree iLLeaf; _propOpMonoidsToLeaf stree iRLeaf; let { !lVertex = iLLeaf + nLeaves; !rVertex = iRLeaf + nLeaves}; glitchFold lVertex rVertex mempty mempty} where { !nLeaves = GM.length as `div` 2; isLeftChild = not . (`testBit` 0); isRightChild = (`testBit` 0); glitchFold :: Int -> Int -> a -> a -> m a; glitchFold !l !r !lAcc !rAcc | l > r = return $! lAcc <> rAcc | otherwise = do { (!l', !lAcc') <- if isRightChild l then do { !la' <- mact <$> UM.read ops l <*> GM.read as l; let { !la'' = lAcc <> la'}; return (succ l, la'')} else return (l, lAcc); (!r', !rAcc') <- if isLeftChild r then do { !ra' <- mact <$> UM.read ops r <*> GM.read as r; let { !ra'' = ra' <> rAcc}; return (pred r, ra'')} else return (r, rAcc); glitchFold (l' .>>. 1) (r' .>>. 1) lAcc' rAcc'}};_propOpMonoidsToLeaf :: (HasCallStack, GM.MVector v a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> m ();_propOpMonoidsToLeaf (LazySegmentTree !as !ops !height) !iLeaf = do { let { !leafVertex = iLeaf + nVerts `div` 2}; forM_ [height - 1, height - 2 .. 1] $ \ iParent -> do { let { !vertex = nthParent leafVertex iParent}; !op <- UM.read ops vertex; when (op /= mempty) $ do { UM.modify ops (op <>) $! childL vertex; UM.modify ops (op <>) $! childR vertex; GM.modify as (mact op) vertex; UM.write ops vertex mempty}}} where { !nVerts = GM.length as; nthParent !leafVertex !nth = leafVertex .>>. nth; childL !vertex = vertex .<<. 1; childR !vertex = vertex .<<. 1 .|. 1};_evalToRoot :: (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> m ();_evalToRoot (LazySegmentTree !as !ops !height) !iLeaf = do { let { !leafVertex = iLeaf + nVerts `div` 2}; forM_ [1 .. pred height] $ \ iParent -> do { let { !vertex = nthParent leafVertex iParent}; let { !_ = dbgAssert (vertex > 0) "_evalToRoot"}; !aL' <- mact <$!> UM.read ops (childL vertex) <*> GM.read as (childL vertex); !aR' <- mact <$!> UM.read ops (childR vertex) <*> GM.read as (childR vertex); GM.write as vertex $! aL' <> aR'}} where { !nVerts = GM.length as; nthParent !leafVertex !nth = leafVertex .>>. nth; childL !vertex = vertex .<<. 1; childR !vertex = vertex .<<. 1 .|. 1};{-# INLINE bisectLazySTree #-};bisectLazySTree :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> (a -> Bool) -> m (Maybe Int, Maybe Int);bisectLazySTree stree@(LazySegmentTree !as !_ !_) l r f = do { bisectM l r $ \ r' -> do { !acc <- queryLazySTree stree l r'; return $! f acc}} where { !_ = dbgAssert (inRange (0, nLeaves - 1) l && inRange (0, nLeaves - 1) r) $ "bisectLazySTree: giveninvalid range " ++ show (l, r) where { nLeaves = GM.length as `div` 2}};{-# INLINE bisectLazySTreeL #-};bisectLazySTreeL :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bisectLazySTreeL stree l r f = fst <$> bisectLazySTree stree l r f;{-# INLINE bisectLazySTreeR #-};bisectLazySTreeR :: forall v a m op . (HasCallStack, GM.MVector v a, Monoid a, MonoidAction op a, Eq op, U.Unbox op, PrimMonad m) => LazySegmentTree v a op (PrimState m) -> Int -> Int -> (a -> Bool) -> m (Maybe Int);bisectLazySTreeR stree l r f = snd <$> bisectLazySTree stree l r f;data SegmentTree v s a = SegmentTree{unSegmentTree :: !(v s a), nValidLeavesSegmentTree :: !Int};newSTree :: (U.Unbox a, Monoid a, PrimMonad m) => Int -> m (SegmentTree UM.MVector (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 UM.MVector (PrimState m) a);buildSTree leaves = do { verts <- GM.unsafeNew nVerts; G.unsafeCopy (GM.unsafeSlice nLeaves (G.length leaves) verts) leaves; 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};readSTree :: (HasCallStack, GM.MVector v a, PrimMonad m) => SegmentTree v (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 :: (Monoid a, GM.MVector v a, PrimMonad m) => v (PrimState m) a -> Int -> m ();_unsafeUpdateParentNodes vec v0 = 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)}};writeSTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (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 ++ " out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};modifySTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (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 ++ " out of " ++ show nValidLeaves; nLeaves = GM.length vec .>>. 1};foldSTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (PrimState m) a -> Int -> Int -> m a;foldSTree (SegmentTree vec nValidLeaves) l0 r0 = 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); !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'}};foldMaySTree :: (HasCallStack, Monoid a, GM.MVector v a, PrimMonad m) => SegmentTree v (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};foldWholeSTree :: (HasCallStack, GM.MVector v a, PrimMonad m) => SegmentTree v (PrimState m) a -> m a;foldWholeSTree (SegmentTree vec _) = GM.read vec 1;type CapacityMCF c = c;type FlowMCF c = c;type CostMCF c = c;data MinCostFlow s c = MinCostFlow{nVertsMCF :: !Int, nEdgesMCF :: !Int, offsetsMCF :: !(U.Vector Int), edgeDstMCF :: !(U.Vector Int), edgeRevIndexMCF :: !(U.Vector Int), edgeCapMCF :: !(UM.MVector s (CapacityMCF c)), edgeCostMCF :: !(U.Vector (CostMCF c))};data MinCostFlowBuffer r s c = MinCostFlowBuffer{distsMCF :: !(UM.MVector s r), prevVertMCF :: !(UM.MVector s Vertex), prevEdgeMCF :: !(UM.MVector s EdgeId)};relaxedCostFlow' :: (Show (f (CostMCF c)), Num (f (CostMCF c)), Monoid (f (CostMCF c)), U.Unbox (f (CostMCF c)), Ord (f (CostMCF c)), Num (f (CostMCF c)), PrimMonad m, Show c, Num c, U.Unbox c, Integral c, Ord c, Bounded c) => (CostMCF c -> f (CostMCF c)) -> Int -> Int -> Int -> CapacityMCF c -> U.Vector (Vertex, Vertex, CapacityMCF c, CostMCF c) -> m (Maybe (f (CostMCF c)), MinCostFlow (PrimState m) c);relaxedCostFlow' toRelax !nVerts !src !sink !targetFlow !edges = do { !container <- buildMinCostFlow nVerts edges; !minCost <- runMinCostFlow toRelax src sink targetFlow container; return (minCost, container)};relaxedCostFlow ...

Judge Result

Set Name

Sample

Subtask1

Subtask2

Subtask3

Score / Max Score

0 / 0

2 / 2

Status

× 5

× 7

× 16

× 25

Set Name	Test Cases
Sample	00_sample_0_123.txt, 00_sample_1_123.txt, 00_sample_2_123.txt, 00_sample_3__23.txt, 00_sample_4___3.txt
Subtask1	00_sample_0_123.txt, 00_sample_1_123.txt, 00_sample_2_123.txt, 01_random_0_123.txt, 01_random_1_123.txt, 01_random_2_123.txt, 01_random_3_123.txt
Subtask2	00_sample_0_123.txt, 00_sample_1_123.txt, 00_sample_2_123.txt, 00_sample_3__23.txt, 01_random_0_123.txt, 01_random_1_123.txt, 01_random_2_123.txt, 01_random_3_123.txt, 02_random_0__23.txt, 02_random_1__23.txt, 02_random_2__23.txt, 02_random_3__23.txt, 03_maxima_0__23.txt, 03_maxima_1__23.txt, 03_maxima_2__23.txt, 03_maxima_3__23.txt
Subtask3	00_sample_0_123.txt, 00_sample_1_123.txt, 00_sample_2_123.txt, 00_sample_3__23.txt, 00_sample_4___3.txt, 01_random_0_123.txt, 01_random_1_123.txt, 01_random_2_123.txt, 01_random_3_123.txt, 02_random_0__23.txt, 02_random_1__23.txt, 02_random_2__23.txt, 02_random_3__23.txt, 03_maxima_0__23.txt, 03_maxima_1__23.txt, 03_maxima_2__23.txt, 03_maxima_3__23.txt, 04_random_0__3.txt, 04_random_1__3.txt, 04_random_2__3.txt, 04_random_3__3.txt, 05_maxima_0__3.txt, 05_maxima_1__3.txt, 05_maxima_2__3.txt, 05_maxima_3__3.txt

Case Name	Status	Exec Time	Memory
00_sample_0_123.txt	AC	2 ms	7316 KiB
00_sample_1_123.txt	AC	1 ms	7872 KiB
00_sample_2_123.txt	AC	2 ms	7728 KiB
00_sample_3__23.txt	AC	4 ms	7952 KiB
00_sample_4___3.txt	AC	6 ms	7980 KiB
01_random_0_123.txt	AC	2 ms	7728 KiB
01_random_1_123.txt	AC	2 ms	7936 KiB
01_random_2_123.txt	AC	2 ms	7816 KiB
01_random_3_123.txt	AC	1 ms	8000 KiB
02_random_0__23.txt	AC	2 ms	7948 KiB
02_random_1__23.txt	AC	2 ms	8012 KiB
02_random_2__23.txt	AC	3 ms	7912 KiB
02_random_3__23.txt	AC	2 ms	7964 KiB
03_maxima_0__23.txt	AC	2 ms	7928 KiB
03_maxima_1__23.txt	AC	2 ms	8000 KiB
03_maxima_2__23.txt	AC	4 ms	7740 KiB
03_maxima_3__23.txt	AC	8 ms	7968 KiB
04_random_0__3.txt	AC	191 ms	11304 KiB
04_random_1__3.txt	AC	2 ms	9748 KiB
04_random_2__3.txt	AC	20 ms	8228 KiB
04_random_3__3.txt	AC	30 ms	8348 KiB
05_maxima_0__3.txt	AC	271 ms	12672 KiB
05_maxima_1__3.txt	AC	4 ms	12604 KiB
05_maxima_2__3.txt	AC	801 ms	12632 KiB
05_maxima_3__3.txt	AC	1621 ms	12668 KiB