-- toy-lib: https://github.com/toyboot4e/toy-lib
{- ORMOLU_DISABLE -}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds -Wno-orphans #-}
{-# LANGUAGE BlockArguments, CPP, DataKinds, DefaultSignatures, DerivingVia, LambdaCase, MagicHash, MultiWayIf, NumDecimals, PatternSynonyms, QuantifiedConstraints, RecordWildCards, StandaloneDeriving, StrictData, TypeFamilies, ViewPatterns #-}
import Control.Applicative;import Control.DeepSeq;import Control.Exception (assert);import Control.Monad;import Control.Monad.Fix;import Control.Monad.IO.Class;import Control.Monad.Primitive;import Control.Monad.ST;import Control.Monad.State.Class;import Control.Monad.Trans (MonadTrans, lift);import Control.Monad.Trans.Cont;import Control.Monad.Trans.Maybe;import Control.Monad.Trans.State.Strict (State, StateT(..), evalState, evalStateT, execState, execStateT, runState, runStateT);import Data.Bifunctor;import Data.Bits;import Data.Bool (bool);import Data.Char;import Data.Coerce;import Data.Either;import Data.Foldable;import Data.Function (on);import Data.Functor;import Data.Functor.Identity;import Data.IORef;import Data.Kind;import Data.List.Extra hiding (nubOn);import Data.Maybe;import Data.Ord;import Data.Primitive;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 Unsafe.Coerce;import Data.Ratio;import Data.Array.IArray;import Data.Array.IO;import Data.Array.MArray;import Data.Array.ST;import Data.Array.Unboxed (UArray);import Data.Array.Unsafe;import qualified Data.Array as A;import qualified AtCoder.Extra.Bisect as B;import qualified AtCoder.Extra.DsuMonoid as DsuM;import qualified AtCoder.Extra.Graph as Gr;import qualified AtCoder.Extra.Vector as EV;import qualified AtCoder.Extra.Vector.Prim as EVP;import qualified AtCoder.Extra.Bisect as B;import qualified AtCoder.Extra.Math as EM;import qualified AtCoder.Extra.HashMap as EHM;import qualified AtCoder.Extra.IntMap as EIM;import qualified AtCoder.Extra.IntSet as EIS;import qualified AtCoder.Extra.IntervalMap as EIT;import AtCoder.Extra.Ix0;import qualified AtCoder.Extra.Monoid.RangeAdd as RangeAdd;import qualified AtCoder.Extra.Monoid.RangeSet as RangeSet;import qualified AtCoder.Extra.Monoid.RollingHash as RH;import qualified AtCoder.Extra.Semigroup.Matrix as Mat;import qualified AtCoder.Extra.Semigroup.Permutation as Permutation;import qualified AtCoder.Extra.Tree as Tr;import qualified AtCoder.Extra.Tree.Hld as Hld;import qualified AtCoder.Extra.Tree.Lct as Lct;import qualified AtCoder.Extra.Tree.TreeMonoid as Tm;import qualified AtCoder.FenwickTree as Ft;import qualified AtCoder.Internal.MinHeap as MH;import qualified AtCoder.Internal.Queue as Q;import qualified AtCoder.LazySegTree as LSeg;import qualified AtCoder.ModInt as MI;import qualified AtCoder.SegTree as Seg;import Data.Bit;import qualified Data.ByteString.Builder as BSB;import qualified Data.ByteString.Char8 as BS;import qualified Data.ByteString.Unsafe as BSU;import Control.Monad.Extra hiding (loop);import Data.IORef.Extra;import Data.List.Extra hiding (merge);import Data.Tuple.Extra hiding (first, second);import Numeric.Extra;import Data.Bool.HT;import qualified Data.Ix.Enum as HT;import qualified Data.List.HT as HT;import qualified Data.Vector.Fusion.Bundle as FB;import qualified Data.Vector.Generic as G;import qualified Data.Vector.Generic.Mutable as GM;import qualified Data.Vector.Primitive as P;import qualified Data.Vector.Unboxed as U;import qualified Data.Vector.Unboxed.Base as U;import qualified Data.Vector.Unboxed.Mutable as UM;import qualified Data.Vector as V;import qualified Data.Vector.Mutable as VM;import qualified Data.Vector.Fusion.Bundle.Monadic as MB;import qualified Data.Vector.Fusion.Bundle.Size as MB;import qualified Data.Vector.Fusion.Stream.Monadic as MS;import qualified Data.Vector.Algorithms.Merge as VAM;import qualified Data.Vector.Algorithms.Intro as VAI;import qualified Data.Vector.Algorithms.Radix as VAR;import qualified Data.Vector.Algorithms.Search as VAS;import qualified Data.IntMap.Strict as IM;import qualified Data.Map.Strict as M;import qualified Data.IntSet as IS;import qualified Data.Set as S;import qualified Data.Sequence as Seq;import qualified Data.Heap as H;import Data.Hashable;import qualified Data.HashMap.Strict as HM;import qualified Data.HashSet as HS;import qualified Test.QuickCheck as QC
{-# INLINE runIO #-};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;{-# INLINE runFileIO #-};runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;{-# INLINE intP #-};intP :: (MonadState BS.ByteString m) => m Int;intP = state $ fromJust . BS.readInt . BS.dropSpace;{-# INLINE int1P #-};int1P :: (MonadState BS.ByteString m) => m Int;int1P = subtract 1 <$> intP;{-# INLINE charP #-};charP :: (MonadState BS.ByteString m) => m Char;charP = state $ fromJust . BS.uncons . BS.dropSpace;{-# INLINE wordP #-};wordP :: (MonadState BS.ByteString m) => m BS.ByteString;wordP = state $ BS.break isSpace . BS.dropSpace;doubleP :: (MonadState BS.ByteString m) => m Double;doubleP = read . BS.unpack <$> wordP;{-# INLINE ints2P #-};ints2P :: (MonadState BS.ByteString m) => m (Int, Int);ints2P = (,) <$> intP <*> intP;{-# INLINE ints11P #-};ints11P :: (MonadState BS.ByteString m) => m (Int, Int);ints11P = (,) <$> int1P <*> int1P;{-# INLINE ints3P #-};ints3P :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3P = (,,) <$> intP <*> intP <*> intP;{-# INLINE ints110P #-};ints110P :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110P = (,,) <$> int1P <*> int1P <*> intP;{-# INLINE ints011 #-};ints011 :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints011 = (,,) <$> intP <*> int1P <*> int1P;{-# INLINE ints111 #-};ints111 :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111 = (,,) <$> int1P <*> int1P <*> int1P;{-# INLINE ints4P #-};ints4P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4P = (,,,) <$> intP <*> intP <*> intP <*> intP;{-# INLINE ints5P #-};ints5P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5P = (,,,,) <$> intP <*> intP <*> intP <*> intP <*> intP;{-# INLINE ints6P #-};ints6P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6P = (,,,,,) <$> intP <*> intP <*> intP <*> intP <*> intP <*> intP;{-# INLINE lineP #-};lineP :: (MonadState BS.ByteString m) => m BS.ByteString;lineP = state $ BS.span (/= '\n') . BS.dropSpace;{-# INLINE lineUP #-};lineUP :: (MonadState BS.ByteString m) => m (U.Vector Char);lineUP = do { s <- lineP; pure $ U.fromListN (BS.length s) $ BS.unpack s};{-# INLINE withLine #-};withLine :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine f = evalState f <$> lineP;{-# INLINE intListP #-};intListP :: (MonadState BS.ByteString m) => m [Int];intListP = unfoldr (BS.readInt . BS.dropSpace) <$> lineP;{-# INLINE intsP #-};intsP :: (MonadState BS.ByteString m) => m (U.Vector Int);intsP = U.unfoldr (BS.readInt . BS.dropSpace) <$> lineP;{-# INLINE intsNP #-};intsNP :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsNP n = U.replicateM n intP;{-# INLINE digitsP #-};digitsP :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsP = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> lineP;dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();dbgM :: (Monad m, Show a) => m a -> m ();dbgM m | debug = do { !s <- m; let { !_ = traceShow s ()}; pure ()} | otherwise = pure ();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 ()}; pure ()} | otherwise = pure ();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 :: (HasCallStack) => Bool -> String -> ();dbgAssert b s | debug && not b = error $ "assertion failed!: " ++ s | otherwise = ();asserted :: (HasCallStack) => Bool -> a -> a;asserted b x | debug && not b = error "assertion failed!" | otherwise = x;($$) :: (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'}; pure ()} | otherwise = pure ();{-# INLINE endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';{-# INLINE putBSB #-};putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;{-# INLINE putLnBSB #-};putLnBSB :: (MonadIO m) => BSB.Builder -> m ();putLnBSB = liftIO . BSB.hPutBuilder stdout . (<> endlBSB);{-# INLINE wsBSB #-};wsBSB :: BSB.Builder;wsBSB = BSB.char7 ' ';class ShowBSB a where { showBSB :: a -> BSB.Builder; {-# INLINE showBSB #-}; default showBSB :: (Show a) => a -> BSB.Builder; showBSB = BSB.string8 . show};instance ShowBSB Int where { {-# INLINE showBSB #-}; showBSB = BSB.intDec};instance ShowBSB Integer where { {-# INLINE showBSB #-}; showBSB = BSB.integerDec};instance ShowBSB Float where { {-# INLINE showBSB #-}; showBSB = BSB.floatDec};instance ShowBSB Double where { {-# INLINE showBSB #-}; showBSB = BSB.doubleDec};instance ShowBSB Char where { {-# INLINE showBSB #-}; showBSB = BSB.char7};instance ShowBSB String where { {-# INLINE showBSB #-}; showBSB = BSB.string8};instance ShowBSB BS.ByteString where { {-# INLINE showBSB #-}; showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { {-# INLINE showBSB #-}; showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { {-# INLINE showBSB #-}; showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};instance (ShowBSB a, ShowBSB b, ShowBSB c, ShowBSB d) => ShowBSB (a, b, c, d) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c, !d) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c <> BSB.string7 " " <> showBSB d};{-# INLINE showLnBSB #-};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;{-# INLINE printBSB #-};printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;{-# INLINE concatBSB #-};concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;{-# INLINE intersperseBSB #-};intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB = intersperseWithBSB showBSB;{-# INLINE intersperseWithBSB #-};intersperseWithBSB :: (G.Vector v a) => (a -> BSB.Builder) -> BSB.Builder -> v a -> BSB.Builder;intersperseWithBSB showF del vec | G.null vec = mempty | otherwise = showF (G.head vec) <> G.foldMap ((del <>) . showF) (G.tail vec);{-# INLINE unwordsBSB #-};unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;{-# INLINE unlinesBSB #-};unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;{-# INLINE yn #-};yn :: Bool -> String;yn = bool "No" "Yes";{-# INLINE ynBSB #-};ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");{-# INLINE printYn #-};printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;{-# INLINE printList #-};printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;{-# INLINE putList #-};putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;{-# INLINE printVec #-};printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;{-# INLINE putVec #-};putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;type Vertex = Int;type EdgeId = Int;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))};{-# INLINE rleOf #-};rleOf :: BS.ByteString -> [(Char, Int)];rleOf = map (\ s -> (BS.head s, BS.length s)) . BS.group;{-# INLINE rleOfU #-};rleOfU :: BS.ByteString -> U.Vector (Char, Int);rleOfU = U.fromList . rleOf;{-# INLINE square #-};square :: (Num a) => a -> a;square !x = x * x;{-# INLINE isqrt #-};isqrt :: Int -> Int;isqrt = round @Double . sqrt . fromIntegral;{-# INLINE (.:) #-};(.:) :: (b -> c) -> (a1 -> a2 -> b) -> (a1 -> a2 -> c);(.:) = (.) . (.);{-# INLINE swapDupeU #-};swapDupeU :: U.Vector (Int, Int) -> U.Vector (Int, Int);swapDupeU = U.concatMap (\ (!u, !v) -> U.fromListN 2 [(u, v), (v, u)]);{-# INLINE swapDupeW #-};swapDupeW :: (U.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);swapDupeW = U.concatMap (\ (!u, !v, !d) -> U.fromListN 2 [(u, v, d), (v, u, d)]);{-# INLINE ortho4 #-};ortho4 :: U.Vector (Int, Int);ortho4 = U.fromList [(0, 1), (0, -1), (1, 0), (-1, 0)];{-# INLINE ortho4' #-};ortho4' :: ((Int, Int), (Int, Int)) -> (Int, Int) -> U.Vector (Int, Int);ortho4' bnd base = U.filter (inRange bnd) $ U.map (add2 base) ortho4;{-# INLINE orthoWith #-};orthoWith :: ((Int, Int), (Int, Int)) -> ((Int, Int) -> Bool) -> (Int -> U.Vector Int);orthoWith bnd p v1 = U.map (index bnd) . U.filter ((&&) <$> inRange bnd <*> p) $ U.map (add2 (unindex bnd v1)) ortho4;{-# INLINE diag4 #-};diag4 :: U.Vector (Int, Int);diag4 = U.fromList [(-1, 1), (1, 1), (1, -1), (-1, -1)];{-# INLINE slice #-};slice :: (G.Vector v a) => Int -> Int -> v a -> v a;slice !l !r !vec = G.slice l (max 0 (r - l + 1)) vec;{-# INLINE zero2 #-};zero2 :: Int -> Int -> ((Int, Int), (Int, Int));zero2 n1 n2 = ((0, 0), (n1 - 1, n2 - 1));{-# INLINE zero3 #-};zero3 :: Int -> Int -> Int -> ((Int, Int, Int), (Int, Int, Int));zero3 n1 n2 n3 = ((0, 0, 0), (n1 - 1, n2 - 1, n3 - 1));{-# INLINE rangeG #-};rangeG :: (G.Vector v Int) => Int -> Int -> v Int;rangeG !i !j = G.enumFromN i (succ j - i);{-# INLINE rangeV #-};rangeV :: Int -> Int -> V.Vector Int;rangeV = rangeG;{-# INLINE rangeU #-};rangeU :: Int -> Int -> U.Vector Int;rangeU = rangeG;{-# INLINE rangeGR #-};rangeGR :: (G.Vector v Int) => Int -> Int -> v Int;rangeGR !i !j = G.enumFromStepN j (-1) (succ j - i);{-# INLINE rangeVR #-};rangeVR :: Int -> Int -> V.Vector Int;rangeVR = rangeGR;{-# INLINE rangeUR #-};rangeUR :: Int -> Int -> U.Vector Int;rangeUR = rangeGR;{-# INLINE times #-};times :: Int -> (a -> a) -> a -> a;times !n !f = inner 0 where { inner i !s | i >= n = s | otherwise = inner (i + 1) $! f s};interleave :: [a] -> [a] -> [a];interleave xs [] = xs; interleave [] ys = ys; interleave (x : xs) (y : ys) = x : y : interleave xs ys;combs :: Int -> [a] -> [[a]];combs _ [] = []; combs k as@(!(_ : xs)) | k == 0 = [[]] | k == 1 = map pure as | k == l = pure as | k > l = [] | otherwise = run (l - 1) (k - 1) as $ combs (k - 1) xs where { l = length as; run :: Int -> Int -> [a] -> [[a]] -> [[a]]; run n k ys cs | n == k = map (ys ++) cs | otherwise = map (q :) cs ++ run (n - 1) k qs (drop dc cs) where { (!(q : qs)) = take (n - k + 1) ys; dc = product [(n - k + 1) .. (n - 1)] `div` product [1 .. (k - 1)]}};{-# INLINE swapDupe #-};swapDupe :: (a, a) -> [(a, a)];swapDupe (!x1, !x2) = [(x1, x2), (x2, x1)];{-# INLINE add2 #-};add2 :: (Int, Int) -> (Int, Int) -> (Int, Int);add2 (!y, !x) = bimap (y +) (x +);{-# INLINE sub2 #-};sub2 :: (Int, Int) -> (Int, Int) -> (Int, Int);sub2 (!y, !x) = bimap (y -) (x -);{-# INLINE mul2 #-};mul2 :: Int -> (Int, Int) -> (Int, Int);mul2 !m = both (m *);{-# INLINE add3 #-};add3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);add3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 + z2, y1 + y2, x1 + x2);{-# INLINE sub3 #-};sub3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);sub3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE mul3 #-};mul3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);mul3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE toRadian #-};toRadian :: Double -> Double;toRadian degree = degree / 180.0 * pi;{-# INLINE toDegree #-};toDegree :: Double -> Double;toDegree rad = rad / pi * 180.0;{-# INLINE fst4 #-};fst4 :: (a, b, c, d) -> a;fst4 (!a, !_, !_, !_) = a;{-# INLINE snd4 #-};snd4 :: (a, b, c, d) -> b;snd4 (!_, !b, !_, !_) = b;{-# INLINE thd4 #-};thd4 :: (a, b, c, d) -> c;thd4 (!_, !_, !c, !_) = c;{-# INLINE fth4 #-};fth4 :: (a, b, c, d) -> d;fth4 (!_, !_, !_, !d) = d;{-# INLINE first4 #-};first4 :: (a -> x) -> (a, b, c, d) -> (x, b, c, d);first4 f (!a, !b, !c, !d) = (f a, b, c, d);{-# INLINE second4 #-};second4 :: (b -> x) -> (a, b, c, d) -> (a, x, c, d);second4 f (!a, !b, !c, !d) = (a, f b, c, d);{-# INLINE third4 #-};third4 :: (c -> x) -> (a, b, c, d) -> (a, b, x, d);third4 f (!a, !b, !c, !d) = (a, b, f c, d);{-# INLINE fourth4 #-};fourth4 :: (d -> x) -> (a, b, c, d) -> (a, b, c, x);fourth4 f (!a, !b, !c, !d) = (a, b, c, f d);fix1 :: a -> ((a -> b) -> a -> b) -> b;fix1 a f = fix f a;fix2 :: a -> b -> ((a -> b -> c) -> a -> b -> c) -> c;fix2 a b f = fix f a b;fix3 :: a -> b -> c -> ((a -> b -> c -> d) -> a -> b -> c -> d) -> d;fix3 a b c f = fix f a b c;{-# INLINE index' #-};index' :: (HasCallStack, Ix i, Show i) => (i, i) -> i -> Int;index' !bnd !i | inRange bnd i = index bnd i | otherwise = error $ "index out ouf bounds: " ++ show i ++ " in " ++ show bnd;data IxVector i v = IxVector{boundsIV :: !(i, i), vecIV :: !v} deriving (Show, Eq);type IxUVector i a = IxVector i (U.Vector a);type IxBVector i a = IxVector i (V.Vector a);type IxMUVector s i a = IxVector i (UM.MVector s a);type IxMBVector s i a = IxVector i (VM.MVector s a);{-# INLINE (@!) #-};(@!) :: (HasCallStack, Ix i, Show 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, Show 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) => (a -> Bool) -> IxVector i (v a) -> Maybe i;findIndexIV f IxVector{..} = unindex boundsIV <$> G.findIndex f vecIV;{-# INLINE findIndicesIV #-};findIndicesIV :: (Unindex i, G.Vector v a, G.Vector v i, G.Vector v Int) => (a -> Bool) -> IxVector i (v a) -> v i;findIndicesIV f IxVector{..} = G.map (unindex boundsIV) $ G.findIndices 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 filterIV #-};filterIV :: (U.Unbox a) => (a -> Bool) -> IxVector i (U.Vector a) -> U.Vector a;filterIV !f IxVector{..} = U.filter f vecIV;{-# INLINE ifilterIV #-};ifilterIV :: (Unindex i, U.Unbox a) => (i -> a -> Bool) -> IxVector i (U.Vector a) -> U.Vector a;ifilterIV !f IxVector{..} = U.ifilter (f . unindex boundsIV) vecIV;{-# INLINE indexedIV #-};indexedIV :: (Unindex i, U.Unbox a) => IxVector i (U.Vector a) -> U.Vector (i, a);indexedIV IxVector{..} = U.imap ((,) . unindex boundsIV) vecIV;{-# INLINE replicateIV #-};replicateIV :: (Unindex i, U.Unbox a) => (i, i) -> a -> IxUVector i a;replicateIV bnd x = IxVector bnd $ U.replicate (rangeSize bnd) x;{-# 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, Show 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 . (HasCallStack, 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 _ = pure 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, Show 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 readMaybeIV #-};readMaybeIV :: (HasCallStack, Ix i, Show i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> m (Maybe a);readMaybeIV IxVector{..} i | not (inRange boundsIV i) = pure 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, Show 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);cloneIV :: (PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> m (IxVector i (v (PrimState m) a));cloneIV IxVector{..} = do { vec' <- GM.clone vecIV; pure $ IxVector boundsIV vec'};{-# INLINE extractImos2d #-};extractImos2d :: forall a . (HasCallStack, Num a, U.Unbox a) => Int -> Int -> U.Vector (Int, Int, Int, Int, a) -> IxUVector (Int, Int) a;extractImos2d h w rangeAdds = IxVector (zero2 h w) $ U.create $ do { rect <- IxVector (zero2 h w) <$> UM.replicate (h * w) (0 :: a); U.forM_ rangeAdds $ \ (!y1, !y2, !x1, !x2, !d) -> do { modifyIV rect (+ d) (y1, x1); let { !by = y2 < h - 1}; when by $ do { modifyIV rect (subtract d) (y2 + 1, x1)}; let { !bx = x2 < w - 1}; when bx $ do { modifyIV rect (subtract d) (y1, x2 + 1)}; when (by && bx) $ do { modifyIV rect (+ d) (y2 + 1, x2 + 1)}}; pure $ vecIV rect};{-# INLINE imos2d #-};imos2d :: forall a . (HasCallStack, Num a, U.Unbox a) => Int -> Int -> U.Vector (Int, Int, Int, Int, a) -> IxUVector (Int, Int) a;imos2d h w rangeAdds = IxVector (zero2 h w) $ U.create $ do { rect <- thawIV seeds; for_ [0 .. h - 1] $ \ y -> do { for_ [1 .. w - 1] $ \ x -> do { dx <- readIV rect (y, x - 1); modifyIV rect (+ dx) (y, x)}}; for_ [0 .. w - 1] $ \ x -> do { for_ [1 .. h - 1] $ \ y -> do { dy <- readIV rect (y - 1, x); modifyIV rect (+ dy) (y, x)}}; pure $ vecIV rect} where { seeds = extractImos2d h w rangeAdds};{-# 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)};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (HasCallStack, Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum G.! (r + 1) - csum G.! l where { _ | debug = let { n = U.length csum - 1; !_ = dbgAssert (inRange (0, n - 1) l && inRange (0, n - 1) r) $ "(+!) invalid range: " ++ show (l, r)} in () | otherwise = ()};{-# INLINE newCSumU #-};newCSumU :: (PrimMonad m, Num a, U.Unbox a) => Int -> m (UM.MVector (PrimState m) a);newCSumU n = UM.replicate (n + 1) 0;{-# INLINE readCSum #-};readCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> Int -> m a;readCSum vec l r = (-) <$> GM.read vec (r + 1) <*> GM.read vec l;{-# INLINE appendCSum #-};appendCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();appendCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};{-# INLINE csum3D #-};csum3D :: (HasCallStack, Num a, U.Unbox a) => Int -> IxUVector (Int, Int, Int) a -> IxUVector (Int, Int, Int) a;csum3D !n !gr = IxVector bnd $ U.constructN (succ n * succ n * succ n) $ \ sofar -> case unindex bnd (G.length sofar) of { (0, !_, !_) -> 0; (!_, 0, !_) -> 0; (!_, !_, 0) -> 0; (!x, !y, !z) -> v0 + (fromZ + fromY + fromX) - 2 * fromDiag - (dupX + dupY + dupZ) where { v0 = gr @! (x - 1, y - 1, z - 1); sofar' = IxVector bnd sofar; fromZ = sofar' @! (x - 1, y, z); fromY = sofar' @! (x, y - 1, z); fromX = sofar' @! (x, y, z - 1); fromDiag = sofar' @! (x - 1, y - 1, z - 1); dupX = sofar' @! (x - 1, y - 1, z) - fromDiag; dupY = sofar' @! (x - 1, y, z - 1) - fromDiag; dupZ = sofar' @! (x, y - 1, z - 1) - fromDiag}} where { !bnd = ((0, 0, 0), (n, n, n))};class SemigroupAction s a where { sact :: s -> a -> a};sactTimes :: (Semigroup s, SemigroupAction s a) => Int -> s -> a -> a;sactTimes n0 s0 a0 = case compare n0 0 of { LT -> errorWithoutStackTrace "sactTimes: zero or positive multiplier expected"; EQ -> a0; GT -> EM.stimes' n0 s0 `sact` a0};instance (Semigroup a) => SemigroupAction a a where { {-# INLINE sact #-}; sact = (<>)};
{-# RULES "Force inline VAI.sort" VAI.sort = VAI.sortBy compare #-}
#ifdef DEBUG
debug :: Bool ; debug = True
#else
debug :: Bool ; debug = False
#endif
{- ORMOLU_ENABLE -}
solve :: StateT BS.ByteString IO ()
solve = do
((* 1000) -> !w, !b) <- ints2P
let n = (w + 1 + (b - 1)) `div` b
printBSB n
-- verification-helper: PROBLEM https://atcoder.jp/contests/abc434/tasks/abc434_a
main :: IO ()
main = runIO solve
Configuration is affected by the following files:
- cabal.project
- cabal.project.freeze
- cabal.project.local
app/Main.hs:7:11925: warning: [GHC-63397] [-Wname-shadowing]
This binding for ‘k’ shadows the existing binding
bound at app/Main.hs:7:11708
|
7 | {-# INLINE runIO #-};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;{-# INLINE runFileIO #-};runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;{-# INLINE intP #-};intP :: (MonadState BS.ByteString m) => m Int;intP = state $ fromJust . BS.readInt . BS.dropSpace;{-# INLINE int1P #-};int1P :: (MonadState BS.ByteString m) => m Int;int1P = subtract 1 <$> intP;{-# INLINE charP #-};charP :: (MonadState BS.ByteString m) => m Char;charP = state $ fromJust . BS.uncons . BS.dropSpace;{-# INLINE wordP #-};wordP :: (MonadState BS.ByteString m) => m BS.ByteString;wordP = state $ BS.break isSpace . BS.dropSpace;doubleP :: (MonadState BS.ByteString m) => m Double;doubleP = read . BS.unpack <$> wordP;{-# INLINE ints2P #-};ints2P :: (MonadState BS.ByteString m) => m (Int, Int);ints2P = (,) <$> intP <*> intP;{-# INLINE ints11P #-};ints11P :: (MonadState BS.ByteString m) => m (Int, Int);ints11P = (,) <$> int1P <*> int1P;{-# INLINE ints3P #-};ints3P :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3P = (,,) <$> intP <*> intP <*> intP;{-# INLINE ints110P #-};ints110P :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110P = (,,) <$> int1P <*> int1P <*> intP;{-# INLINE ints011 #-};ints011 :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints011 = (,,) <$> intP <*> int1P <*> int1P;{-# INLINE ints111 #-};ints111 :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111 = (,,) <$> int1P <*> int1P <*> int1P;{-# INLINE ints4P #-};ints4P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4P = (,,,) <$> intP <*> intP <*> intP <*> intP;{-# INLINE ints5P #-};ints5P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5P = (,,,,) <$> intP <*> intP <*> intP <*> intP <*> intP;{-# INLINE ints6P #-};ints6P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6P = (,,,,,) <$> intP <*> intP <*> intP <*> intP <*> intP <*> intP;{-# INLINE lineP #-};lineP :: (MonadState BS.ByteString m) => m BS.ByteString;lineP = state $ BS.span (/= '\n') . BS.dropSpace;{-# INLINE lineUP #-};lineUP :: (MonadState BS.ByteString m) => m (U.Vector Char);lineUP = do { s <- lineP; pure $ U.fromListN (BS.length s) $ BS.unpack s};{-# INLINE withLine #-};withLine :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine f = evalState f <$> lineP;{-# INLINE intListP #-};intListP :: (MonadState BS.ByteString m) => m [Int];intListP = unfoldr (BS.readInt . BS.dropSpace) <$> lineP;{-# INLINE intsP #-};intsP :: (MonadState BS.ByteString m) => m (U.Vector Int);intsP = U.unfoldr (BS.readInt . BS.dropSpace) <$> lineP;{-# INLINE intsNP #-};intsNP :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsNP n = U.replicateM n intP;{-# INLINE digitsP #-};digitsP :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsP = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> lineP;dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();dbgM :: (Monad m, Show a) => m a -> m ();dbgM m | debug = do { !s <- m; let { !_ = traceShow s ()}; pure ()} | otherwise = pure ();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 ()}; pure ()} | otherwise = pure ();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 :: (HasCallStack) => Bool -> String -> ();dbgAssert b s | debug && not b = error $ "assertion failed!: " ++ s | otherwise = ();asserted :: (HasCallStack) => Bool -> a -> a;asserted b x | debug && not b = error "assertion failed!" | otherwise = x;($$) :: (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'}; pure ()} | otherwise = pure ();{-# INLINE endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';{-# INLINE putBSB #-};putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;{-# INLINE putLnBSB #-};putLnBSB :: (MonadIO m) => BSB.Builder -> m ();putLnBSB = liftIO . BSB.hPutBuilder stdout . (<> endlBSB);{-# INLINE wsBSB #-};wsBSB :: BSB.Builder;wsBSB = BSB.char7 ' ';class ShowBSB a where { showBSB :: a -> BSB.Builder; {-# INLINE showBSB #-}; default showBSB :: (Show a) => a -> BSB.Builder; showBSB = BSB.string8 . show};instance ShowBSB Int where { {-# INLINE showBSB #-}; showBSB = BSB.intDec};instance ShowBSB Integer where { {-# INLINE showBSB #-}; showBSB = BSB.integerDec};instance ShowBSB Float where { {-# INLINE showBSB #-}; showBSB = BSB.floatDec};instance ShowBSB Double where { {-# INLINE showBSB #-}; showBSB = BSB.doubleDec};instance ShowBSB Char where { {-# INLINE showBSB #-}; showBSB = BSB.char7};instance ShowBSB String where { {-# INLINE showBSB #-}; showBSB = BSB.string8};instance ShowBSB BS.ByteString where { {-# INLINE showBSB #-}; showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { {-# INLINE showBSB #-}; showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { {-# INLINE showBSB #-}; showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};instance (ShowBSB a, ShowBSB b, ShowBSB c, ShowBSB d) => ShowBSB (a, b, c, d) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c, !d) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c <> BSB.string7 " " <> showBSB d};{-# INLINE showLnBSB #-};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;{-# INLINE printBSB #-};printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;{-# INLINE concatBSB #-};concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;{-# INLINE intersperseBSB #-};intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB = intersperseWithBSB showBSB;{-# INLINE intersperseWithBSB #-};intersperseWithBSB :: (G.Vector v a) => (a -> BSB.Builder) -> BSB.Builder -> v a -> BSB.Builder;intersperseWithBSB showF del vec | G.null vec = mempty | otherwise = showF (G.head vec) <> G.foldMap ((del <>) . showF) (G.tail vec);{-# INLINE unwordsBSB #-};unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;{-# INLINE unlinesBSB #-};unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;{-# INLINE yn #-};yn :: Bool -> String;yn = bool "No" "Yes";{-# INLINE ynBSB #-};ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");{-# INLINE printYn #-};printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;{-# INLINE printList #-};printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;{-# INLINE putList #-};putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;{-# INLINE printVec #-};printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;{-# INLINE putVec #-};putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;type Vertex = Int;type EdgeId = Int;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))};{-# INLINE rleOf #-};rleOf :: BS.ByteString -> [(Char, Int)];rleOf = map (\ s -> (BS.head s, BS.length s)) . BS.group;{-# INLINE rleOfU #-};rleOfU :: BS.ByteString -> U.Vector (Char, Int);rleOfU = U.fromList . rleOf;{-# INLINE square #-};square :: (Num a) => a -> a;square !x = x * x;{-# INLINE isqrt #-};isqrt :: Int -> Int;isqrt = round @Double . sqrt . fromIntegral;{-# INLINE (.:) #-};(.:) :: (b -> c) -> (a1 -> a2 -> b) -> (a1 -> a2 -> c);(.:) = (.) . (.);{-# INLINE swapDupeU #-};swapDupeU :: U.Vector (Int, Int) -> U.Vector (Int, Int);swapDupeU = U.concatMap (\ (!u, !v) -> U.fromListN 2 [(u, v), (v, u)]);{-# INLINE swapDupeW #-};swapDupeW :: (U.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);swapDupeW = U.concatMap (\ (!u, !v, !d) -> U.fromListN 2 [(u, v, d), (v, u, d)]);{-# INLINE ortho4 #-};ortho4 :: U.Vector (Int, Int);ortho4 = U.fromList [(0, 1), (0, -1), (1, 0), (-1, 0)];{-# INLINE ortho4' #-};ortho4' :: ((Int, Int), (Int, Int)) -> (Int, Int) -> U.Vector (Int, Int);ortho4' bnd base = U.filter (inRange bnd) $ U.map (add2 base) ortho4;{-# INLINE orthoWith #-};orthoWith :: ((Int, Int), (Int, Int)) -> ((Int, Int) -> Bool) -> (Int -> U.Vector Int);orthoWith bnd p v1 = U.map (index bnd) . U.filter ((&&) <$> inRange bnd <*> p) $ U.map (add2 (unindex bnd v1)) ortho4;{-# INLINE diag4 #-};diag4 :: U.Vector (Int, Int);diag4 = U.fromList [(-1, 1), (1, 1), (1, -1), (-1, -1)];{-# INLINE slice #-};slice :: (G.Vector v a) => Int -> Int -> v a -> v a;slice !l !r !vec = G.slice l (max 0 (r - l + 1)) vec;{-# INLINE zero2 #-};zero2 :: Int -> Int -> ((Int, Int), (Int, Int));zero2 n1 n2 = ((0, 0), (n1 - 1, n2 - 1));{-# INLINE zero3 #-};zero3 :: Int -> Int -> Int -> ((Int, Int, Int), (Int, Int, Int));zero3 n1 n2 n3 = ((0, 0, 0), (n1 - 1, n2 - 1, n3 - 1));{-# INLINE rangeG #-};rangeG :: (G.Vector v Int) => Int -> Int -> v Int;rangeG !i !j = G.enumFromN i (succ j - i);{-# INLINE rangeV #-};rangeV :: Int -> Int -> V.Vector Int;rangeV = rangeG;{-# INLINE rangeU #-};rangeU :: Int -> Int -> U.Vector Int;rangeU = rangeG;{-# INLINE rangeGR #-};rangeGR :: (G.Vector v Int) => Int -> Int -> v Int;rangeGR !i !j = G.enumFromStepN j (-1) (succ j - i);{-# INLINE rangeVR #-};rangeVR :: Int -> Int -> V.Vector Int;rangeVR = rangeGR;{-# INLINE rangeUR #-};rangeUR :: Int -> Int -> U.Vector Int;rangeUR = rangeGR;{-# INLINE times #-};times :: Int -> (a -> a) -> a -> a;times !n !f = inner 0 where { inner i !s | i >= n = s | otherwise = inner (i + 1) $! f s};interleave :: [a] -> [a] -> [a];interleave xs [] = xs; interleave [] ys = ys; interleave (x : xs) (y : ys) = x : y : interleave xs ys;combs :: Int -> [a] -> [[a]];combs _ [] = []; combs k as@(!(_ : xs)) | k == 0 = [[]] | k == 1 = map pure as | k == l = pure as | k > l = [] | otherwise = run (l - 1) (k - 1) as $ combs (k - 1) xs where { l = length as; run :: Int -> Int -> [a] -> [[a]] -> [[a]]; run n k ys cs | n == k = map (ys ++) cs | otherwise = map (q :) cs ++ run (n - 1) k qs (drop dc cs) where { (!(q : qs)) = take (n - k + 1) ys; dc = product [(n - k + 1) .. (n - 1)] `div` product [1 .. (k - 1)]}};{-# INLINE swapDupe #-};swapDupe :: (a, a) -> [(a, a)];swapDupe (!x1, !x2) = [(x1, x2), (x2, x1)];{-# INLINE add2 #-};add2 :: (Int, Int) -> (Int, Int) -> (Int, Int);add2 (!y, !x) = bimap (y +) (x +);{-# INLINE sub2 #-};sub2 :: (Int, Int) -> (Int, Int) -> (Int, Int);sub2 (!y, !x) = bimap (y -) (x -);{-# INLINE mul2 #-};mul2 :: Int -> (Int, Int) -> (Int, Int);mul2 !m = both (m *);{-# INLINE add3 #-};add3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);add3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 + z2, y1 + y2, x1 + x2);{-# INLINE sub3 #-};sub3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);sub3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE mul3 #-};mul3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);mul3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE toRadian #-};toRadian :: Double -> Double;toRadian degree = degree / 180.0 * pi;{-# INLINE toDegree #-};toDegree :: Double -> Double;toDegree rad = rad / pi * 180.0;{-# INLINE fst4 #-};fst4 :: (a, b, c, d) -> a;fst4 (!a, !_, !_, !_) = a;{-# INLINE snd4 #-};snd4 :: (a, b, c, d) -> b;snd4 (!_, !b, !_, !_) = b;{-# INLINE thd4 #-};thd4 :: (a, b, c, d) -> c;thd4 (!_, !_, !c, !_) = c;{-# INLINE fth4 #-};fth4 :: (a, b, c, d) -> d;fth4 (!_, !_, !_, !d) = d;{-# INLINE first4 #-};first4 :: (a -> x) -> (a, b, c, d) -> (x, b, c, d);first4 f (!a, !b, !c, !d) = (f a, b, c, d);{-# INLINE second4 #-};second4 :: (b -> x) -> (a, b, c, d) -> (a, x, c, d);second4 f (!a, !b, !c, !d) = (a, f b, c, d);{-# INLINE third4 #-};third4 :: (c -> x) -> (a, b, c, d) -> (a, b, x, d);third4 f (!a, !b, !c, !d) = (a, b, f c, d);{-# INLINE fourth4 #-};fourth4 :: (d -> x) -> (a, b, c, d) -> (a, b, c, x);fourth4 f (!a, !b, !c, !d) = (a, b, c, f d);fix1 :: a -> ((a -> b) -> a -> b) -> b;fix1 a f = fix f a;fix2 :: a -> b -> ((a -> b -> c) -> a -> b -> c) -> c;fix2 a b f = fix f a b;fix3 :: a -> b -> c -> ((a -> b -> c -> d) -> a -> b -> c -> d) -> d;fix3 a b c f = fix f a b c;{-# INLINE index' #-};index' :: (HasCallStack, Ix i, Show i) => (i, i) -> i -> Int;index' !bnd !i | inRange bnd i = index bnd i | otherwise = error $ "index out ouf bounds: " ++ show i ++ " in " ++ show bnd;data IxVector i v = IxVector{boundsIV :: !(i, i), vecIV :: !v} deriving (Show, Eq);type IxUVector i a = IxVector i (U.Vector a);type IxBVector i a = IxVector i (V.Vector a);type IxMUVector s i a = IxVector i (UM.MVector s a);type IxMBVector s i a = IxVector i (VM.MVector s a);{-# INLINE (@!) #-};(@!) :: (HasCallStack, Ix i, Show 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, Show 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) => (a -> Bool) -> IxVector i (v a) -> Maybe i;findIndexIV f IxVector{..} = unindex boundsIV <$> G.findIndex f vecIV;{-# INLINE findIndicesIV #-};findIndicesIV :: (Unindex i, G.Vector v a, G.Vector v i, G.Vector v Int) => (a -> Bool) -> IxVector i (v a) -> v i;findIndicesIV f IxVector{..} = G.map (unindex boundsIV) $ G.findIndices 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 filterIV #-};filterIV :: (U.Unbox a) => (a -> Bool) -> IxVector i (U.Vector a) -> U.Vector a;filterIV !f IxVector{..} = U.filter f vecIV;{-# INLINE ifilterIV #-};ifilterIV :: (Unindex i, U.Unbox a) => (i -> a -> Bool) -> IxVector i (U.Vector a) -> U.Vector a;ifilterIV !f IxVector{..} = U.ifilter (f . unindex boundsIV) vecIV;{-# INLINE indexedIV #-};indexedIV :: (Unindex i, U.Unbox a) => IxVector i (U.Vector a) -> U.Vector (i, a);indexedIV IxVector{..} = U.imap ((,) . unindex boundsIV) vecIV;{-# INLINE replicateIV #-};replicateIV :: (Unindex i, U.Unbox a) => (i, i) -> a -> IxUVector i a;replicateIV bnd x = IxVector bnd $ U.replicate (rangeSize bnd) x;{-# 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, Show 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 . (HasCallStack, 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 _ = pure 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, Show 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 readMaybeIV #-};readMaybeIV :: (HasCallStack, Ix i, Show i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> m (Maybe a);readMaybeIV IxVector{..} i | not (inRange boundsIV i) = pure 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, Show 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);cloneIV :: (PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> m (IxVector i (v (PrimState m) a));cloneIV IxVector{..} = do { vec' <- GM.clone vecIV; pure $ IxVector boundsIV vec'};{-# INLINE extractImos2d #-};extractImos2d :: forall a . (HasCallStack, Num a, U.Unbox a) => Int -> Int -> U.Vector (Int, Int, Int, Int, a) -> IxUVector (Int, Int) a;extractImos2d h w rangeAdds = IxVector (zero2 h w) $ U.create $ do { rect <- IxVector (zero2 h w) <$> UM.replicate (h * w) (0 :: a); U.forM_ rangeAdds $ \ (!y1, !y2, !x1, !x2, !d) -> do { modifyIV rect (+ d) (y1, x1); let { !by = y2 < h - 1}; when by $ do { modifyIV rect (subtract d) (y2 + 1, x1)}; let { !bx = x2 < w - 1}; when bx $ do { modifyIV rect (subtract d) (y1, x2 + 1)}; when (by && bx) $ do { modifyIV rect (+ d) (y2 + 1, x2 + 1)}}; pure $ vecIV rect};{-# INLINE imos2d #-};imos2d :: forall a . (HasCallStack, Num a, U.Unbox a) => Int -> Int -> U.Vector (Int, Int, Int, Int, a) -> IxUVector (Int, Int) a;imos2d h w rangeAdds = IxVector (zero2 h w) $ U.create $ do { rect <- thawIV seeds; for_ [0 .. h - 1] $ \ y -> do { for_ [1 .. w - 1] $ \ x -> do { dx <- readIV rect (y, x - 1); modifyIV rect (+ dx) (y, x)}}; for_ [0 .. w - 1] $ \ x -> do { for_ [1 .. h - 1] $ \ y -> do { dy <- readIV rect (y - 1, x); modifyIV rect (+ dy) (y, x)}}; pure $ vecIV rect} where { seeds = extractImos2d h w rangeAdds};{-# 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)};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (HasCallStack, Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum G.! (r + 1) - csum G.! l where { _ | debug = let { n = U.length csum - 1; !_ = dbgAssert (inRange (0, n - 1) l && inRange (0, n - 1) r) $ "(+!) invalid range: " ++ show (l, r)} in () | otherwise = ()};{-# INLINE newCSumU #-};newCSumU :: (PrimMonad m, Num a, U.Unbox a) => Int -> m (UM.MVector (PrimState m) a);newCSumU n = UM.replicate (n + 1) 0;{-# INLINE readCSum #-};readCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> Int -> m a;readCSum vec l r = (-) <$> GM.read vec (r + 1) <*> GM.read vec l;{-# INLINE appendCSum #-};appendCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();appendCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};{-# INLINE csum3D #-};csum3D :: (HasCallStack, Num a, U.Unbox a) => Int -> IxUVector (Int, Int, Int) a -> IxUVector (Int, Int, Int) a;csum3D !n !gr = IxVector bnd $ U.constructN (succ n * succ n * succ n) $ \ sofar -> case unindex bnd (G.length sofar) of { (0, !_, !_) -> 0; (!_, 0, !_) -> 0; (!_, !_, 0) -> 0; (!x, !y, !z) -> v0 + (fromZ + fromY + fromX) - 2 * fromDiag - (dupX + dupY + dupZ) where { v0 = gr @! (x - 1, y - 1, z - 1); sofar' = IxVector bnd sofar; fromZ = sofar' @! (x - 1, y, z); fromY = sofar' @! (x, y - 1, z); fromX = sofar' @! (x, y, z - 1); fromDiag = sofar' @! (x - 1, y - 1, z - 1); dupX = sofar' @! (x - 1, y - 1, z) - fromDiag; dupY = sofar' @! (x - 1, y, z - 1) - fromDiag; dupZ = sofar' @! (x, y - 1, z - 1) - fromDiag}} where { !bnd = ((0, 0, 0), (n, n, n))};class SemigroupAction s a where { sact :: s -> a -> a};sactTimes :: (Semigroup s, SemigroupAction s a) => Int -> s -> a -> a;sactTimes n0 s0 a0 = case compare n0 0 of { LT -> errorWithoutStackTrace "sactTimes: zero or positive multiplier expected"; EQ -> a0; GT -> EM.stimes' n0 s0 `sact` a0};instance (Semigroup a) => SemigroupAction a a where { {-# INLINE sact #-}; sact = (<>)};
| ^
app/Main.hs:7:12027: warning: [GHC-62161] [-Wincomplete-uni-patterns]
Pattern match(es) are non-exhaustive
In a pattern binding: Patterns of type ‘[a]’ not matched: []
|
7 | {-# INLINE runIO #-};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;{-# INLINE runFileIO #-};runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;{-# INLINE intP #-};intP :: (MonadState BS.ByteString m) => m Int;intP = state $ fromJust . BS.readInt . BS.dropSpace;{-# INLINE int1P #-};int1P :: (MonadState BS.ByteString m) => m Int;int1P = subtract 1 <$> intP;{-# INLINE charP #-};charP :: (MonadState BS.ByteString m) => m Char;charP = state $ fromJust . BS.uncons . BS.dropSpace;{-# INLINE wordP #-};wordP :: (MonadState BS.ByteString m) => m BS.ByteString;wordP = state $ BS.break isSpace . BS.dropSpace;doubleP :: (MonadState BS.ByteString m) => m Double;doubleP = read . BS.unpack <$> wordP;{-# INLINE ints2P #-};ints2P :: (MonadState BS.ByteString m) => m (Int, Int);ints2P = (,) <$> intP <*> intP;{-# INLINE ints11P #-};ints11P :: (MonadState BS.ByteString m) => m (Int, Int);ints11P = (,) <$> int1P <*> int1P;{-# INLINE ints3P #-};ints3P :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3P = (,,) <$> intP <*> intP <*> intP;{-# INLINE ints110P #-};ints110P :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110P = (,,) <$> int1P <*> int1P <*> intP;{-# INLINE ints011 #-};ints011 :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints011 = (,,) <$> intP <*> int1P <*> int1P;{-# INLINE ints111 #-};ints111 :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111 = (,,) <$> int1P <*> int1P <*> int1P;{-# INLINE ints4P #-};ints4P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4P = (,,,) <$> intP <*> intP <*> intP <*> intP;{-# INLINE ints5P #-};ints5P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5P = (,,,,) <$> intP <*> intP <*> intP <*> intP <*> intP;{-# INLINE ints6P #-};ints6P :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6P = (,,,,,) <$> intP <*> intP <*> intP <*> intP <*> intP <*> intP;{-# INLINE lineP #-};lineP :: (MonadState BS.ByteString m) => m BS.ByteString;lineP = state $ BS.span (/= '\n') . BS.dropSpace;{-# INLINE lineUP #-};lineUP :: (MonadState BS.ByteString m) => m (U.Vector Char);lineUP = do { s <- lineP; pure $ U.fromListN (BS.length s) $ BS.unpack s};{-# INLINE withLine #-};withLine :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine f = evalState f <$> lineP;{-# INLINE intListP #-};intListP :: (MonadState BS.ByteString m) => m [Int];intListP = unfoldr (BS.readInt . BS.dropSpace) <$> lineP;{-# INLINE intsP #-};intsP :: (MonadState BS.ByteString m) => m (U.Vector Int);intsP = U.unfoldr (BS.readInt . BS.dropSpace) <$> lineP;{-# INLINE intsNP #-};intsNP :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsNP n = U.replicateM n intP;{-# INLINE digitsP #-};digitsP :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsP = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> lineP;dbg :: (Show a) => a -> ();dbg x | debug = let { !_ = traceShow x ()} in () | otherwise = ();dbgM :: (Monad m, Show a) => m a -> m ();dbgM m | debug = do { !s <- m; let { !_ = traceShow s ()}; pure ()} | otherwise = pure ();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 ()}; pure ()} | otherwise = pure ();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 :: (HasCallStack) => Bool -> String -> ();dbgAssert b s | debug && not b = error $ "assertion failed!: " ++ s | otherwise = ();asserted :: (HasCallStack) => Bool -> a -> a;asserted b x | debug && not b = error "assertion failed!" | otherwise = x;($$) :: (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'}; pure ()} | otherwise = pure ();{-# INLINE endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';{-# INLINE putBSB #-};putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;{-# INLINE putLnBSB #-};putLnBSB :: (MonadIO m) => BSB.Builder -> m ();putLnBSB = liftIO . BSB.hPutBuilder stdout . (<> endlBSB);{-# INLINE wsBSB #-};wsBSB :: BSB.Builder;wsBSB = BSB.char7 ' ';class ShowBSB a where { showBSB :: a -> BSB.Builder; {-# INLINE showBSB #-}; default showBSB :: (Show a) => a -> BSB.Builder; showBSB = BSB.string8 . show};instance ShowBSB Int where { {-# INLINE showBSB #-}; showBSB = BSB.intDec};instance ShowBSB Integer where { {-# INLINE showBSB #-}; showBSB = BSB.integerDec};instance ShowBSB Float where { {-# INLINE showBSB #-}; showBSB = BSB.floatDec};instance ShowBSB Double where { {-# INLINE showBSB #-}; showBSB = BSB.doubleDec};instance ShowBSB Char where { {-# INLINE showBSB #-}; showBSB = BSB.char7};instance ShowBSB String where { {-# INLINE showBSB #-}; showBSB = BSB.string8};instance ShowBSB BS.ByteString where { {-# INLINE showBSB #-}; showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { {-# INLINE showBSB #-}; showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { {-# INLINE showBSB #-}; showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};instance (ShowBSB a, ShowBSB b, ShowBSB c, ShowBSB d) => ShowBSB (a, b, c, d) where { {-# INLINE showBSB #-}; showBSB (!a, !b, !c, !d) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c <> BSB.string7 " " <> showBSB d};{-# INLINE showLnBSB #-};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;{-# INLINE printBSB #-};printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;{-# INLINE concatBSB #-};concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;{-# INLINE intersperseBSB #-};intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB = intersperseWithBSB showBSB;{-# INLINE intersperseWithBSB #-};intersperseWithBSB :: (G.Vector v a) => (a -> BSB.Builder) -> BSB.Builder -> v a -> BSB.Builder;intersperseWithBSB showF del vec | G.null vec = mempty | otherwise = showF (G.head vec) <> G.foldMap ((del <>) . showF) (G.tail vec);{-# INLINE unwordsBSB #-};unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;{-# INLINE unlinesBSB #-};unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;{-# INLINE yn #-};yn :: Bool -> String;yn = bool "No" "Yes";{-# INLINE ynBSB #-};ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");{-# INLINE printYn #-};printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;{-# INLINE printList #-};printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;{-# INLINE putList #-};putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;{-# INLINE printVec #-};printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;{-# INLINE putVec #-};putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;type Vertex = Int;type EdgeId = Int;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))};{-# INLINE rleOf #-};rleOf :: BS.ByteString -> [(Char, Int)];rleOf = map (\ s -> (BS.head s, BS.length s)) . BS.group;{-# INLINE rleOfU #-};rleOfU :: BS.ByteString -> U.Vector (Char, Int);rleOfU = U.fromList . rleOf;{-# INLINE square #-};square :: (Num a) => a -> a;square !x = x * x;{-# INLINE isqrt #-};isqrt :: Int -> Int;isqrt = round @Double . sqrt . fromIntegral;{-# INLINE (.:) #-};(.:) :: (b -> c) -> (a1 -> a2 -> b) -> (a1 -> a2 -> c);(.:) = (.) . (.);{-# INLINE swapDupeU #-};swapDupeU :: U.Vector (Int, Int) -> U.Vector (Int, Int);swapDupeU = U.concatMap (\ (!u, !v) -> U.fromListN 2 [(u, v), (v, u)]);{-# INLINE swapDupeW #-};swapDupeW :: (U.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);swapDupeW = U.concatMap (\ (!u, !v, !d) -> U.fromListN 2 [(u, v, d), (v, u, d)]);{-# INLINE ortho4 #-};ortho4 :: U.Vector (Int, Int);ortho4 = U.fromList [(0, 1), (0, -1), (1, 0), (-1, 0)];{-# INLINE ortho4' #-};ortho4' :: ((Int, Int), (Int, Int)) -> (Int, Int) -> U.Vector (Int, Int);ortho4' bnd base = U.filter (inRange bnd) $ U.map (add2 base) ortho4;{-# INLINE orthoWith #-};orthoWith :: ((Int, Int), (Int, Int)) -> ((Int, Int) -> Bool) -> (Int -> U.Vector Int);orthoWith bnd p v1 = U.map (index bnd) . U.filter ((&&) <$> inRange bnd <*> p) $ U.map (add2 (unindex bnd v1)) ortho4;{-# INLINE diag4 #-};diag4 :: U.Vector (Int, Int);diag4 = U.fromList [(-1, 1), (1, 1), (1, -1), (-1, -1)];{-# INLINE slice #-};slice :: (G.Vector v a) => Int -> Int -> v a -> v a;slice !l !r !vec = G.slice l (max 0 (r - l + 1)) vec;{-# INLINE zero2 #-};zero2 :: Int -> Int -> ((Int, Int), (Int, Int));zero2 n1 n2 = ((0, 0), (n1 - 1, n2 - 1));{-# INLINE zero3 #-};zero3 :: Int -> Int -> Int -> ((Int, Int, Int), (Int, Int, Int));zero3 n1 n2 n3 = ((0, 0, 0), (n1 - 1, n2 - 1, n3 - 1));{-# INLINE rangeG #-};rangeG :: (G.Vector v Int) => Int -> Int -> v Int;rangeG !i !j = G.enumFromN i (succ j - i);{-# INLINE rangeV #-};rangeV :: Int -> Int -> V.Vector Int;rangeV = rangeG;{-# INLINE rangeU #-};rangeU :: Int -> Int -> U.Vector Int;rangeU = rangeG;{-# INLINE rangeGR #-};rangeGR :: (G.Vector v Int) => Int -> Int -> v Int;rangeGR !i !j = G.enumFromStepN j (-1) (succ j - i);{-# INLINE rangeVR #-};rangeVR :: Int -> Int -> V.Vector Int;rangeVR = rangeGR;{-# INLINE rangeUR #-};rangeUR :: Int -> Int -> U.Vector Int;rangeUR = rangeGR;{-# INLINE times #-};times :: Int -> (a -> a) -> a -> a;times !n !f = inner 0 where { inner i !s | i >= n = s | otherwise = inner (i + 1) $! f s};interleave :: [a] -> [a] -> [a];interleave xs [] = xs; interleave [] ys = ys; interleave (x : xs) (y : ys) = x : y : interleave xs ys;combs :: Int -> [a] -> [[a]];combs _ [] = []; combs k as@(!(_ : xs)) | k == 0 = [[]] | k == 1 = map pure as | k == l = pure as | k > l = [] | otherwise = run (l - 1) (k - 1) as $ combs (k - 1) xs where { l = length as; run :: Int -> Int -> [a] -> [[a]] -> [[a]]; run n k ys cs | n == k = map (ys ++) cs | otherwise = map (q :) cs ++ run (n - 1) k qs (drop dc cs) where { (!(q : qs)) = take (n - k + 1) ys; dc = product [(n - k + 1) .. (n - 1)] `div` product [1 .. (k - 1)]}};{-# INLINE swapDupe #-};swapDupe :: (a, a) -> [(a, a)];swapDupe (!x1, !x2) = [(x1, x2), (x2, x1)];{-# INLINE add2 #-};add2 :: (Int, Int) -> (Int, Int) -> (Int, Int);add2 (!y, !x) = bimap (y +) (x +);{-# INLINE sub2 #-};sub2 :: (Int, Int) -> (Int, Int) -> (Int, Int);sub2 (!y, !x) = bimap (y -) (x -);{-# INLINE mul2 #-};mul2 :: Int -> (Int, Int) -> (Int, Int);mul2 !m = both (m *);{-# INLINE add3 #-};add3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);add3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 + z2, y1 + y2, x1 + x2);{-# INLINE sub3 #-};sub3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);sub3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE mul3 #-};mul3 :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int);mul3 (!z1, !y1, !x1) (!z2, !y2, !x2) = (z1 - z2, y1 - y2, x1 - x2);{-# INLINE toRadian #-};toRadian :: Double -> Double;toRadian degree = degree / 180.0 * pi;{-# INLINE toDegree #-};toDegree :: Double -> Double;toDegree rad = rad / pi * 180.0;{-# INLINE fst4 #-};fst4 :: (a, b, c, d) -> a;fst4 (!a, !_, !_, !_) = a;{-# INLINE snd4 #-};snd4 :: (a, b, c, d) -> b;snd4 (!_, !b, !_, !_) = b;{-# INLINE thd4 #-};thd4 :: (a, b, c, d) -> c;thd4 (!_, !_, !c, !_) = c;{-# INLINE fth4 #-};fth4 :: (a, b, c, d) -> d;fth4 (!_, !_, !_, !d) = d;{-# INLINE first4 #-};first4 :: (a -> x) -> (a, b, c, d) -> (x, b, c, d);first4 f (!a, !b, !c, !d) = (f a, b, c, d);{-# INLINE second4 #-};second4 :: (b -> x) -> (a, b, c, d) -> (a, x, c, d);second4 f (!a, !b, !c, !d) = (a, f b, c, d);{-# INLINE third4 #-};third4 :: (c -> x) -> (a, b, c, d) -> (a, b, x, d);third4 f (!a, !b, !c, !d) = (a, b, f c, d);{-# INLINE fourth4 #-};fourth4 :: (d -> x) -> (a, b, c, d) -> (a, b, c, x);fourth4 f (!a, !b, !c, !d) = (a, b, c, f d);fix1 :: a -> ((a -> b) -> a -> b) -> b;fix1 a f = fix f a;fix2 :: a -> b -> ((a -> b -> c) -> a -> b -> c) -> c;fix2 a b f = fix f a b;fix3 :: a -> b -> c -> ((a -> b -> c -> d) -> a -> b -> c -> d) -> d;fix3 a b c f = fix f a b c;{-# INLINE index' #-};index' :: (HasCallStack, Ix i, Show i) => (i, i) -> i -> Int;index' !bnd !i | inRange bnd i = index bnd i | otherwise = error $ "index out ouf bounds: " ++ show i ++ " in " ++ show bnd;data IxVector i v = IxVector{boundsIV :: !(i, i), vecIV :: !v} deriving (Show, Eq);type IxUVector i a = IxVector i (U.Vector a);type IxBVector i a = IxVector i (V.Vector a);type IxMUVector s i a = IxVector i (UM.MVector s a);type IxMBVector s i a = IxVector i (VM.MVector s a);{-# INLINE (@!) #-};(@!) :: (HasCallStack, Ix i, Show 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, Show 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) => (a -> Bool) -> IxVector i (v a) -> Maybe i;findIndexIV f IxVector{..} = unindex boundsIV <$> G.findIndex f vecIV;{-# INLINE findIndicesIV #-};findIndicesIV :: (Unindex i, G.Vector v a, G.Vector v i, G.Vector v Int) => (a -> Bool) -> IxVector i (v a) -> v i;findIndicesIV f IxVector{..} = G.map (unindex boundsIV) $ G.findIndices 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 filterIV #-};filterIV :: (U.Unbox a) => (a -> Bool) -> IxVector i (U.Vector a) -> U.Vector a;filterIV !f IxVector{..} = U.filter f vecIV;{-# INLINE ifilterIV #-};ifilterIV :: (Unindex i, U.Unbox a) => (i -> a -> Bool) -> IxVector i (U.Vector a) -> U.Vector a;ifilterIV !f IxVector{..} = U.ifilter (f . unindex boundsIV) vecIV;{-# INLINE indexedIV #-};indexedIV :: (Unindex i, U.Unbox a) => IxVector i (U.Vector a) -> U.Vector (i, a);indexedIV IxVector{..} = U.imap ((,) . unindex boundsIV) vecIV;{-# INLINE replicateIV #-};replicateIV :: (Unindex i, U.Unbox a) => (i, i) -> a -> IxUVector i a;replicateIV bnd x = IxVector bnd $ U.replicate (rangeSize bnd) x;{-# 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, Show 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 . (HasCallStack, 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 _ = pure 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, Show 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 readMaybeIV #-};readMaybeIV :: (HasCallStack, Ix i, Show i, PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> i -> m (Maybe a);readMaybeIV IxVector{..} i | not (inRange boundsIV i) = pure 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, Show 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);cloneIV :: (PrimMonad m, GM.MVector v a) => IxVector i (v (PrimState m) a) -> m (IxVector i (v (PrimState m) a));cloneIV IxVector{..} = do { vec' <- GM.clone vecIV; pure $ IxVector boundsIV vec'};{-# INLINE extractImos2d #-};extractImos2d :: forall a . (HasCallStack, Num a, U.Unbox a) => Int -> Int -> U.Vector (Int, Int, Int, Int, a) -> IxUVector (Int, Int) a;extractImos2d h w rangeAdds = IxVector (zero2 h w) $ U.create $ do { rect <- IxVector (zero2 h w) <$> UM.replicate (h * w) (0 :: a); U.forM_ rangeAdds $ \ (!y1, !y2, !x1, !x2, !d) -> do { modifyIV rect (+ d) (y1, x1); let { !by = y2 < h - 1}; when by $ do { modifyIV rect (subtract d) (y2 + 1, x1)}; let { !bx = x2 < w - 1}; when bx $ do { modifyIV rect (subtract d) (y1, x2 + 1)}; when (by && bx) $ do { modifyIV rect (+ d) (y2 + 1, x2 + 1)}}; pure $ vecIV rect};{-# INLINE imos2d #-};imos2d :: forall a . (HasCallStack, Num a, U.Unbox a) => Int -> Int -> U.Vector (Int, Int, Int, Int, a) -> IxUVector (Int, Int) a;imos2d h w rangeAdds = IxVector (zero2 h w) $ U.create $ do { rect <- thawIV seeds; for_ [0 .. h - 1] $ \ y -> do { for_ [1 .. w - 1] $ \ x -> do { dx <- readIV rect (y, x - 1); modifyIV rect (+ dx) (y, x)}}; for_ [0 .. w - 1] $ \ x -> do { for_ [1 .. h - 1] $ \ y -> do { dy <- readIV rect (y - 1, x); modifyIV rect (+ dy) (y, x)}}; pure $ vecIV rect} where { seeds = extractImos2d h w rangeAdds};{-# 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)};{-# INLINE csum1D #-};csum1D :: (Num a, U.Unbox a) => U.Vector a -> U.Vector a;csum1D = U.scanl' (+) 0;{-# INLINE (+!) #-};(+!) :: (HasCallStack, Num a, U.Unbox a) => U.Vector a -> (Int, Int) -> a;(+!) csum (!l, !r) = csum G.! (r + 1) - csum G.! l where { _ | debug = let { n = U.length csum - 1; !_ = dbgAssert (inRange (0, n - 1) l && inRange (0, n - 1) r) $ "(+!) invalid range: " ++ show (l, r)} in () | otherwise = ()};{-# INLINE newCSumU #-};newCSumU :: (PrimMonad m, Num a, U.Unbox a) => Int -> m (UM.MVector (PrimState m) a);newCSumU n = UM.replicate (n + 1) 0;{-# INLINE readCSum #-};readCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> Int -> m a;readCSum vec l r = (-) <$> GM.read vec (r + 1) <*> GM.read vec l;{-# INLINE appendCSum #-};appendCSum :: (PrimMonad m, Num a, GM.MVector v a) => v (PrimState m) a -> Int -> a -> m ();appendCSum vec len dx = do { x <- GM.read vec len; GM.write vec (len + 1) $! x + dx};{-# INLINE csum3D #-};csum3D :: (HasCallStack, Num a, U.Unbox a) => Int -> IxUVector (Int, Int, Int) a -> IxUVector (Int, Int, Int) a;csum3D !n !gr = IxVector bnd $ U.constructN (succ n * succ n * succ n) $ \ sofar -> case unindex bnd (G.length sofar) of { (0, !_, !_) -> 0; (!_, 0, !_) -> 0; (!_, !_, 0) -> 0; (!x, !y...