提出 #54548102
ソースコード 拡げる
{-# 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, ViewPatterns #-}
import Control.Applicative;import Control.DeepSeq;import Control.Exception (assert);import Control.Monad;import Control.Monad.Fix;import Control.Monad.IO.Class;import Control.Monad.Primitive;import Control.Monad.ST;import Control.Monad.State.Class;import Control.Monad.Trans (MonadTrans, lift);import Control.Monad.Trans.Cont;import Control.Monad.Trans.Maybe;import Control.Monad.Trans.State.Strict (State, StateT(..), evalState, evalStateT, execState, execStateT, runState, runStateT);import Data.Bifunctor;import Data.Bits;import Data.Bool (bool);import Data.Char;import Data.Coerce;import Data.Either;import Data.Foldable;import Data.Function (on);import Data.Functor;import Data.Functor.Identity;import Data.IORef;import Data.Kind;import Data.List.Extra hiding (nubOn);import Data.Maybe;import Data.Ord;import Data.Primitive.MutVar;import Data.Proxy;import Data.STRef;import Data.Semigroup;import Data.Word;import Debug.Trace;import GHC.Exts (proxy#);import GHC.Float (int2Float);import GHC.Ix (unsafeIndex);import GHC.Stack (HasCallStack);import GHC.TypeLits;import System.Exit (exitSuccess);import System.IO;import System.Random;import System.Random.Stateful;import Text.Printf;import 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 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.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
{- ORMOLU_ENABLE -}
saOfNaive :: BS.ByteString -> U.Vector Int;saOfNaive bs = U.convert . V.map fst . V.modify (VAI.sortBy (comparing snd)) $ V.generate n (\ i -> (i, BS.drop i bs)) where { n = BS.length bs};saOf :: BS.ByteString -> U.Vector Int;saOf bs0 = G.tail $ sortCyclicShifts (BS.snoc bs0 c0) where { !c0 = chr 0};sortCyclicShifts :: BS.ByteString -> U.Vector Int;sortCyclicShifts bs = sortCyclicShifts' n 1 nClasses0 classes0 perm0 where { (!nClasses0, !classes0, !perm0) = sortByCharacter bs; !n = BS.length bs};sortByCharacter :: BS.ByteString -> (Int, U.Vector Int, U.Vector Int);sortByCharacter bs = (nClasses, classes, perm) where { !n = BS.length bs; !alphabet = 256; !perm = U.create $ do { cnt <- U.unsafeThaw . G.scanl1' (+) . G.accumulate (+) (U.replicate alphabet (0 :: Int)) . G.map ((, 1) . ord) . U.fromList $ BS.unpack bs; vec <- UM.unsafeNew n; forM_ [n - 1, n - 2 .. 0] $ \ i -> do { let { !c = ord $ BS.index bs i}; GM.modify cnt (subtract 1) c; i' <- GM.read cnt c; GM.write vec i' i}; return vec}; (!nClasses, !classes) = runST $ do { vec <- UM.unsafeNew n; GM.write vec (G.head perm) 0; !nClasses <- fmap (+ 1) . (`execStateT` (0 :: Int)) $ G.zipWithM_ (\ i1 i2 -> do { when (BS.index bs i1 /= BS.index bs i2) $ do { modify' (+ 1)}; GM.write vec i1 =<< get}) (G.tail perm) perm; (nClasses,) <$> G.unsafeFreeze vec}};sortCyclicShifts' :: Int -> Int -> Int -> U.Vector Int -> U.Vector Int -> U.Vector Int;sortCyclicShifts' n len nClasses classes perm | len >= n = perm | otherwise = let { (!nClasses', !classes') = getNextClasses ()} in sortCyclicShifts' n (len .<<. 1) nClasses' classes' perm' where { fastAddMod m x y | x' >= m = x' - m | otherwise = x' where { !x' = x + y}; fastSubMod m x y | x' < 0 = x' + m | otherwise = x' where { !x' = x - y}; rightHalves = G.map (\ p -> fastSubMod n p len) perm; perm' = U.create $ do { cnt <- U.unsafeThaw . G.scanl1' (+) . G.accumulate (+) (G.replicate nClasses (0 :: Int)) $ G.map (\ i -> (classes G.! i, 1)) rightHalves; vec <- UM.unsafeNew n; GM.write vec (G.head rightHalves) 0; G.forM_ (G.reverse rightHalves) $ \ i -> do { let { !c = classes G.! i}; GM.modify cnt (subtract 1) c; i' <- GM.read cnt c; GM.write vec i' i}; return vec}; getNextClasses () = runST $ do { vec <- UM.unsafeNew n; GM.write vec (G.head perm') 0; !nClasses' <- fmap (+ 1) . (`execStateT` (0 :: Int)) $ G.zipWithM_ (\ i1 i2 -> do { let { !l1 = (G.!) classes i1; !r1 = (G.!) classes $ fastAddMod n i1 len; !l2 = (G.!) classes i2; !r2 = (G.!) classes $ fastAddMod n i2 len}; unless (l1 == l2 && r1 == r2) $ do { modify' (+ 1)}; GM.write vec i1 =<< get}) (G.tail perm') perm'; (nClasses',) <$> G.unsafeFreeze vec}};lcpOfSa :: BS.ByteString -> U.Vector Int -> U.Vector Int;lcpOfSa bs sa = U.create $ do { vec <- UM.unsafeNew (n - 1); G.ifoldM_ (\ len i i' -> do { if i' == n - 1 then do { return 0} else do { let { !j = G.unsafeIndex sa (i' + 1)}; let { !len' = until (not . testMatch sa i j) (+ 1) len}; GM.unsafeWrite vec i' len'; return $ max 0 (len' - 1)}}) (0 :: Int) revSa; return vec} where { !n = G.length sa; !revSa = G.unsafeUpdate (U.replicate n (-1 :: Int)) $ U.imap (flip (,)) sa; testMatch sa i j len | i + len >= n || j + len >= n = False | otherwise = BSU.unsafeIndex bs (i + len) == BSU.unsafeIndex bs (j + len)};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 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)};{-# INLINE groupRootsMUF #-};groupRootsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m (U.Vector Int);groupRootsMUF uf@(MUnionFind !vec) = U.filterM (\ x -> (== x) <$> rootMUF uf x) (U.generate (GM.length vec) id);groupsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m (IM.IntMap [Int]);groupsMUF uf@(MUnionFind !vec) = do { rvs <- V.generateM (GM.length vec) (\ v -> (, [v]) <$> rootMUF uf v); return $ IM.fromListWith (flip (++)) $ V.toList rvs};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))};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 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, 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) => (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, 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);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; return $ IxVector boundsIV vec'};{-# 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 endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;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; 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};instance ShowBSB Char where { showBSB = BSB.char7};instance ShowBSB String where { showBSB = BSB.string8};instance ShowBSB BS.ByteString where { showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { showBSB (!a, !b, c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB del vec | G.null vec = mempty | otherwise = showBSB (G.head vec) <> G.foldMap ((del <>) . showBSB) (G.tail vec);unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;yn :: Bool -> String;yn = bool "No" "Yes";ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;printGrid :: (MonadIO m) => IxUVector (Int, Int) Char -> m ();printGrid = putBSB . showGridBSB;showGridBSB :: IxUVector (Int, Int) Char -> BSB.Builder;showGridBSB mat = G.foldMap ((<> endlBSB) . concatBSB) rows where { ((!y1, !x1), (!y2, !x2)) = boundsIV mat; !h = y2 + 1 - y1; !w = x2 + 1 - x1; rows = V.unfoldrExactN h (U.splitAt w) (vecIV mat)};printMat :: (ShowBSB a, U.Unbox a, MonadIO m) => IxUVector (Int, Int) a -> m ();printMat = putBSB . showMatBSB;showMatBSB :: (ShowBSB a, U.Unbox a) => IxUVector (Int, Int) a -> BSB.Builder;showMatBSB mat = G.foldMap ((<> endlBSB) . unwordsBSB) rows where { ((!y1, !x1), (!y2, !x2)) = boundsIV mat; !h = y2 + 1 - y1; !w = x2 + 1 - x1; rows = V.unfoldrExactN h (U.splitAt w) (vecIV mat)};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;int' :: (MonadState BS.ByteString m) => m Int;int' = state $ fromJust . BS.readInt . BS.dropSpace;int1' :: (MonadState BS.ByteString m) => m Int;int1' = subtract 1 <$> int';char' :: (MonadState BS.ByteString m) => m Char;char' = state $ fromJust . BS.uncons . BS.dropSpace;word' :: (MonadState BS.ByteString m) => m BS.ByteString;word' = state $ BS.break isSpace . BS.dropSpace;double' :: (MonadState BS.ByteString m) => m Double;double' = read . BS.unpack <$> word';ints2' :: (MonadState BS.ByteString m) => m (Int, Int);ints2' = (,) <$> int' <*> int';ints11' :: (MonadState BS.ByteString m) => m (Int, Int);ints11' = (,) <$> int1' <*> int1';ints3' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3' = (,,) <$> int' <*> int' <*> int';ints110' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110' = (,,) <$> int1' <*> int1' <*> int';ints111' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111' = (,,) <$> int1' <*> int1' <*> int1';ints4' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4' = (,,,) <$> int' <*> int' <*> int' <*> int';ints5' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5' = (,,,,) <$> int' <*> int' <*> int' <*> int' <*> int';ints6' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6' = (,,,,,) <$> int' <*> int' <*> int' <*> int' <*> int' <*> int';line' :: (MonadState BS.ByteString m) => m BS.ByteString;line' = state $ BS.span (/= '\n') . BS.dropSpace;withLine' :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine' f = evalState f <$> line';ints' :: (MonadState BS.ByteString m) => m [Int];ints' = unfoldr (BS.readInt . BS.dropSpace) <$> line';intsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);intsU' = U.unfoldr (BS.readInt . BS.dropSpace) <$> line';intsN' :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsN' n = U.replicateM n int';digitsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsU' = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> line';getMat' :: (MonadState BS.ByteString m) => Int -> Int -> m (IxVector (Int, Int) (U.Vector Int));getMat' !h !w = IxVector ((0, 0), (h - 1, w - 1)) <$> U.replicateM (h * w) int';getGrid' :: (MonadState BS.ByteString m) => Int -> Int -> m (IxUVector (Int, Int) Char);getGrid' !h !w = IxVector ((0, 0), (h - 1, w - 1)) <$> U.replicateM (h * w) char';getDiagMat' :: (PrimMonad m, MonadState BS.ByteString m) => Int -> m (IxUVector (Int, Int) Int);getDiagMat' !n = fmap (IxVector bnd) $ do { !vec <- UM.replicate (n * n) (0 :: Int); U.forM_ (U.generate (n - 1) id) $ \ y -> do { !ws <- intsU'; U.iforM_ ws $ \ i dw -> do { let { !x = y + i + 1}; UM.write vec (index bnd (y, x)) dw; UM.write vec (index bnd (x, y)) dw}}; U.unsafeFreeze vec} where { !bnd = ((0, 0), (n - 1, n - 1))};{-# 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.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);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 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 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
{-# RULES "Force inline VAI.sort" VAI.sort = VAI.sortBy compare #-}
debug = False
countUniqueSubstrings :: BS.ByteString -> Int
countUniqueSubstrings bs = (n * (n + 1)) `div` 2 - U.sum lcp
where
!n = BS.length bs
!sa = saOf bs
!lcp = lcpOfSa bs sa
solve :: StateT BS.ByteString IO ()
solve = do
s <- line'
printBSB $ countUniqueSubstrings s
-- verification-helper: PROBLEM https://atcoder.jp/contests/practice2/tasks/practice2_i
-- #suffix-array
--
-- Same as yosupo one.
main :: IO ()
main = runIO solve
提出情報
コンパイルエラー
app/Main.hs:7:1098: warning: [-Wname-shadowing]
This binding for ‘nClasses’ shadows the existing binding
bound at app/Main.hs:7:1009
|
7 | saOfNaive :: BS.ByteString -> U.Vector Int;saOfNaive bs = U.convert . V.map fst . V.modify (VAI.sortBy (comparing snd)) $ V.generate n (\ i -> (i, BS.drop i bs)) where { n = BS.length bs};saOf :: BS.ByteString -> U.Vector Int;saOf bs0 = G.tail $ sortCyclicShifts (BS.snoc bs0 c0) where { !c0 = chr 0};sortCyclicShifts :: BS.ByteString -> U.Vector Int;sortCyclicShifts bs = sortCyclicShifts' n 1 nClasses0 classes0 perm0 where { (!nClasses0, !classes0, !perm0) = sortByCharacter bs; !n = BS.length bs};sortByCharacter :: BS.ByteString -> (Int, U.Vector Int, U.Vector Int);sortByCharacter bs = (nClasses, classes, perm) where { !n = BS.length bs; !alphabet = 256; !perm = U.create $ do { cnt <- U.unsafeThaw . G.scanl1' (+) . G.accumulate (+) (U.replicate alphabet (0 :: Int)) . G.map ((, 1) . ord) . U.fromList $ BS.unpack bs; vec <- UM.unsafeNew n; forM_ [n - 1, n - 2 .. 0] $ \ i -> do { let { !c = ord $ BS.index bs i}; GM.modify cnt (subtract 1) c; i' <- GM.read cnt c; GM.write vec i' i}; return vec}; (!nClasses, !classes) = runST $ do { vec <- UM.unsafeNew n; GM.write vec (G.head perm) 0; !nClasses <- fmap (+ 1) . (`execStateT` (0 :: Int)) $ G.zipWithM_ (\ i1 i2 -> do { when (BS.index bs i1 /= BS.index bs i2) $ do { modify' (+ 1)}; GM.write vec i1 =<< get}) (G.tail perm) perm; (nClasses,) <$> G.unsafeFreeze vec}};sortCyclicShifts' :: Int -> Int -> Int -> U.Vector Int -> U.Vector Int -> U.Vector Int;sortCyclicShifts' n len nClasses classes perm | len >= n = perm | otherwise = let { (!nClasses', !classes') = getNextClasses ()} in sortCyclicShifts' n (len .<<. 1) nClasses' classes' perm' where { fastAddMod m x y | x' >= m = x' - m | otherwise = x' where { !x' = x + y}; fastSubMod m x y | x' < 0 = x' + m | otherwise = x' where { !x' = x - y}; rightHalves = G.map (\ p -> fastSubMod n p len) perm; perm' = U.create $ do { cnt <- U.unsafeThaw . G.scanl1' (+) . G.accumulate (+) (G.replicate nClasses (0 :: Int)) $ G.map (\ i -> (classes G.! i, 1)) rightHalves; vec <- UM.unsafeNew n; GM.write vec (G.head rightHalves) 0; G.forM_ (G.reverse rightHalves) $ \ i -> do { let { !c = classes G.! i}; GM.modify cnt (subtract 1) c; i' <- GM.read cnt c; GM.write vec i' i}; return vec}; getNextClasses () = runST $ do { vec <- UM.unsafeNew n; GM.write vec (G.head perm') 0; !nClasses' <- fmap (+ 1) . (`execStateT` (0 :: Int)) $ G.zipWithM_ (\ i1 i2 -> do { let { !l1 = (G.!) classes i1; !r1 = (G.!) classes $ fastAddMod n i1 len; !l2 = (G.!) classes i2; !r2 = (G.!) classes $ fastAddMod n i2 len}; unless (l1 == l2 && r1 == r2) $ do { modify' (+ 1)}; GM.write vec i1 =<< get}) (G.tail perm') perm'; (nClasses',) <$> G.unsafeFreeze vec}};lcpOfSa :: BS.ByteString -> U.Vector Int -> U.Vector Int;lcpOfSa bs sa = U.create $ do { vec <- UM.unsafeNew (n - 1); G.ifoldM_ (\ len i i' -> do { if i' == n - 1 then do { return 0} else do { let { !j = G.unsafeIndex sa (i' + 1)}; let { !len' = until (not . testMatch sa i j) (+ 1) len}; GM.unsafeWrite vec i' len'; return $ max 0 (len' - 1)}}) (0 :: Int) revSa; return vec} where { !n = G.length sa; !revSa = G.unsafeUpdate (U.replicate n (-1 :: Int)) $ U.imap (flip (,)) sa; testMatch sa i j len | i + len >= n || j + len >= n = False | otherwise = BSU.unsafeIndex bs (i + len) == BSU.unsafeIndex bs (j + len)};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 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)};{-# INLINE groupRootsMUF #-};groupRootsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m (U.Vector Int);groupRootsMUF uf@(MUnionFind !vec) = U.filterM (\ x -> (== x) <$> rootMUF uf x) (U.generate (GM.length vec) id);groupsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m (IM.IntMap [Int]);groupsMUF uf@(MUnionFind !vec) = do { rvs <- V.generateM (GM.length vec) (\ v -> (, [v]) <$> rootMUF uf v); return $ IM.fromListWith (flip (++)) $ V.toList rvs};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))};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 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, 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) => (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, 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);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; return $ IxVector boundsIV vec'};{-# 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 endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;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; 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};instance ShowBSB Char where { showBSB = BSB.char7};instance ShowBSB String where { showBSB = BSB.string8};instance ShowBSB BS.ByteString where { showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { showBSB (!a, !b, c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB del vec | G.null vec = mempty | otherwise = showBSB (G.head vec) <> G.foldMap ((del <>) . showBSB) (G.tail vec);unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;yn :: Bool -> String;yn = bool "No" "Yes";ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;printGrid :: (MonadIO m) => IxUVector (Int, Int) Char -> m ();printGrid = putBSB . showGridBSB;showGridBSB :: IxUVector (Int, Int) Char -> BSB.Builder;showGridBSB mat = G.foldMap ((<> endlBSB) . concatBSB) rows where { ((!y1, !x1), (!y2, !x2)) = boundsIV mat; !h = y2 + 1 - y1; !w = x2 + 1 - x1; rows = V.unfoldrExactN h (U.splitAt w) (vecIV mat)};printMat :: (ShowBSB a, U.Unbox a, MonadIO m) => IxUVector (Int, Int) a -> m ();printMat = putBSB . showMatBSB;showMatBSB :: (ShowBSB a, U.Unbox a) => IxUVector (Int, Int) a -> BSB.Builder;showMatBSB mat = G.foldMap ((<> endlBSB) . unwordsBSB) rows where { ((!y1, !x1), (!y2, !x2)) = boundsIV mat; !h = y2 + 1 - y1; !w = x2 + 1 - x1; rows = V.unfoldrExactN h (U.splitAt w) (vecIV mat)};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;int' :: (MonadState BS.ByteString m) => m Int;int' = state $ fromJust . BS.readInt . BS.dropSpace;int1' :: (MonadState BS.ByteString m) => m Int;int1' = subtract 1 <$> int';char' :: (MonadState BS.ByteString m) => m Char;char' = state $ fromJust . BS.uncons . BS.dropSpace;word' :: (MonadState BS.ByteString m) => m BS.ByteString;word' = state $ BS.break isSpace . BS.dropSpace;double' :: (MonadState BS.ByteString m) => m Double;double' = read . BS.unpack <$> word';ints2' :: (MonadState BS.ByteString m) => m (Int, Int);ints2' = (,) <$> int' <*> int';ints11' :: (MonadState BS.ByteString m) => m (Int, Int);ints11' = (,) <$> int1' <*> int1';ints3' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3' = (,,) <$> int' <*> int' <*> int';ints110' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110' = (,,) <$> int1' <*> int1' <*> int';ints111' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111' = (,,) <$> int1' <*> int1' <*> int1';ints4' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4' = (,,,) <$> int' <*> int' <*> int' <*> int';ints5' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5' = (,,,,) <$> int' <*> int' <*> int' <*> int' <*> int';ints6' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6' = (,,,,,) <$> int' <*> int' <*> int' <*> int' <*> int' <*> int';line' :: (MonadState BS.ByteString m) => m BS.ByteString;line' = state $ BS.span (/= '\n') . BS.dropSpace;withLine' :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine' f = evalState f <$> line';ints' :: (MonadState BS.ByteString m) => m [Int];ints' = unfoldr (BS.readInt . BS.dropSpace) <$> line';intsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);intsU' = U.unfoldr (BS.readInt . BS.dropSpace) <$> line';intsN' :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsN' n = U.replicateM n int';digitsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsU' = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> line';getMat' :: (MonadState BS.ByteString m) => Int -> Int -> m (IxVector (Int, Int) (U.Vector Int));getMat' !h !w = IxVector ((0, 0), (h - 1, w - 1)) <$> U.replicateM (h * w) int';getGrid' :: (MonadState BS.ByteString m) => Int -> Int -> m (IxUVector (Int, Int) Char);getGrid' !h !w = IxVector ((0, 0), (h - 1, w - 1)) <$> U.replicateM (h * w) char';getDiagMat' :: (PrimMonad m, MonadState BS.ByteString m) => Int -> m (IxUVector (Int, Int) Int);getDiagMat' !n = fmap (IxVector bnd) $ do { !vec <- UM.replicate (n * n) (0 :: Int); U.forM_ (U.generate (n - 1) id) $ \ y -> do { !ws <- intsU'; U.iforM_ ws $ \ i dw -> do { let { !x = y + i + 1}; UM.write vec (index bnd (y, x)) dw; UM.write vec (index bnd (x, y)) dw}}; U.unsafeFreeze vec} where { !bnd = ((0, 0), (n - 1, n - 1))};{-# 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.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);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 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 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
| ^^^^^^^^
app/Main.hs:7:3132: warning: [-Wunused-matches]
Defined but not used: ‘sa’
|
7 | saOfNaive :: BS.ByteString -> U.Vector Int;saOfNaive bs = U.convert . V.map fst . V.modify (VAI.sortBy (comparing snd)) $ V.generate n (\ i -> (i, BS.drop i bs)) where { n = BS.length bs};saOf :: BS.ByteString -> U.Vector Int;saOf bs0 = G.tail $ sortCyclicShifts (BS.snoc bs0 c0) where { !c0 = chr 0};sortCyclicShifts :: BS.ByteString -> U.Vector Int;sortCyclicShifts bs = sortCyclicShifts' n 1 nClasses0 classes0 perm0 where { (!nClasses0, !classes0, !perm0) = sortByCharacter bs; !n = BS.length bs};sortByCharacter :: BS.ByteString -> (Int, U.Vector Int, U.Vector Int);sortByCharacter bs = (nClasses, classes, perm) where { !n = BS.length bs; !alphabet = 256; !perm = U.create $ do { cnt <- U.unsafeThaw . G.scanl1' (+) . G.accumulate (+) (U.replicate alphabet (0 :: Int)) . G.map ((, 1) . ord) . U.fromList $ BS.unpack bs; vec <- UM.unsafeNew n; forM_ [n - 1, n - 2 .. 0] $ \ i -> do { let { !c = ord $ BS.index bs i}; GM.modify cnt (subtract 1) c; i' <- GM.read cnt c; GM.write vec i' i}; return vec}; (!nClasses, !classes) = runST $ do { vec <- UM.unsafeNew n; GM.write vec (G.head perm) 0; !nClasses <- fmap (+ 1) . (`execStateT` (0 :: Int)) $ G.zipWithM_ (\ i1 i2 -> do { when (BS.index bs i1 /= BS.index bs i2) $ do { modify' (+ 1)}; GM.write vec i1 =<< get}) (G.tail perm) perm; (nClasses,) <$> G.unsafeFreeze vec}};sortCyclicShifts' :: Int -> Int -> Int -> U.Vector Int -> U.Vector Int -> U.Vector Int;sortCyclicShifts' n len nClasses classes perm | len >= n = perm | otherwise = let { (!nClasses', !classes') = getNextClasses ()} in sortCyclicShifts' n (len .<<. 1) nClasses' classes' perm' where { fastAddMod m x y | x' >= m = x' - m | otherwise = x' where { !x' = x + y}; fastSubMod m x y | x' < 0 = x' + m | otherwise = x' where { !x' = x - y}; rightHalves = G.map (\ p -> fastSubMod n p len) perm; perm' = U.create $ do { cnt <- U.unsafeThaw . G.scanl1' (+) . G.accumulate (+) (G.replicate nClasses (0 :: Int)) $ G.map (\ i -> (classes G.! i, 1)) rightHalves; vec <- UM.unsafeNew n; GM.write vec (G.head rightHalves) 0; G.forM_ (G.reverse rightHalves) $ \ i -> do { let { !c = classes G.! i}; GM.modify cnt (subtract 1) c; i' <- GM.read cnt c; GM.write vec i' i}; return vec}; getNextClasses () = runST $ do { vec <- UM.unsafeNew n; GM.write vec (G.head perm') 0; !nClasses' <- fmap (+ 1) . (`execStateT` (0 :: Int)) $ G.zipWithM_ (\ i1 i2 -> do { let { !l1 = (G.!) classes i1; !r1 = (G.!) classes $ fastAddMod n i1 len; !l2 = (G.!) classes i2; !r2 = (G.!) classes $ fastAddMod n i2 len}; unless (l1 == l2 && r1 == r2) $ do { modify' (+ 1)}; GM.write vec i1 =<< get}) (G.tail perm') perm'; (nClasses',) <$> G.unsafeFreeze vec}};lcpOfSa :: BS.ByteString -> U.Vector Int -> U.Vector Int;lcpOfSa bs sa = U.create $ do { vec <- UM.unsafeNew (n - 1); G.ifoldM_ (\ len i i' -> do { if i' == n - 1 then do { return 0} else do { let { !j = G.unsafeIndex sa (i' + 1)}; let { !len' = until (not . testMatch sa i j) (+ 1) len}; GM.unsafeWrite vec i' len'; return $ max 0 (len' - 1)}}) (0 :: Int) revSa; return vec} where { !n = G.length sa; !revSa = G.unsafeUpdate (U.replicate n (-1 :: Int)) $ U.imap (flip (,)) sa; testMatch sa i j len | i + len >= n || j + len >= n = False | otherwise = BSU.unsafeIndex bs (i + len) == BSU.unsafeIndex bs (j + len)};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 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)};{-# INLINE groupRootsMUF #-};groupRootsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m (U.Vector Int);groupRootsMUF uf@(MUnionFind !vec) = U.filterM (\ x -> (== x) <$> rootMUF uf x) (U.generate (GM.length vec) id);groupsMUF :: (HasCallStack, PrimMonad m) => MUnionFind (PrimState m) -> m (IM.IntMap [Int]);groupsMUF uf@(MUnionFind !vec) = do { rvs <- V.generateM (GM.length vec) (\ v -> (, [v]) <$> rootMUF uf v); return $ IM.fromListWith (flip (++)) $ V.toList rvs};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))};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 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, 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) => (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, 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);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; return $ IxVector boundsIV vec'};{-# 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 endlBSB #-};endlBSB :: BSB.Builder;endlBSB = BSB.char7 '\n';putBSB :: (MonadIO m) => BSB.Builder -> m ();putBSB = liftIO . BSB.hPutBuilder stdout;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; 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};instance ShowBSB Char where { showBSB = BSB.char7};instance ShowBSB String where { showBSB = BSB.string8};instance ShowBSB BS.ByteString where { showBSB = BSB.byteString};instance ShowBSB BSB.Builder where { showBSB = id};instance (ShowBSB a, ShowBSB b) => ShowBSB (a, b) where { showBSB (!a, !b) = showBSB a <> BSB.string7 " " <> showBSB b};instance (ShowBSB a, ShowBSB b, ShowBSB c) => ShowBSB (a, b, c) where { showBSB (!a, !b, c) = showBSB a <> BSB.string7 " " <> showBSB b <> BSB.string7 " " <> showBSB c};showLnBSB :: (ShowBSB a) => a -> BSB.Builder;showLnBSB = (<> endlBSB) . showBSB;printBSB :: (ShowBSB a, MonadIO m) => a -> m ();printBSB = putBSB . showLnBSB;concatBSB :: (G.Vector v a, ShowBSB a) => v a -> BSB.Builder;concatBSB = G.foldMap showBSB;intersperseBSB :: (G.Vector v a, ShowBSB a) => BSB.Builder -> v a -> BSB.Builder;intersperseBSB del vec | G.null vec = mempty | otherwise = showBSB (G.head vec) <> G.foldMap ((del <>) . showBSB) (G.tail vec);unwordsBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unwordsBSB = intersperseBSB wsBSB;unlinesBSB :: (ShowBSB a, G.Vector v a) => v a -> BSB.Builder;unlinesBSB = intersperseBSB endlBSB;yn :: Bool -> String;yn = bool "No" "Yes";ynBSB :: Bool -> BSB.Builder;ynBSB = bool (BSB.string8 "No") (BSB.string8 "Yes");printYn :: (MonadIO m) => Bool -> m ();printYn = putLnBSB . ynBSB;printList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();printList = putLnBSB . unwordsBSB . U.fromList;putList :: (ShowBSB a, U.Unbox a, MonadIO m) => [a] -> m ();putList = putBSB . unwordsBSB . U.fromList;printVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();printVec = putLnBSB . unwordsBSB;putVec :: (ShowBSB a, G.Vector v a, MonadIO m) => v a -> m ();putVec = putBSB . unwordsBSB;printGrid :: (MonadIO m) => IxUVector (Int, Int) Char -> m ();printGrid = putBSB . showGridBSB;showGridBSB :: IxUVector (Int, Int) Char -> BSB.Builder;showGridBSB mat = G.foldMap ((<> endlBSB) . concatBSB) rows where { ((!y1, !x1), (!y2, !x2)) = boundsIV mat; !h = y2 + 1 - y1; !w = x2 + 1 - x1; rows = V.unfoldrExactN h (U.splitAt w) (vecIV mat)};printMat :: (ShowBSB a, U.Unbox a, MonadIO m) => IxUVector (Int, Int) a -> m ();printMat = putBSB . showMatBSB;showMatBSB :: (ShowBSB a, U.Unbox a) => IxUVector (Int, Int) a -> BSB.Builder;showMatBSB mat = G.foldMap ((<> endlBSB) . unwordsBSB) rows where { ((!y1, !x1), (!y2, !x2)) = boundsIV mat; !h = y2 + 1 - y1; !w = x2 + 1 - x1; rows = V.unfoldrExactN h (U.splitAt w) (vecIV mat)};runIO :: StateT BS.ByteString IO a -> IO a;runIO = (BS.getContents >>=) . evalStateT;runFileIO :: StateT BS.ByteString IO a -> String -> IO a;runFileIO f path = evalStateT f =<< BS.readFile path;int' :: (MonadState BS.ByteString m) => m Int;int' = state $ fromJust . BS.readInt . BS.dropSpace;int1' :: (MonadState BS.ByteString m) => m Int;int1' = subtract 1 <$> int';char' :: (MonadState BS.ByteString m) => m Char;char' = state $ fromJust . BS.uncons . BS.dropSpace;word' :: (MonadState BS.ByteString m) => m BS.ByteString;word' = state $ BS.break isSpace . BS.dropSpace;double' :: (MonadState BS.ByteString m) => m Double;double' = read . BS.unpack <$> word';ints2' :: (MonadState BS.ByteString m) => m (Int, Int);ints2' = (,) <$> int' <*> int';ints11' :: (MonadState BS.ByteString m) => m (Int, Int);ints11' = (,) <$> int1' <*> int1';ints3' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints3' = (,,) <$> int' <*> int' <*> int';ints110' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints110' = (,,) <$> int1' <*> int1' <*> int';ints111' :: (MonadState BS.ByteString m) => m (Int, Int, Int);ints111' = (,,) <$> int1' <*> int1' <*> int1';ints4' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int);ints4' = (,,,) <$> int' <*> int' <*> int' <*> int';ints5' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int);ints5' = (,,,,) <$> int' <*> int' <*> int' <*> int' <*> int';ints6' :: (MonadState BS.ByteString m) => m (Int, Int, Int, Int, Int, Int);ints6' = (,,,,,) <$> int' <*> int' <*> int' <*> int' <*> int' <*> int';line' :: (MonadState BS.ByteString m) => m BS.ByteString;line' = state $ BS.span (/= '\n') . BS.dropSpace;withLine' :: (MonadState BS.ByteString m) => State BS.ByteString a -> m a;withLine' f = evalState f <$> line';ints' :: (MonadState BS.ByteString m) => m [Int];ints' = unfoldr (BS.readInt . BS.dropSpace) <$> line';intsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);intsU' = U.unfoldr (BS.readInt . BS.dropSpace) <$> line';intsN' :: (MonadState BS.ByteString m) => Int -> m (U.Vector Int);intsN' n = U.replicateM n int';digitsU' :: (MonadState BS.ByteString m) => m (U.Vector Int);digitsU' = U.unfoldr (fmap (first digitToInt) . BS.uncons) <$> line';getMat' :: (MonadState BS.ByteString m) => Int -> Int -> m (IxVector (Int, Int) (U.Vector Int));getMat' !h !w = IxVector ((0, 0), (h - 1, w - 1)) <$> U.replicateM (h * w) int';getGrid' :: (MonadState BS.ByteString m) => Int -> Int -> m (IxUVector (Int, Int) Char);getGrid' !h !w = IxVector ((0, 0), (h - 1, w - 1)) <$> U.replicateM (h * w) char';getDiagMat' :: (PrimMonad m, MonadState BS.ByteString m) => Int -> m (IxUVector (Int, Int) Int);getDiagMat' !n = fmap (IxVector bnd) $ do { !vec <- UM.replicate (n * n) (0 :: Int); U.forM_ (U.generate (n - 1) id) $ \ y -> do { !ws <- intsU'; U.iforM_ ws $ \ i dw -> do { let { !x = y + i + 1}; UM.write vec (index bnd (y, x)) dw; UM.write vec (index bnd (x, y)) dw}}; U.unsafeFreeze vec} where { !bnd = ((0, 0), (n - 1, n - 1))};{-# 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.Unbox w) => U.Vector (Int, Int, w) -> U.Vector (Int, Int, w);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 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 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
| ^^
app/Main.hs:7:3132: warning: [-Wname-shadowing]
This binding for ‘sa’ shadows the existing binding
bound at app/Main.hs:7:2712
|
7 | saOfNaive :: BS.ByteString -> U.Vector Int;saOfNaive bs = U.convert . V.map fst . V.modify (VAI.sortBy (comparing snd)) $ V.generate n (\ i -> (i, BS.drop i bs)) where { n = BS.length bs};saOf :: BS.ByteString -> U.Vector Int;saOf bs0 = G.tail $ sortCyclicShifts (BS.snoc bs0 c0) where { !c0 = chr 0};sortCyclicShifts :: BS.ByteString -> U.Vector Int;sortCyclicShifts bs = sortCyclicShifts' n 1 nClasses0 classes0 perm0 where { (!nClasses0, !classes0, !perm0) = sortByCharacter bs; !n = BS.length bs};sortByCharacter :: BS.ByteString -> (Int, U.Vector Int, U.Vector Int);sortByCharacter bs = (nClasses, classes, perm) where { !n = BS.length bs; !alphabet = 256; !perm = U.create $ do { cnt <- U.unsafeThaw . G.scanl1' (+) . G.accumulate (+) (U.replicate alphabet (0 :: Int)) . G.map ((, 1) . ord) . U.fromList $ BS.unpack bs; vec <- UM.unsafeNew n; forM_ [n - 1, n - 2 .. 0] $ \ i -> do { let { !c = ord $ BS.index bs i}; GM.modify cnt (subtract 1) c; i' <- GM.read cnt c; GM.write vec i' i}; return vec}; (!nClasses, !classes) = runST $ do { vec <- UM.unsafeNew n; GM.write vec (G.head perm) 0; !nClasses <- fmap (+ 1) . (`execStateT` (0 :: Int)) $ G.zipWithM_ (\ i1 i2 -> do { when (BS.index bs i1 /= BS.index bs i2) $ do { modify' (+ 1)}; GM.write vec i1 =<< get}) (G.tail perm) perm; (nClasses,) <$> G.unsafeFreeze vec}};sortCyclicShifts' :: Int -> Int -> Int -> U.Vector Int -> U.Vector Int -> U.Vector Int;sortCyclicShifts' n len nClasses classes perm | len >= n = perm | otherwise = le...
ジャッジ結果
| セット名 |
Sample |
All |
| 得点 / 配点 |
0 / 0 |
100 / 100 |
| 結果 |
|
|
| セット名 |
テストケース |
| Sample |
example_00, example_01, example_02, example_03 |
| All |
all_same_00, all_same_01, all_same_02, all_same_03, all_same_04, example_00, example_01, example_02, example_03, fib_str_00, fib_str_01, fib_str_02, fib_str_03, fib_str_04, max_random_00, max_random_01, max_random_02, max_random_03, max_random_04, random_00, random_01, random_02, random_03, random_04 |
| ケース名 |
結果 |
実行時間 |
メモリ |
| all_same_00 |
AC |
112 ms |
40644 KiB |
| all_same_01 |
AC |
111 ms |
33208 KiB |
| all_same_02 |
AC |
111 ms |
33300 KiB |
| all_same_03 |
AC |
111 ms |
33200 KiB |
| all_same_04 |
AC |
121 ms |
40652 KiB |
| example_00 |
AC |
1 ms |
7184 KiB |
| example_01 |
AC |
1 ms |
7220 KiB |
| example_02 |
AC |
1 ms |
6948 KiB |
| example_03 |
AC |
1 ms |
6948 KiB |
| fib_str_00 |
AC |
192 ms |
48796 KiB |
| fib_str_01 |
AC |
141 ms |
29640 KiB |
| fib_str_02 |
AC |
142 ms |
38992 KiB |
| fib_str_03 |
AC |
131 ms |
37908 KiB |
| fib_str_04 |
AC |
181 ms |
37040 KiB |
| max_random_00 |
AC |
282 ms |
43656 KiB |
| max_random_01 |
AC |
282 ms |
43696 KiB |
| max_random_02 |
AC |
282 ms |
43884 KiB |
| max_random_03 |
AC |
282 ms |
43720 KiB |
| max_random_04 |
AC |
282 ms |
43700 KiB |
| random_00 |
AC |
211 ms |
34032 KiB |
| random_01 |
AC |
252 ms |
42740 KiB |
| random_02 |
AC |
21 ms |
15184 KiB |
| random_03 |
AC |
232 ms |
41684 KiB |
| random_04 |
AC |
151 ms |
33044 KiB |