Submission #73564105
Source Code Expand
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds -Wno-orphans -Wno-x-partial -Wno-unrecognised-warning-flags #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative (liftA2, liftA3)
import Control.Arrow (first, second, (***), (&&&))
import Control.Monad (forM, forM_, (>=>), (<=<), void, join, filterM, zipWithM, zipWithM_, foldM, foldM_, replicateM, replicateM_, guard, when, unless)
import Control.Monad.Extra (maybeM, fromMaybeM, eitherM, partitionM, concatMapM, mapMaybeM, whenM, unlessM, orM, andM, anyM, allM)
import Control.Monad.State.Lazy (MonadState, get, put, state, modify, modify', gets, State, runState, evalState, execState, mapState, withState, StateT (StateT), runStateT, evalStateT, execStateT, mapStateT, withStateT)
import Data.Biapplicative (Biapplicative, biliftA2, biliftA3)
import Data.Bifunctor (bimap)
import Data.Bits (Bits, bit, zeroBits, testBit, setBit, clearBit, complement, (.&.), (.|.), (.>>.), (.<<.), (.^.), popCount, FiniteBits, finiteBitSize, countLeadingZeros, countTrailingZeros)
import Data.Bool (bool)
import Data.Bool.HT (implies)
import Data.Char (isSpace, isLower, isUpper, isAlpha, isAlphaNum, isDigit, toLower, toUpper, digitToInt, intToDigit, ord, chr)
import Data.Containers.ListUtils (nubOrd, nubInt)
import Data.Either (lefts, rights, isLeft, isRight, fromLeft, fromRight, partitionEithers)
import Data.Either.Extra (eitherToMaybe, maybeToEither, mapLeft, mapRight)
import Data.Foldable (foldl', toList, traverse_, for_, sequenceA_, find)
import Data.Function (on, (&))
import Data.Functor ((<$), ($>))
import Data.Functor.Classes (Eq1, liftEq, eq1, Ord1, liftCompare, compare1, Eq2, liftEq2, eq2, Ord2, liftCompare2, compare2)
import Data.Graph (Graph, Edge, Vertex, Bounds, buildG, vertices, edges, transposeG, dfs, dff, topSort, reverseTopSort, components, scc, bcc)
import Data.Ix (Ix, range, index, inRange, rangeSize)
import Data.List (uncons, unsnoc, singleton, intersperse, intercalate, transpose, subsequences, permutations, scanl', unfoldr, stripPrefix, group, inits, tails, isPrefixOf, isSuffixOf, isInfixOf, isSubsequenceOf, partition, elemIndex, elemIndices, findIndex, findIndices, delete, (\\), union, intersect, sort, sortOn, groupBy, sortBy, maximumBy, minimumBy)
import Data.List.Extra (dropEnd, takeEnd, splitAtEnd, spanEnd, dropWhileEnd, takeWhileEnd, chunksOf, notNull, maximumOn, minimumOn, allSame, anySame, groupOn, replace, merge, mergeBy, repeatedly)
import Data.List.HT (takeUntil, search)
import Data.List.Index (indexed, deleteAt, setAt, modifyAt, updateAt, insertAt, imap, imapM, imapM_, ifoldr, ifoldl, ifoldl', iall, iany, iconcatMap, ifilter, ipartition, itakeWhile, idropWhile, izipWith, izipWithM, izipWithM_, izipWith3, izipWith4, itraverse, itraverse_, ireplicateM, ireplicateM_, ifoldrM, ifoldlM, ifoldMap, imapAccumR, imapAccumL)
import Data.List.Split (splitOn, splitWhen, splitPlaces, splitPlacesBlanks)
import Data.Maybe (isJust, isNothing, fromJust, fromMaybe, listToMaybe, maybeToList, catMaybes, mapMaybe)
import Data.Ord (comparing, clamp, Down (Down, getDown))
import Data.Ratio (Ratio, (%), numerator, denominator)
import Data.Semigroup (stimes, Sum (Sum, getSum), Product (Product, getProduct), Min (Min, getMin), Max (Max, getMax), Arg (Arg), ArgMin, ArgMax)
import Data.Traversable (mapAccumL, mapAccumR, mapAccumM)
import Data.Tree (Tree (Node, rootLabel, subForest), Forest, flatten, foldTree, unfoldTree, unfoldForest, unfoldTreeM, unfoldForestM, levels)
import Data.Tuple (swap)
import Data.Tuple.Extra (both, dupe, fst3, snd3, thd3, uncurry3, first3, second3, third3)
import Data.Tuple.HT (mapPair)
import Numeric (showBin, showInt, showHex)
import System.IO (hFlush, stdout)
import qualified Data.Array.IArray as A
import qualified Data.Array.Unboxed as AU
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Builder as BB
import qualified Data.Heap as H
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Sequence as SQ
import qualified Data.Vector.Generic as VG
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Algorithms.Intro as VAI
import qualified Data.Vector.Split as VS
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed.Mutable as VUM
-- A
main :: IO ()
main = do
[_n, m] <- getLineIO
[s, t] <- getLineIO
pvs <- getLinesIO m
putLineIO $ solve s t pvs
solve :: Int -> Int -> VU.Vector (Int, Int) -> Int
solve s t = VG.sum . VG.map snd . VG.filter (isBetween s t . fst)
-- graph
type Graph' = Vertex -> [Vertex]
buildGV :: VG.Vector v Edge => Bounds -> v Edge -> Graph
buildGV = (. VG.toList) . buildG
symmetrizeEdges :: [Edge] -> [Edge]
symmetrizeEdges = (++) =<< (swap <$>)
buildUndirectedG :: Bounds -> [Edge] -> Graph
buildUndirectedG = (. symmetrizeEdges) . buildG
buildUndirectedGV :: VG.Vector v Edge => Bounds -> v Edge -> Graph
buildUndirectedGV = (. VG.toList) . buildUndirectedG
type Weight = Int
type WeightedEdge = LabelledEdge Weight
type WeightedGraph = LabelledGraph Weight
type WeightedGraph' = LabelledGraph' Weight
buildWG :: Bounds -> [WeightedEdge] -> WeightedGraph
buildWG = buildLG
buildWGV :: VG.Vector v WeightedEdge =>
Bounds -> v WeightedEdge -> WeightedGraph
buildWGV = buildLGV
buildUndirectedWG :: Bounds -> [WeightedEdge] -> WeightedGraph
buildUndirectedWG = buildUndirectedLG
buildUndirectedWGV :: VG.Vector v WeightedEdge =>
Bounds -> v WeightedEdge -> WeightedGraph
buildUndirectedWGV = buildUndirectedLGV
type LabelledEdge a = (Vertex, Vertex, a)
type LabelledGraph a = A.Array Vertex [(Vertex, a)]
type LabelledGraph' a = Vertex -> [(Vertex, a)]
buildLG :: Bounds -> [LabelledEdge a] -> LabelledGraph a
buildLG bnds uvxs = A.accumArray (flip (:)) [] bnds $ (\(!u, !v, !x) -> (u, (v, x))) <$> uvxs
buildLGV :: VG.Vector v (LabelledEdge a) =>
Bounds -> v (LabelledEdge a) -> LabelledGraph a
buildLGV = (. VG.toList) . buildLG
symmetrizeLabelledEdges :: [LabelledEdge a] -> [LabelledEdge a]
symmetrizeLabelledEdges uvxs = foldl' (flip ((:) . (\(!u, !v, !x) -> (v, u, x)))) uvxs uvxs
buildUndirectedLG :: Bounds -> [LabelledEdge a] -> LabelledGraph a
buildUndirectedLG = (. symmetrizeLabelledEdges) . buildLG
buildUndirectedLGV :: VG.Vector v (LabelledEdge a) =>
Bounds -> v (LabelledEdge a) -> LabelledGraph a
buildUndirectedLGV = (. VG.toList) . buildUndirectedLG
transposeLG :: LabelledGraph a -> LabelledGraph a
transposeLG g = g'
where
f !u0 vws0 = (\(!v0, !w0) -> (v0, u0, w0)) <$> vws0
es = uncurry f =<< A.assocs g
g' = buildLG (A.bounds g) es
type AdjacencyMatrix = AU.UArray Edge Weight
adjacencyMatrixFromEdges :: Bounds -> [Edge] -> AdjacencyMatrix
-- supposes there is no multiple edges.
adjacencyMatrixFromEdges (v0, v1) es = ews
where
ews = A.accumArray min maxBound ((v0, v0), (v1, v1)) $
[ ((v, v), 0) | v <- [v0 .. v1] ] ++
((\(!u, !v) -> ((u, v), 1)) <$> es)
undirectedAdjacencyMatrixFromEdges :: Bounds -> [Edge] -> AdjacencyMatrix
-- supposes there is no multiple edges.
undirectedAdjacencyMatrixFromEdges bnds = adjacencyMatrixFromEdges bnds . symmetrizeEdges
adjacencyMatrixFromWeightedEdges :: Bounds -> [WeightedEdge] -> AdjacencyMatrix
-- supposes there is no multiple edges.
adjacencyMatrixFromWeightedEdges (v0, v1) wes = ews
where
ews = A.accumArray min maxBound ((v0, v0), (v1, v1)) $
[ ((v, v), 0) | v <- [v0 .. v1] ] ++
((\(!u, !v, !w) -> ((u, v), w)) <$> wes)
undirectedAdjacencyMatrixFromWeightedEdges :: Bounds -> [WeightedEdge] -> AdjacencyMatrix
-- supposes there is no multiple edges.
undirectedAdjacencyMatrixFromWeightedEdges bnds = adjacencyMatrixFromWeightedEdges bnds . symmetrizeLabelledEdges
decomposedGraphs :: Graph -> (Int, A.Array Vertex (Int, Vertex), A.Array Int (Int, AU.UArray Vertex Vertex, Graph))
-- decompose a graph into its connected components.
-- the result is:
-- * k: the number of components,
-- * vijs: the mapping from original vertex to (index of its component, vertex in the component),
-- * iljvsgs: array of components which consist of the triple:
-- * l: the number of vertices in the component,
-- * jvs: the mapping from vertex in the component to the original vertex, and
-- * g: the induced subgraph, whose bounds is (1, l) and vertices are renumbered as 1 .. l.
decomposedGraphs g = (k, vijs, iljvsgs)
where
bnds = A.bounds g
vss = components g
(k, _vis, ivss) = groupDictionary bnds $ flatten <$> vss
ibnds = A.bounds ivss
(ls, jvss, vijss) = unzip3 $ f0 <$> range ibnds
where
f0 !i0 = (l0, jvs0, vijs0)
where
vs0 = ivss A.! i0
l0 = length vs0
jvs0 = A.listArray (1, l0) vs0 :: AU.UArray Vertex Vertex
vijs0 = zip vs0 $ (i0, ) <$> [1 .. l0]
ils = A.listArray ibnds ls :: AU.UArray Int Int
ijvss = A.listArray ibnds jvss :: A.Array Int (AU.UArray Vertex Vertex)
vijs = A.accumArray (const id) (0, 0) bnds $ concat vijss :: A.Array Vertex (Int, Vertex)
ijjs = bundleArray ibnds $ f0 =<< range bnds
where
f0 !u0 = f00 <$> vs0
where
vs0 = g A.! u0
(i0, ju0) = vijs A.! u0
f00 !v00 = (i0, (ju0, jv00))
where
(_i00, jv00) = vijs A.! v00 -- i00 should be i0
iljvsgs = imapArray f0 ijjs
where
f0 !i0 !jjs0 = (ils A.! i0, ijvss A.! i0, buildG (1, ils A.! i0) jjs0)
quotientGraph :: Graph -> [[Vertex]] ->
(Int, A.Array Vertex [Vertex], AU.UArray Vertex Vertex, Graph)
-- supposes the union of vss is the vertex set of g, vss is disjoint and length of vss is k.
quotientGraph g vss = (k, ivss, vis, g')
where
(k, vis, ivss) = groupDictionary (A.bounds g) vss
f (!u0, vs0) = (i0, js0)
where
i0 = vis A.! u0
js0 = IS.delete i0 $ IS.fromList $ (vis A.!) <$> vs0
g' = A.amap IS.toList $
A.accumArray IS.union IS.empty (1, k) $ f <$> A.assocs g
-- tree
isSingletonTree :: Tree a -> Bool
isSingletonTree = null . subForest
fromTreeWithA :: (A.IArray a e', Ix i) => (e -> e') -> (i, i) -> Tree (i, e) -> a i e'
fromTreeWithA f bnds = A.array bnds . (second f <$>) . flatten
fromTreeA :: (A.IArray a e, Ix i) => (i, i) -> Tree (i, e) -> a i e
fromTreeA = fromTreeWithA id
fromForestWithA :: (A.IArray a e', Ix i) => (e -> e') -> (i, i) -> Forest (i, e) -> a i e'
fromForestWithA f bnds = A.array bnds . (second f <$>) . (flatten =<<)
fromForestA :: (A.IArray a e, Ix i) => (i, i) -> Forest (i, e) -> a i e
fromForestA = fromForestWithA id
fromGraphT :: Graph -> Vertex -> Tree Vertex
-- supposes the graph is indeed a tree.
-- although it doesn’t have to be undirected,
-- there should be all edges from each parent to its children.
fromGraphT g v0 = vs
where
vs = unfoldTree (stepFromGraphT g) (v0, v0)
stepFromGraphT :: Graph -> (Vertex, Vertex) -> (Vertex, [(Vertex, Vertex)])
stepFromGraphT g (!u, !v) = (v, (v, ) <$> vs1)
where
vs1 = filter (/= u) $ g A.! v
fromGraphWithT :: Graph -> (Vertex -> a -> Vertex -> a) ->
Vertex -> a -> Tree (Vertex, a)
-- supposes the graph is indeed a tree.
-- although it doesn’t have to be undirected,
-- there should be all edges from each parent to its children.
fromGraphWithT g f !v0 !x0 = unfoldTree (stepfromGraphWithT g f) (v0, v0, x0)
stepfromGraphWithT :: Graph -> (Vertex -> a -> Vertex -> a) ->
(Vertex, Vertex, a) -> ((Vertex, a), [(Vertex, Vertex, a)])
stepfromGraphWithT g f (!p, !u, !x) = ((u, x), uvxs)
where
vs = g A.! u
uvxs = [ (u, v0, x0) |
v0 <- vs, v0 /= p,
let x0 = f u x v0 ]
fromLabelledGraphT :: LabelledGraph a -> Vertex -> a -> Tree (Vertex, a)
fromLabelledGraphT g v0 x0 = vxs
where
vxs = unfoldTree (stepFromLabelledGraphT g) (v0, (v0, x0))
stepFromLabelledGraphT :: LabelledGraph a -> (Vertex, (Vertex, a)) -> ((Vertex, a), [(Vertex, (Vertex, a))])
stepFromLabelledGraphT g (!u, (!v, !x)) = ((v, x), (v, ) <$> vxs1)
where
vxs1 = filter ((/= u) . fst) $ g A.! v
fromLabelledGraphWithT :: LabelledGraph a -> (Vertex -> a -> b -> Vertex -> a -> b) ->
Vertex -> a -> b -> Tree (Vertex, b)
-- supposes the graph is indeed a tree.
-- although it doesn’t have to be undirected,
-- there should be all edges from each parent to its children.
fromLabelledGraphWithT g f !v0 !x0 !y0 = unfoldTree (stepfromLabelledGraphWithT g f) (v0, v0, x0, y0)
stepfromLabelledGraphWithT :: LabelledGraph a -> (Vertex -> a -> b -> Vertex -> a -> b) ->
(Vertex, Vertex, a, b) -> ((Vertex, b), [(Vertex, Vertex, a, b)])
stepfromLabelledGraphWithT g f (!p, !u, !x, !y) = ((u, y), uvxys)
where
vxs = g A.! u
uvxys = [ (u, v0, x0, y0) |
(v0, x0) <- vxs, v0 /= p,
let y0 = f u x y v0 x0 ]
foldTreeM :: Monad m => (a -> [b] -> m b) -> Tree a -> m b
foldTreeM f = foldTree g
where
g x mys = f x =<< sequence mys
scanTree :: (a -> [b] -> b) -> Tree a -> Tree b
-- scan from leaves to root.
scanTree f = foldTree $ liftStepForScanTree f
liftStepForScanTree :: (a -> [b] -> b) -> a -> [Tree b] -> Tree b
-- make a step function for scanTree from the one for foldTree.
liftStepForScanTree f !x0 yss = Node y0 yss
where
!y0 = f x0 $ rootLabel <$> yss
zipScanTree :: (a -> [b] -> b) -> Tree a -> Tree (a, b)
-- paired with the original nodes.
zipScanTree f = scanTree g
where
g x xys = (x, f x $ snd <$> xys)
scanTreeM :: Monad m => (a -> [b] -> m b) -> Tree a -> m (Tree b)
scanTreeM = foldTreeM . liftStepForScanTreeM
liftStepForScanTreeM :: Monad m => (a -> [b] -> m b) -> a -> [Tree b] -> m (Tree b)
-- make a step function for scanTreeM from the one for foldTreeM.
liftStepForScanTreeM f !x0 yss = (`Node` yss) <$> my0
where
!my0 = f x0 $ rootLabel <$> yss
accumTree :: (b -> a -> b) -> b -> Tree a -> Tree b
-- scan from root to leaves.
accumTree f y0 xs = ys
where
ys = unfoldTree (liftStepForAccumTree f) (y0, xs)
liftStepForAccumTree :: (b -> a -> b) -> (b, Tree a) -> (b, [(b, Tree a)])
-- make a step function for accumTree from that with foldl style.
liftStepForAccumTree f (!y, Node x xss) = (y', (y', ) <$> xss)
where
y' = f y x
accumTree1 :: (b -> a -> b) -> (a -> b) -> Tree a -> Tree b
-- use a special function for the root node.
accumTree1 f f0 (Node x ts) = Node y1 $ accumTree f y1 <$> ts
where
y1 = f0 x
zipAccumTree :: (b -> a -> b) -> b -> Tree a -> Tree (a, b)
-- paired with the original nodes.
zipAccumTree f y0 = zipAccumTree1 f (f y0)
zipAccumTree1 :: (b -> a -> b) -> (a -> b) -> Tree a -> Tree (a, b)
-- paired with the original nodes.
zipAccumTree1 f f0 = accumTree1 g g0
where
g (_, y) x = (x, f y x)
g0 x = (x, f0 x)
fuseTree :: (b -> (a, [b])) -> (a -> [c] -> c) -> b -> c
-- fuses (foldTree stepf . unfoldTree stepu) sequence (hylomorphism).
-- avoids creating (and discarding) an intermediate tree of Tree a.
fuseTree stepu stepf = go
where
go y0 = z0
where
(x0, ys0) = stepu y0
zs0 = go <$> ys0
z0 = stepf x0 zs0
fuseForest :: (b -> (a, [b])) -> (a -> [c] -> c) -> [b] -> [c]
fuseForest stepu stepf = (fuseTree stepu stepf <$>)
rerootScanTree :: Monoid m => (Vertex -> (Vertex, m) -> m) ->
Tree Vertex -> Tree (Vertex, m)
-- f makes the ‘next’ value. more precisely,
-- f u (v, x) is the ‘next’ value of x on vertex v when proceeding to vertex u.
-- in the first scanning (that is, from leaves to the root), u is the parent of v,
-- but in the rerooting process, u is a child of v.
rerootScanTree f vs = vxs
where
v0 = rootLabel vs
step0 !u0 vxs0 = (u0, x0')
where
xs0' = f u0 <$> vxs0
x0' = mconcat xs0'
vxstemp = scanTree step0 vs
vxs = unfoldTree (stepReroot f v0) ((v0, mempty), vxstemp) -- (v0, mempty) is a dummy
-- vxs is essentially a result of foldTree -> unfoldTree (metamorphism on Tree)
stepReroot :: Monoid m => (Vertex -> (Vertex, m) -> m) -> Vertex ->
((Vertex, m), Tree (Vertex, m)) -> ((Vertex, m), [((Vertex, m), Tree (Vertex, m))])
stepReroot f !v0 ((!u, px), Node (!v, x) vxss) = ((v, x'), vxvxss)
-- note that x is the folded value in the first scanning (from leaves to the root)
where
px' | v == v0 = mempty -- (u, px) is a dummy and discarded
| otherwise = f v (u, px)
x' = px' <> x -- this is written as the value of this node, which x *affects*.
vxs = rootLabel <$> vxss
xs' = f v <$> vxs
xaccls = scanl' (<>) mempty xs' -- accumulations from left
xaccrs = tail $ scanr (<>) mempty xs' -- accumulations from right
xaccstemp = zipWith (<>) xaccls xaccrs -- accumulations excluding each element
-- xaccsTemp is essentially a result of foldr -> unfoldr (metamorphism on List)
xaccs = (px' <>) <$> xaccstemp -- note that x does *not* affect these values passed to the children
vxvxss = zip ((v, ) <$> xaccs) vxss
-- byte string
fromVectorWithB :: VG.Vector v a => (a -> Char) -> v a -> B.ByteString
fromVectorWithB f xs = s
where
n = VG.length xs
(s, _) = B.unfoldrN n ((first f <$>) . VG.uncons) xs
fromVectorB :: VG.Vector v Char => v Char -> B.ByteString
fromVectorB = fromVectorWithB id
generateB :: Int -> (Int -> Char) -> B.ByteString
generateB n f = fst $ B.unfoldrN n step0 0
where
step0 !i0 = Just (f i0, i0 + 1)
generate2B :: Int -> (Int -> Int) -> (Int -> Int -> Char) -> V.Vector B.ByteString
generate2B !h fiw f = VG.generate h g
where
g !i0 = generateB (fiw i0) (f i0)
imapB :: (Int -> Char -> a) -> B.ByteString -> [a]
imapB f s = unfoldr step0 (0, s)
where
step0 (!i0, s0) = case B.uncons s0 of
Nothing -> Nothing
Just (!c0, s0') -> Just (f i0 c0, (i0 + 1, s0'))
mapMaybeB :: (Char -> Maybe a) -> B.ByteString -> [a]
mapMaybeB f = go
where
go s0 = case B.uncons s0 of
Nothing -> []
Just (!c0, s0') -> case f c0 of
Nothing -> go s0'
Just x0 -> x0 : go s0'
mapMaybeBV :: VG.Vector v a => (Char -> Maybe a) -> B.ByteString -> v a
mapMaybeBV = VG.fromList .: mapMaybeB
imapMaybeB :: (Int -> Char -> Maybe a) -> B.ByteString -> [a]
imapMaybeB f = go 0
where
go !i0 s0 = case B.uncons s0 of
Nothing -> []
Just (!c0, s0') -> case f i0 c0 of
Nothing -> go i0' s0'
Just x0 -> x0 : go i0' s0'
where
i0' = i0 + 1
sliceB :: Int -> Int -> B.ByteString -> B.ByteString
sliceB !i !n = B.take n . B.drop i
sliceFromToB :: Int -> Int -> B.ByteString -> B.ByteString
-- supposes l < r. note that [l, r) is a closed-open interval.
sliceFromToB !l !r = sliceB l (r - l)
splitPlacesB :: [Int] -> B.ByteString -> [B.ByteString]
splitPlacesB ls s = ss
where
step0 ([], _) = Nothing
step0 (l0 : ls0, s0)
| B.null s0 = Nothing
| otherwise = Just (s1, (ls0, s0'))
where
(s1, s0') = B.splitAt l0 s0
ss = unfoldr step0 (ls, s)
splitPlacesBlanksB :: [Int] -> B.ByteString -> [B.ByteString]
splitPlacesBlanksB ls s = ss
where
step0 ([], _) = Nothing
step0 (l0 : ls0, s0) = Just (s1, (ls0, s0'))
where
(s1, s0') = B.splitAt l0 s0
ss = unfoldr step0 (ls, s)
-- vector
safeV :: VG.Vector v a => (v a -> b) -> v a -> Maybe b
safeV = mapNothingIf VG.null
fromByteStringWithV :: VG.Vector v a => (Char -> a) -> B.ByteString -> v a
fromByteStringWithV f s = VG.generate (B.length s) (f . B.index s)
fromByteStringV :: B.ByteString -> VU.Vector Char
fromByteStringV = fromByteStringWithV id
fromOrdsBV :: Char -> B.ByteString -> VU.Vector Int
fromOrdsBV !c = fromByteStringWithV $ subtract (ord c) . ord
fromDigitsBV :: B.ByteString -> VU.Vector Int
fromDigitsBV = fromByteStringWithV digitToInt
fromCharMaskBV :: Char -> B.ByteString -> VU.Vector Bool
fromCharMaskBV !c = fromByteStringWithV (== c)
fromCharMaskDeltaBV :: Char -> B.ByteString -> VU.Vector Int
fromCharMaskDeltaBV !c = fromByteStringWithV $ delta . (== c)
fixVector :: VG.Vector v a => Int -> ((Int -> a) -> Int -> a) -> v a
-- construct a vector recursively from left (i == 0) to right (i == n - 1).
fixVector !n f = xs
where
xs = VG.constructN n f0
where
f0 xs0 = f (xs0 VG.!) l0
where
!l0 = VG.length xs0
fixVectorR :: VG.Vector v a => Int -> ((Int -> a) -> Int -> a) -> v a
-- construct a vector recursively from right (i == n - 1) to left (i == 0).
fixVectorR !n f = xs
where
xs = VG.constructrN n f0
where
f0 xs0 = f (\i0 -> xs0 VG.! (i0 - (n - l0))) (n - 1 - l0)
where
!l0 = VG.length xs0
allSameV :: (Eq a, VG.Vector v a) => v a -> Bool
allSameV xs = case VG.uncons xs of
Nothing -> True
Just (x0, xs') -> VG.all (== x0) xs'
accumVector :: VG.Vector v a => (a -> b -> a) -> a -> Int -> [(Int, b)] -> v a
-- similar interface to the array’s counterpart.
accumVector f x0 n = VG.accum f $ VG.replicate n x0
accumulateVector :: (VG.Vector v a, VG.Vector v (Int, b)) =>
(a -> b -> a) -> a -> Int -> v (Int, b) -> v a
accumulateVector f x0 n = VG.accumulate f $ VG.replicate n x0
concatMapV :: (VG.Vector v a, VG.Vector w b) =>
(a -> w b) -> v a -> w b
-- more generic (but probably slower) than VG.concatMap.
concatMapV f = VG.concat . (f <$>) . VG.toList
iconcatMapV :: (VG.Vector v a, VG.Vector w b) =>
(Int -> a -> w b) -> v a -> w b
iconcatMapV f = VG.concat . imap f . VG.toList
concatMapMaybeV :: (VG.Vector v a, VG.Vector w b) =>
(a -> Maybe (w b)) -> v a -> w b
concatMapMaybeV f = VG.concat . mapMaybe f . VG.toList
adjacentWithV :: (VG.Vector v a, VG.Vector v b) =>
(a -> a -> b) -> v a -> v b
adjacentWithV f xs = case VG.uncons xs of
Nothing -> VG.empty
Just (_, xs') -> VG.zipWith f xs xs'
adjacentPairsV :: (VG.Vector v a, VG.Vector v (a, a)) =>
v a -> v (a, a)
adjacentPairsV = adjacentWithV (,)
iadjacentWithV :: (VG.Vector v a, VG.Vector v b) =>
(Int -> a -> a -> b) -> v a -> v b
iadjacentWithV f xs = case VG.uncons xs of
Nothing -> VG.empty
Just (_, xs') -> VG.izipWith f xs xs'
adjacentWithMaybeV :: (VG.Vector v a, VG.Vector v b) =>
(a -> a -> Maybe b) -> v a -> v b
adjacentWithMaybeV f xs = case VG.uncons xs of
Nothing -> VG.empty
Just (_, xs') -> zipWithMaybeV f xs xs'
concatAdjacentWithV :: (VG.Vector v a, VG.Vector v (a, a), VG.Vector v b) =>
(a -> a -> v b) -> v a -> v b
concatAdjacentWithV f xs = case VG.uncons xs of
Nothing -> VG.empty
Just (_, xs') -> concatZipWithV f xs xs'
adjacentWith3V :: (VG.Vector v a, VG.Vector v b) =>
(a -> a -> a -> b) -> v a -> v b
adjacentWith3V f xs = fromMaybe VG.empty $ do
(_, xs') <- VG.uncons xs
(_, xs'') <- VG.uncons xs'
return $ VG.zipWith3 f xs xs' xs''
adjacentTriplesV :: (VG.Vector v a, VG.Vector v (a, a, a)) =>
v a -> v (a, a, a)
adjacentTriplesV = adjacentWith3V (,,)
zipWithMaybeV :: (VG.Vector v a, VG.Vector v b, VG.Vector v c) =>
(a -> b -> Maybe c) -> v a -> v b -> v c
zipWithMaybeV f xs ys = VG.unfoldr step0 (xs, ys)
where
step0 (xs0, ys0) = do
(x0, xs0') <- VG.uncons xs0
(y0, ys0') <- VG.uncons ys0
case f x0 y0 of
Nothing -> step0 (xs0', ys0')
Just z0 -> Just (z0, (xs0', ys0'))
izipWithMaybeV :: (VG.Vector v a, VG.Vector v b, VG.Vector v c) =>
(Int -> a -> b -> Maybe c) -> v a -> v b -> v c
izipWithMaybeV f xs ys = VG.unfoldr step0 (0, xs, ys)
where
step0 (!i0, xs0, ys0) = do
(x0, xs0') <- VG.uncons xs0
(y0, ys0') <- VG.uncons ys0
case f i0 x0 y0 of
Nothing -> step0 (i0', xs0', ys0')
Just z0 -> Just (z0, (i0', xs0', ys0'))
where
i0' = i0 + 1
concatZipWithV :: (VG.Vector v a, VG.Vector v b, VG.Vector v (a, b), VG.Vector w c) =>
(a -> b -> w c) -> v a -> v b -> w c
concatZipWithV f = concatMapV (uncurry f) .: VG.zip
orderedPairWithV :: (VG.Vector v a, VG.Vector v b) =>
(a -> a -> b) -> v a -> v b
orderedPairWithV f = VG.concat . unfoldr step0
where
step0 xs0 = case VG.uncons xs0 of
Nothing -> Nothing
Just (x0, xs0') -> Just (ys0, xs0')
where
ys0 = VG.map (f x0) xs0'
orderedPairsV :: (VG.Vector v a, VG.Vector v (a, a)) =>
v a -> v (a, a)
orderedPairsV = orderedPairWithV (,)
orderedPairWithMaybeV :: (VG.Vector v a, VG.Vector v b) =>
(a -> a -> Maybe b) -> v a -> v b
orderedPairWithMaybeV f = VG.concat . unfoldr step0
where
step0 xs0 = do
(x0, xs0') <- VG.uncons xs0
Just (VG.mapMaybe (f x0) xs0', xs0')
sequentialPairWithV :: (VG.Vector v a, VG.Vector v b) =>
(a -> a -> b) -> v a -> v b
sequentialPairWithV f = VG.unfoldr step0
where
step0 xs0 = do
(x0, xs0') <- VG.uncons xs0
(x0', xs0'') <- VG.uncons xs0'
return (f x0 x0', xs0'')
sequentialPairsV :: (VG.Vector v a, VG.Vector v (a, a)) =>
v a -> v (a, a)
sequentialPairsV = sequentialPairWithV (,)
sequentialPairWith1V :: VG.Vector v a =>
(a -> a -> a) -> v a -> v a
sequentialPairWith1V f = VG.unfoldr step0
where
step0 xs0 = do
(x0, xs0') <- VG.uncons xs0
return $ case VG.uncons xs0' of
Nothing -> (x0, VG.empty)
Just (x0', xs0'') -> (f x0 x0', xs0'')
sequentialPairWithMaybeV :: (VG.Vector v a, VG.Vector v b) =>
(a -> a -> Maybe b) -> v a -> v b
sequentialPairWithMaybeV f = VG.unfoldr step0
where
step0 xs0 = do
(x0, xs0') <- VG.uncons xs0
(x0', xs0'') <- VG.uncons xs0'
case f x0 x0' of
Nothing -> step0 xs0''
Just y0 -> Just (y0, xs0'')
liftA2V :: (VG.Vector v a, VG.Vector v b, VG.Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
liftA2V f xs ys = zs
where
g x = VG.map (f x) ys
zs = VG.concatMap g xs
liftA2MaybeV :: (VG.Vector v a, VG.Vector v b, VG.Vector v c) =>
(a -> b -> Maybe c) -> v a -> v b -> v c
liftA2MaybeV f xs ys = zs
where
g x = VG.mapMaybe (f x) ys
zs = VG.concatMap g xs
sortByV :: VG.Vector v a =>
(a -> a -> Ordering) -> v a -> v a
sortByV comp = VG.modify (VAI.sortBy comp)
sortOnV :: (VG.Vector v a, Ord b) =>
(a -> b) -> v a -> v a
sortOnV f = sortByV (compare `on` f)
sortV :: (Ord a, VG.Vector v a) =>
v a -> v a
sortV = sortOnV id
uniqSortByV :: (Eq a, VG.Vector v a) =>
(a -> a -> Ordering) -> v a -> v a
uniqSortByV = VG.uniq .: sortByV
uniqSortOnV :: (Eq a, VG.Vector v a, Ord b) =>
(a -> b) -> v a -> v a
-- supposes f preserves equality.
uniqSortOnV = VG.uniq .: sortOnV
uniqSortV :: (Ord a, VG.Vector v a) => v a -> v a
uniqSortV = VG.uniq . sortV
partialSortByV :: VG.Vector v a => (a -> a -> Ordering) -> Int -> v a -> v a
partialSortByV comp k = VG.modify (\mv -> VAI.partialSortBy comp mv k)
partialSortOnV :: (VG.Vector v a, Ord b) => (a -> b) -> Int -> v a -> v a
partialSortOnV f = partialSortByV (compare `on` f)
partialSortV :: (Ord a, VG.Vector v a) => Int -> v a -> v a
partialSortV = partialSortOnV id
indexRV :: VG.Vector v a => v a -> Int -> a
indexRV xs !i = xs VG.! (VG.length xs - 1 - i)
sliceFromToV :: VG.Vector v a => Int -> Int -> v a -> v a
-- supposes l < r. note that [l, r) is a closed-open interval.
sliceFromToV !l !r = VG.slice l (r - l)
spanEndV :: VG.Vector v a => (a -> Bool) -> v a -> (v a, v a)
spanEndV cond xs = (xs1, xs0)
where
(xs0, xs1) = both VG.reverse $ VG.span cond $ VG.reverse xs
takeWhileEndV :: VG.Vector v a => (a -> Bool) -> v a -> v a
takeWhileEndV cond = snd . spanEndV cond
dropWhileEndV :: VG.Vector v a => (a -> Bool) -> v a -> v a
dropWhileEndV cond = fst . spanEndV cond
splitAtEndV :: VG.Vector v a => Int -> v a -> (v a, v a)
splitAtEndV k xs = VG.splitAt (n - k) xs
where
n = VG.length xs
takeEndV :: VG.Vector v a => Int -> v a -> v a
takeEndV = snd .: splitAtEndV
dropEndV :: VG.Vector v a => Int -> v a -> v a
dropEndV = fst .: splitAtEndV
mergeByV :: VG.Vector v a =>
(a -> a -> Ordering) -> v a -> v a -> v a
mergeByV comp xs ys = zs
where
step0 (xs0, ys0) = case VG.uncons xs0 of
Nothing -> case VG.uncons ys0 of
Nothing -> Nothing
Just (y0, ys1) -> Just (y0, (xs0, ys1))
Just (x0, xs1) -> case VG.uncons ys0 of
Nothing -> Just (x0, (xs1, ys0))
Just (y0, ys1)
| x0 `comp` y0 == GT -> Just (y0, (xs0, ys1))
| otherwise -> Just (x0, (xs1, ys0))
zs = VG.unfoldr step0 (xs, ys)
mergeV :: (VG.Vector v a, Ord a) => v a -> v a -> v a
mergeV = mergeByV compare
isSubsequenceOfV :: (Ord a, VG.Vector v a) => v a -> v a -> Bool
-- supposes argument vectors are sorted.
-- note that duplicate elements matters, i.e., this is *not* ‘isSubsetOf’.
isSubsequenceOfV = go
where
go xs0 ys0 = case VG.uncons xs0 of
Nothing -> True
Just (x0, xs0') -> case VG.uncons ys0 of
Nothing -> False
Just (y0, ys0')
| x0 == y0 -> go xs0' ys0'
| x0 >= y0 -> go xs0 ys0'
| otherwise -> False -- x0 < y0
intersectionV :: (Ord a, VG.Vector v a) => v a -> v a -> v a
-- supposes xs and ys are sorted.
intersectionV xs ys = VG.unfoldr step0 (xs, ys)
where
step0 (xs0, ys0) = case VG.uncons xs0 of
Nothing -> Nothing
Just (x0, xs0') -> case VG.uncons ys0 of
Nothing -> Nothing
Just (y0, ys0')
| x0 == y0 -> Just (x0, (xs0', ys0'))
| x0 < y0 -> step0 (xs0', ys0)
| otherwise -> step0 (xs0, ys0') -- x0 > y0
differenceV :: (Ord a, VG.Vector v a) => v a -> v a -> v a
-- supposes xs and ys are sorted.
differenceV xs ys = VG.unfoldr step0 (xs, ys)
where
step0 (xs0, ys0) = case VG.uncons xs0 of
Nothing -> Nothing
Just (x0, xs0') -> case VG.uncons ys0 of
Nothing -> Just (x0, (xs0', ys0)) -- ys0 is null though
Just (y0, ys0')
| x0 == y0 -> step0 (xs0', ys0')
| x0 < y0 -> Just (x0, (xs0', ys0))
| otherwise -> step0 (xs0, ys0') -- x0 > y0
partitionEithersV :: (VG.Vector v (Either a b), VG.Vector v a, VG.Vector v b) =>
v (Either a b) -> (v a, v b)
partitionEithersV = (VG.map (fromLeft undefined) *** VG.map (fromRight undefined)) . VG.partition isLeft
generate2V :: (VG.Vector v a, VG.Vector w (v a)) =>
Int -> (Int -> Int) -> (Int -> Int -> a) -> w (v a)
generate2V n = VG.generate n .: liftA2 VG.generate
map2V :: (VG.Vector v a, VG.Vector w (v a), VG.Vector v b, VG.Vector w (v b)) =>
(a -> b) -> w (v a) -> w (v b)
map2V = VG.map . VG.map
imap2V :: (VG.Vector v a, VG.Vector w (v a), VG.Vector v b, VG.Vector w (v b)) =>
(Int -> Int -> a -> b) -> w (v a) -> w (v b)
imap2V = VG.imap . (VG.imap .)
zipWith2V :: (VG.Vector v a, VG.Vector w (v a), VG.Vector v b, VG.Vector w (v b), VG.Vector v c, VG.Vector w (v c)) =>
(a -> b -> c) -> w (v a) -> w (v b) -> w (v c)
zipWith2V = VG.zipWith . VG.zipWith
izipWith2V :: (VG.Vector v a, VG.Vector w (v a), VG.Vector v b, VG.Vector w (v b), VG.Vector v c, VG.Vector w (v c)) =>
(Int -> Int -> a -> b -> c) -> w (v a) -> w (v b) -> w (v c)
izipWith2V = VG.izipWith . (VG.izipWith .)
sum2V :: (Num a, VG.Vector v a, VG.Vector w (v a), VG.Vector w a) =>
w (v a) -> a
sum2V = VG.sum . VG.map VG.sum
all2V :: (VG.Vector v a, VG.Vector w (v a)) =>
(a -> Bool) -> w (v a) -> Bool
all2V = VG.all . VG.all
any2V :: (VG.Vector v a, VG.Vector w (v a)) =>
(a -> Bool) -> w (v a) -> Bool
any2V = VG.any . VG.any
index2V :: (VG.Vector v a, VG.Vector w (v a)) =>
w (v a) -> Int -> Int -> a
index2V xss !i !j = xss VG.! i VG.! j
accumVector2 :: (VG.Vector v a, VG.Vector w [(Int, b)], VG.Vector w (v a)) =>
(a -> b -> a) -> a -> Int -> (Int -> Int) -> [(Int, (Int, b))] -> w (v a)
accumVector2 f x0 n fim ijys = ijxss
where
ijxss = VG.imap f0 $ bundleIntV n ijys
where
f0 !i0 = accumVector f x0 (fim i0)
accum2V :: (VG.Vector v a, VG.Vector w [(Int, b)], VG.Vector w (v a)) =>
(a -> b -> a) -> w (v a) -> [(Int, (Int, b))] -> w (v a)
accum2V f ijxss ijys = ijxss'
where
ijxss' = VG.imap f0 $ bundleIntV (VG.length ijxss) ijys
where
f0 !i0 = VG.accum f $ ijxss VG.! i0
scanBoundsIntV :: Int -> [((Int, Int), Int)] -> VU.Vector Int
-- supposes for all (l, r) <- lrs (l < r).
-- note that each (l, r) represents a closed-open interval.
scanBoundsIntV n lrxs = ixs
where
idxs = accumVector (+) 0 n $ concat $ mapMaybe f0 lrxs
where
f0 ((!l0, !r0), x0)
| r0 <= 0 || n - 1 < l0 = Nothing
| otherwise = Just $ (max 0 l0, x0) : [ (r0, -x0) | r0 < n ]
ixs = VG.postscanl' (+) 0 idxs
scanBoundsV :: (VG.Vector v e, Group e) =>
Int -> [((Int, Int), e)] -> v e
-- supposes e is commutative and for all (l, r) <- lrs (l < r).
-- note that each (l, r) represents a closed-open interval.
-- note also that the length increases by 1.
-- the result can be applied to sumOfRangeV.
scanBoundsV !n lrxs = ixs
where
idxs = accumVector (<>) mempty n $ concat $ mapMaybe f0 lrxs
where
f0 ((!l0, !r0), x0)
| r0 <= 0 || n - 1 < l0 = Nothing
| otherwise = Just $ (max 0 l0, x0) : [ (r0, invert x0) | r0 < n ]
ixs = accumWithV (<>) mempty idxs
scanBounds2V :: (Group e, VG.Vector v e, VG.Vector w [(Int, e)], VG.Vector w (v e)) =>
Int -> Int -> [(((Int, Int), (Int, Int)), e)] -> w (v e)
-- supposes that for all ((p, q), _) <- pqxs (inRange ((0, 0), (n, m)) p && inRange ((0, 0), (n, m)) q).
-- supposes e is commutative and for all (((il, jl), (ir, jr)), _) <- pqxs (il < ir && jl < jr).
-- note that each ((il, jl), (ir, jr)) represents a left- and top-closed and right- and bottom-open rectangle.
-- note also that the lengths of both dimensions increase by 1.
-- the result can be applied to sumOfRange2V.
scanBounds2V n m pqxs = ijxs
where
ijdxs = accumVector2 (<>) mempty n (const m) $ f0 =<< pqxs
where
f0 (((!il0, !jl0), (!ir0, !jr0)), x0) =
(max 0 il0, (max 0 jl0, x0)) :
[ (il0, (jr0, invert x0)) | jr0 < m ] ++
[ (ir0, (jl0, invert x0)) | ir0 < n ] ++
[ (ir0, (jr0, x0)) | ir0 < n, jr0 < m ]
ijxs = accumWith2V (<>) mempty m ijdxs
diagonalV :: (VG.Vector v a, VG.Vector w (v a)) =>
w (v a) -> v a
-- supposes the argument is a square matrix.
diagonalV xss = VG.generate (VG.length xss) $ join (index2V xss)
initsV :: VG.Vector v a => v a -> [v a]
initsV xs = reverse $ take (succ n) $ iterate VG.init xs
where
n = VG.length xs
tailsV :: VG.Vector v a => v a -> [v a]
tailsV xs = take (succ n) $ iterate VG.tail xs
where
n = VG.length xs
deleteV :: (Eq a, VG.Vector v a) => a -> v a -> v a
deleteV x xs
| VG.null xsr = xs
| otherwise = xsl VG.++ VG.tail xsr
where
(xsl, xsr) = VG.span (/= x) xs
deleteAtV :: VG.Vector v a => Int -> v a -> v a
-- requires 0 <= i < VG.length xs.
deleteAtV = uncurry (VG.++) . second VG.tail .: VG.splitAt
insertAtV :: VG.Vector v a => Int -> a -> v a -> v a
-- requires 0 <= i <= VG.length xs.
insertAtV !i x = uncurry (VG.++) . second (VG.cons x) . VG.splitAt i
swapAtV :: (Eq a, VG.Vector v a) => Int -> Int -> v a -> v a
-- requires 0 <= i < n and 0 <= j < n.
swapAtV !i !j xs
| i == j = xs
| xi == xj = xs
| otherwise = VG.generate n f
where
n = VG.length xs
-- if i /= j ...
xi = xs VG.! i
xj = xs VG.! j
-- if x0 /= x1 ...
f !i0
| i0 == i = xj
| i0 == j = xi
| otherwise = xs VG.! i0
countV :: VG.Vector v a => (a -> Bool) -> v a -> Int
countV = VG.length .: VG.filter
groupOnV :: (VG.Vector v a, Eq b) => (a -> b) -> v a -> [v a]
groupOnV f = VG.groupBy ((==) `on` f)
repeatedlyV :: VG.Vector v a => (v a -> (b, v a)) -> v a -> [b]
repeatedlyV f = unfoldr (Just . f)
chunksOfV :: VG.Vector v a => Int -> v a -> [v a]
chunksOfV !l = takeWhile (not . VG.null) . repeatedlyV (VG.splitAt l)
runLengthsV :: (VG.Vector v a, Eq a) => v a -> [(a, Int)]
runLengthsV = ((VG.head &&& VG.length) <$>) . VG.group
unRunLengthsV :: VG.Vector v a => [(a, Int)] -> v a
unRunLengthsV = VG.concat . (uncurry (flip VG.replicate) <$>)
countsV :: (VG.Vector v a, Ord a) => v a -> [(a, Int)]
countsV = runLengthsV . sortV
interleaveV :: VG.Vector v a => v a -> v a -> v a
interleaveV xsa xsb = VG.unfoldr step0 (xsa, xsb)
where
step0 (xsa0, xsb0) = case VG.uncons xsa0 of
Nothing -> Nothing
Just (x0, xsa0') -> Just (x0, (xsb0, xsa0'))
uninterleaveV :: VG.Vector v a => v a -> (v a, v a)
uninterleaveV xs = (xsa, xsb)
where
n = VG.length xs
xsa = VG.generate (n `divGE` 2) ((xs VG.!) . (2 *))
xsb = VG.generate (n `div` 2) ((xs VG.!) . succ . (2 *))
findBlockV :: (Num a, Ord a, VG.Vector v a) => a -> v a -> Maybe (Int, a)
-- find the block to which x belongs to.
-- x is supposed to be a accumulated value from left (0-based index, length, etc) and
-- ys is supposeed to be a list of block sizes (all y <- ys should be non-negative).
findBlockV = go 0
where
go !i0 !x0 ys0 = case VG.uncons ys0 of
Nothing -> Nothing
Just (y0, ys0')
| x0 < y0 -> Just (i0, x0)
| otherwise -> go (i0 + 1) (x0 - y0) ys0'
bundleV :: (Ord a, Ord b, VG.Vector v (a, b), VG.Vector v b) =>
v (a, b) -> [(a, v b)]
bundleV xys = f <$> groupOnV fst (sortV xys)
where
f xys0 = (fst (VG.head xys0), VG.map snd xys0)
bundleIntV :: VG.Vector v [a] => Int -> [(Int, a)] -> v [a]
bundleIntV = accumVector (flip (:)) []
stableBundleIntV :: VG.Vector v [a] => Int -> [(Int, a)] -> v [a]
stableBundleIntV = (. reverse) . bundleIntV
countsIntV :: (VG.Vector v Int, VG.Vector v (Int, Int)) => Int -> v Int -> v Int
-- requires that for all x in xs (0 <= x <= xmax).
countsIntV xmax xs = xcnts
where
n = xmax + 1
xcnts = accumulateVector (+) 0 n $ VG.map (, 1) xs
indicesOnV :: (VG.Vector v a, VG.Vector v (Int, a), VG.Vector v Int) =>
(v a -> b) -> (b -> a -> Bool) -> v a -> v Int
indicesOnV f cond xs = VG.map fst $ VG.filter (cond y . snd) $ VG.indexed xs
where
y = f xs
transposeV :: (VG.Vector v a, VG.Vector w (v a)) => w (v a) -> w (v a)
-- supposes xss is of ‘rectangular’ form.
transposeV (xss :: w (v a)) = xss'
where
h = VG.length xss
w = VG.length (VG.head xss)
f !j !i = xss VG.! i VG.! j
g !j = VG.generate h (f j)
xss' = VG.generate w g :: w (v a)
rotateLeft2V :: (VG.Vector v a, VG.Vector w (v a)) => w (v a) -> w (v a)
rotateLeft2V = VG.reverse . transposeV
rotateRight2V :: (VG.Vector v a, VG.Vector w (v a)) => w (v a) -> w (v a)
rotateRight2V = VG.map VG.reverse . transposeV
sumsOfLengthV :: VG.Vector v Int => Int -> v Int -> v Int
sumsOfLengthV k xs
| VG.length xs < k = VG.empty
| otherwise = xsums
where
(xs0, xs1) = VG.splitAt k xs
xsum0 = VG.sum xs0
dxs = VG.zipWith subtract xs xs1
xsums = VG.scanl' (+) xsum0 dxs
sumsOfRange2V :: (VG.Vector v Int, VG.Vector w (v Int)) => Int -> Int -> w (v Int) -> w (v Int)
-- supposes xss is in ‘rectangular’ form.
sumsOfRange2V h w xss
| VG.length xss < h = VG.empty
| otherwise = zss
where
yss = VG.map (sumsOfLengthV w) xss
-- note if VG.length >= h but VG.length (VG.head xss) < w,
-- yss would be vector of empty vectors.
(yss0, yss1) = VG.splitAt h yss
ys0 = VG.foldl1 (VG.zipWith (+)) yss0
dyss = VG.zipWith (VG.zipWith subtract) yss yss1
zss = VG.scanl' (VG.zipWith (+)) ys0 dyss
accumWithV :: VG.Vector v a => (a -> a -> a) -> a -> v a -> v a
-- note that the length increases by 1.
accumWithV = VG.scanl'
accumIntV :: VU.Vector Int -> VU.Vector Int
accumIntV = accumWithV (+) 0
unitsV :: VG.Vector v a => a -> Int -> v a
unitsV = flip VG.replicate
accumWith2V :: (VG.Vector v0 a, VG.Vector v1 (v0 a)) =>
(a -> a -> a) -> a -> Int -> v1 (v0 a) -> v1 (v0 a)
-- supposes m is the length of head xss.
-- note that the lengths of both dimensions increase by 1.
accumWith2V f x0 !m = VG.scanl' (VG.zipWith f) (unitsV x0 (m + 1)) . VG.map (accumWithV f x0)
accumInt2V :: Int -> V.Vector (VU.Vector Int) -> V.Vector (VU.Vector Int)
accumInt2V = accumWith2V (+) 0
units2V :: (VG.Vector v0 a, VG.Vector v1 (v0 a)) =>
a -> Int -> Int -> v1 (v0 a)
units2V x0 !n !m = VG.replicate n (unitsV x0 m)
accumWith3V :: (VG.Vector v0 a, VG.Vector v1 (v0 a), VG.Vector v2 (v1 (v0 a))) =>
(a -> a -> a) -> a -> Int -> Int -> v2 (v1 (v0 a)) -> v2 (v1 (v0 a))
-- supposes m is the length of head xsss and l is the length of head (head xsss).
-- note that the lengths of all dimensions increase by 1.
accumWith3V f x0 !m !l = VG.scanl' (VG.zipWith (VG.zipWith f)) (units2V x0 (m + 1) (l + 1)) . VG.map (accumWith2V f x0 l)
accumInt3V :: Int -> Int -> V.Vector (V.Vector (VU.Vector Int)) -> V.Vector (V.Vector (VU.Vector Int))
accumInt3V = accumWith3V (+) 0
sumOfRangeIntV :: VU.Vector Int -> Int -> Int -> Int
-- supposes xaccs is accumIntV of (some) xs, and 1 <= i0, i1 <= length xs.
-- note that the indices are 1-based.
sumOfRangeIntV xaccs !i0 !i1
| i0 > i1 = 0
| otherwise = xaccs VG.! i1 - xaccs VG.! (i0 - 1)
sumOfRangeInt2V :: V.Vector (VU.Vector Int) -> (Int, Int) -> (Int, Int) -> Int
-- supposes xaccss is accumInt2V of (some) xss, and
-- 1 <= i0, i1 <= length xss and
-- 1 <= j0, j1 <= length (head xss).
-- note that the indices are 1-based.
sumOfRangeInt2V xaccss (!i0, !j0) (!i1, !j1)
| i0 > i1 || j0 > j1 = 0
| otherwise = xacc
where
xacc = sumOfRangeIntV (xaccss VG.! i1) j0 j1 -
sumOfRangeIntV (xaccss VG.! (i0 - 1)) j0 j1
sumOfRangeInt3V :: V.Vector (V.Vector (VU.Vector Int)) -> (Int, Int, Int) -> (Int, Int, Int) -> Int
-- supposes xaccsss is accumInt3V of (some) xsss, and
-- 1 <= i0, i1 <= length xsss,
-- 1 <= j0, j1 <= length (head xsss) and
-- 1 <= k0, k1 <= length (head (head xsss)).
-- note that the indices are 1-based.
sumOfRangeInt3V xaccsss (!i0, !j0, !k0) (!i1, !j1, !k1)
| i0 > i1 || j0 > j1 || k0 > k1 = 0
| otherwise = xacc
where
xacc = sumOfRangeInt2V (xaccsss VG.! i1) (j0, k0) (j1, k1) -
sumOfRangeInt2V (xaccsss VG.! (i0 - 1)) (j0, k0) (j1, k1)
sumOfRangeV :: (Group e, VG.Vector v e) =>
v e -> Int -> Int -> e
-- supposes xaccs is accumWithV of (some) xs, and 1 <= i0, i1 <= length xs.
-- note that the indices are 1-based.
sumOfRangeV xaccs !i0 !i1
| i0 > i1 = mempty
| otherwise = xaccs VG.! i1 <> invert (xaccs VG.! (i0 - 1))
sumOfRange2V :: (Group e, VG.Vector v e, VG.Vector w (v e)) =>
w (v e) -> (Int, Int) -> (Int, Int) -> e
-- supposes xaccss is accumWith2V of (some) xss, and
-- 1 <= i0, i1 <= length xss and
-- 1 <= j0, j1 <= length (head xss).
-- note that the indices are 1-based.
sumOfRange2V xaccss (!i0, !j0) (!i1, !j1)
| i0 > i1 || j0 > j1 = mempty
| otherwise = xacc
where
xacc =
sumOfRangeV (xaccss VG.! i1) j0 j1 <>
invert (sumOfRangeV (xaccss VG.! (i0 - 1)) j0 j1)
sumOfRange3V :: (Group e, VG.Vector u e, VG.Vector v (u e), VG.Vector w (v (u e))) =>
w (v (u e)) -> (Int, Int, Int) -> (Int, Int, Int) -> e
-- supposes xaccsss is accumWith3V of (some) xsss, and
-- 1 <= i0, i1 <= length xsss,
-- 1 <= j0, j1 <= length (head xsss) and
-- 1 <= k0, k1 <= length (head (head xsss)).
-- note that the indices are 1-based.
sumOfRange3V xaccsss (!i0, !j0, !k0) (!i1, !j1, !k1)
| i0 > i1 || j0 > j1 || k0 > k1 = mempty
| otherwise = xacc
where
xacc =
sumOfRange2V (xaccsss VG.! i1) (j0, k0) (j1, k1) <>
invert (sumOfRange2V (xaccsss VG.! (i0 - 1)) (j0, k0) (j1, k1))
inversePermutationV :: Int -> VU.Vector Int -> VU.Vector Int
-- requires VG.length ps == n and ps is a permutation of [0 .. n - 1].
-- the result qs is its inverse permutation, i.e., qs VG.! p == i <=> ps VG.! i == p.
inversePermutationV !n ps = qs
where
qs = accumulateVector (const id) (-1) n $
VG.map swap $ VG.indexed ps
decomposePermutationV :: VG.Vector v Int => v Int -> [[Int]]
-- decompose a permutation into cyclic permutations.
-- supposes ps is a permutation on [0 .. n - 1] where n is its length.
decomposePermutationV ps = iss
where
n = VG.length ps
iss = unfoldr (stepDPV ps) $ IS.fromDistinctAscList [0 .. n - 1]
stepDPV :: VG.Vector v Int => v Int -> IS.IntSet -> Maybe ([Int], IS.IntSet)
stepDPV ps is = case IS.minView is of
Nothing -> Nothing
Just (i, _) -> Just (isa, is')
where
isa = unfoldr step0 (i, IS.empty)
where
step0 (!i0, is0)
| i0 `IS.member` is0 = Nothing
| otherwise = Just (i0, (i0', is0'))
where
is0' = IS.insert i0 is0
i0' = ps VG.! i0 -- for the next iteration
is' = is IS.\\ IS.fromList isa
elemV :: (Ord a, VG.Vector v a) => a -> v a -> Bool
-- supposes xs is sorted.
elemV = isJust .: lookupV
lookupV :: (Ord a, VG.Vector v a) => a -> v a -> Maybe (Int, a)
-- look up the leftmost x in xs (if any).
-- supposes xs is sorted.
lookupV x xs = case lookupGEV x xs of
Nothing -> Nothing
Just (i, xtemp)
| x == xtemp -> Just (i, x)
| otherwise -> Nothing
compressV :: (Ord a, VG.Vector v a) => v a -> (Int, a -> Int, v a)
-- compress xs to 0-based indices.
-- fxi is a function that returns index of the value.
-- (if a value *not* in xs is passed to f, it occurs error.)
-- ixs is the (sorted and) compressed xs itself.
compressV xs = (VG.length ixs, fxi, ixs)
where
ixs = VG.uniq $ VG.modify (VAI.sortBy compare) xs
fxi !x = maybe undefined fst $ lookupV x ixs
lookupLTV :: (Ord a, VG.Vector v a) => a -> v a -> Maybe (Int, a)
-- supposes xs is sorted.
lookupLTV x xs
| VG.null xs = Nothing
| x0 >= x = Nothing
| otherwise = Just (i, xs VG.! i)
where
x0 = VG.head xs
n = VG.length xs
i = reverseBinarySearch (\i0 -> xs VG.! i0 < x) (0, pred n)
lookupGTV :: (Ord a, VG.Vector v a) => a -> v a -> Maybe (Int, a)
-- supposes xs is sorted.
lookupGTV x xs
| VG.null xs = Nothing
| x1 <= x = Nothing
| otherwise = Just (i, xs VG.! i)
where
x1 = VG.last xs
n = VG.length xs
i = binarySearch (\i0 -> xs VG.! i0 > x) (0, pred n)
lookupLEV :: (Ord a, VG.Vector v a) => a -> v a -> Maybe (Int, a)
-- supposes xs is sorted.
lookupLEV x xs
| VG.null xs = Nothing
| x0 > x = Nothing
| otherwise = Just (i, xs VG.! i)
where
x0 = VG.head xs
n = VG.length xs
i = reverseBinarySearch (\i0 -> xs VG.! i0 <= x) (0, pred n)
lookupGEV :: (Ord a, VG.Vector v a) => a -> v a -> Maybe (Int, a)
-- supposes xs is sorted.
lookupGEV x xs
| VG.null xs = Nothing
| x1 < x = Nothing
| otherwise = Just (i, xs VG.! i)
where
x1 = VG.last xs
n = VG.length xs
i = binarySearch (\i0 -> xs VG.! i0 >= x) (0, pred n)
lengthLTV :: (Ord a, VG.Vector v a) => v a -> a -> Int
lengthLTV xs x = maybe 0 (succ . fst) $ lookupLTV x xs
lengthGTV :: (Ord a, VG.Vector v a) => v a -> a -> Int
lengthGTV xs x = maybe 0 ((`subtract` n) . fst) $ lookupGTV x xs
where
n = VG.length xs
lengthLEV :: (Ord a, VG.Vector v a) => v a -> a -> Int
lengthLEV xs x = maybe 0 (succ . fst) $ lookupLEV x xs
lengthGEV :: (Ord a, VG.Vector v a) => v a -> a -> Int
lengthGEV xs x = maybe 0 ((`subtract` n) . fst) $ lookupGEV x xs
where
n = VG.length xs
lengthInRangeV :: (Ord a, VG.Vector v a) => v a -> (a, a) -> Int
lengthInRangeV xs (xmin, xmax)
| xmin > xmax = 0
| otherwise = lengthLEV xs xmax - lengthLTV xs xmin
maxSliceBoundsV :: (Ord a, VG.Vector v a) => v a -> a -> a -> Maybe (Int, Int)
-- supposes xs is sorted and xlow <= xupp.
-- the bounds of the maximal slice xs' of xs which satisfies:
-- for all x <- xs' (inRange (xlow, xupp) x).
maxSliceBoundsV xs xlow xupp = case lookupGEV xlow xs of
Nothing -> Nothing
Just (il, _) -> case lookupLEV xupp xs of
Nothing -> Nothing
Just (ir, _)
| ir < il -> Nothing
| otherwise -> Just (il, ir)
maxSliceV :: (Ord a, VG.Vector v a) => v a -> a -> a -> v a
maxSliceV xs xlow xupp = case maxSliceBoundsV xs xlow xupp of
Nothing -> VG.empty
Just (il, ir) -> VG.slice il (ir - il + 1) xs
-- array
-- obsolete. use Data.Array.IArray.genArray.
tabulate :: (Ix i, A.IArray a e) => (i, i) -> (i -> e) -> a i e
tabulate = A.genArray
-- tabulate bnds f = A.listArray bnds $ f <$> range bnds
fixArray :: Ix i => (i, i) -> (A.Array i e -> i -> e) -> A.Array i e
fixArray bnds f = ixs
where
g = f ixs
ixs = tabulate bnds g
tabulate2 :: (Ix i1, Ix i2, A.IArray a2 e, A.IArray a1 (a2 i2 e)) =>
(i1, i1) -> (i1 -> (i2, i2)) -> (i1 -> i2 -> e) -> a1 i1 (a2 i2 e)
tabulate2 bnds1 fbnds2 f = tabulate bnds1 (\x1 -> tabulate (fbnds2 x1) (f x1))
fixArray2 :: (Ix i1, Ix i2) => (i1, i1) -> (i1 -> (i2, i2)) ->
(A.Array i1 (A.Array i2 e) -> i1 -> i2 -> e) -> A.Array i1 (A.Array i2 e)
fixArray2 bnds1 fbnds2 f = ijxs
where
g = f ijxs
ijxs = tabulate2 bnds1 fbnds2 g
elemsArray2 :: (Ix i1, Ix i2, A.IArray a2 e, A.IArray a1 (a2 i2 e)) =>
a1 i1 (a2 i2 e) -> [[e]]
elemsArray2 = (A.elems <$>) . A.elems
assocsArray2 :: (Ix i1, Ix i2, A.IArray a2 e, A.IArray a1 (a2 i2 e)) =>
a1 i1 (a2 i2 e) -> [(i1, (i2, e))]
assocsArray2 = uncurry ((<$>) . (,)) . second A.assocs <=< A.assocs
accumArray2 :: (Ix i1, Ix i2, A.IArray a2 e, A.IArray a1 (a2 i2 e)) =>
(e -> e' -> e) -> e -> (i1, i1) -> (i1 -> (i2, i2)) -> [(i1, (i2, e'))] -> a1 i1 (a2 i2 e)
accumArray2 f x bnds1 fbnds2 ijxs = ijxss
where
ijxsstemp = bundleArray bnds1 ijxs
ijxss = tabulate bnds1 f0
where
f0 !i0 = A.accumArray f x (fbnds2 i0) $ ijxsstemp A.! i0
accum2Array :: (Ix i1, Ix i2, A.IArray a2 e, A.IArray a1 (a2 i2 e)) =>
(e -> e' -> e) -> a1 i1 (a2 i2 e) -> [(i1, (i2, e'))] -> a1 i1 (a2 i2 e)
accum2Array f ijxss ijxs = ijxss'
where
bnds1 = A.bounds ijxss
ijxsstemp = bundleArray bnds1 ijxs
ijxss' = tabulate bnds1 f0
where
f0 !i0 = A.accum f (ijxss A.! i0) (ijxsstemp A.! i0)
imapArray :: (Ix i, A.IArray a e, A.IArray a' e') => (i -> e -> e') -> a i e -> a' i e'
imapArray f ixs = tabulate (A.bounds ixs) g
where
g !i = f i $ ixs A.! i
postscanlArray :: (Ix i, A.IArray a e, A.IArray a' e') => (e' -> e -> e') -> e' -> a i e -> a' i e'
postscanlArray f y ixs = A.listArray bnds $ postscanl' f0 y $ range bnds
where
bnds = A.bounds ixs
f0 = (. (ixs A.!)) . f
postscanlArray1 :: (Ix i, A.IArray a e, A.IArray a e') => (e' -> e -> e') -> e' -> a i e -> a i e'
postscanlArray1 = postscanlArray
postscanrArray :: (Ix i, A.IArray a e, A.IArray a' e') => (e -> e' -> e') -> e' -> a i e -> a' i e'
postscanrArray f y ixs = A.listArray bnds $ init $ scanr f0 y $ range bnds
where
bnds = A.bounds ixs
f0 = f . (ixs A.!)
scanBoundsArray :: (A.IArray a e, Group e) => (Int, Int) -> [((Int, Int), e)] -> a Int e
-- supposes e is commutative and for all (l, r) <- lrs (l < r).
-- note that each (l, r) represents a closed-open interval.
scanBoundsArray bnds@(!l, !r) lrxs = postscanlArray1 (<>) mempty idxs
where
idxs = A.accumArray (<>) mempty bnds $ concat $ mapMaybe f0 lrxs
where
f0 ((!l0, !r0), x0)
| r0 <= l || r < l0 = Nothing
| otherwise = Just $ (max l l0, x0) : [ (r0, invert x0) | inRange bnds r0 ]
countsArray :: Ix i => (i, i) -> [i] -> AU.UArray i Int
countsArray bnds is = A.accumArray (+) 0 bnds $ (, 1) <$> is
bundleArray :: Ix i => (i, i) -> [(i, a)] -> A.Array i [a]
bundleArray = A.accumArray (flip (:)) []
stableBundleArray :: Ix i => (i, i) -> [(i, a)] -> A.Array i [a]
stableBundleArray = (. reverse) . bundleArray
bundleVArray :: (VG.Vector v (i, a), VG.Vector w a, Ix i) =>
(i, i) -> v (i, a) -> A.Array i (w a)
bundleVArray bnds = A.amap VG.fromList . stableBundleArray bnds . VG.toList
indicesArray :: Ix i => (i, i) -> [i] -> A.Array i [Int]
indicesArray = (. (`zip` [0 ..])) . stableBundleArray
indicesVArray :: (VG.Vector v i, Ix i, VG.Vector v (i, Int)) =>
(i, i) -> v i -> A.Array i (VU.Vector Int)
indicesVArray bnds = bundleVArray bnds . VG.imap (flip (,))
groupDictionary :: Ix i => (i, i) -> [[i]] -> (Int, AU.UArray i Int, A.Array Int [i])
-- gives consecutive id numbers (starting from 1) to each component of xss.
-- both (value -> id number) and (id number -> component (values)) maps are returned (as arrays).
-- requires that (concat xss) has no duplicate values.
groupDictionary bnds xss = (k, xis, ixss)
where
k = length xss
xistemp = (\(xs, !i) -> (, i) <$> xs) =<< zip xss [1 .. k]
xis = A.array bnds xistemp -- note x’s are not duplicated
ixss = A.listArray (1, k) xss
inversePermutationArray :: Int -> [Int] -> AU.UArray Int Int
-- requires length ps == n and ps is a permutation of [1 .. n].
-- the result (pis) is its inverse permutation, i.e., pis A.! p == i <=> ps !! (i - 1) == p.
inversePermutationArray !n ps = A.accumArray (const id) 0 (1, n) $ zip ps [1 ..]
decomposePermutationArray :: A.IArray a Int => a Int Int -> [[Int]]
-- decompose a permutation into cyclic permutations.
-- supposes ips is a permutation on range of bounds of ips.
decomposePermutationArray ips = iss
where
iss = unfoldr (stepDPA ips) $ IS.fromDistinctAscList $ range $ A.bounds ips
stepDPA :: A.IArray a Int => a Int Int -> IS.IntSet -> Maybe ([Int], IS.IntSet)
stepDPA ips is = case IS.minView is of
Nothing -> Nothing
Just (i, _) -> Just (isa, is')
where
isa = unfoldr step0 (i, IS.empty)
where
step0 (!i0, is0)
| i0 `IS.member` is0 = Nothing
| otherwise = Just (i0, (i0', is0'))
where
is0' = IS.insert i0 is0
i0' = ips A.! i0 -- for the next iteration
is' = is IS.\\ IS.fromList isa
-- string
showsPaddedWith :: (a -> ShowS) -> Int -> a -> ShowS
showsPaddedWith f !d !x = showString s
where
stemp = f x ""
dtemp = length stemp
s = replicate (max 0 (d - dtemp)) '0' ++ stemp
showPaddedWith :: (a -> ShowS) -> Int -> a -> String
showPaddedWith = ($ "") .:. showsPaddedWith
showsIntegralPadded :: (Integral a, Show a) => Int -> a -> ShowS
-- show x by at least d digits (padding with 0’s, if necessary).
-- supposes d > 0 and x >= 0.
showsIntegralPadded = showsPaddedWith showInt
showIntegralPadded :: (Integral a, Show a) => Int -> a -> String
showIntegralPadded = showPaddedWith showInt
showsBinPadded :: (Integral a, Show a) => Int -> a -> ShowS
showsBinPadded = showsPaddedWith showBin
showBinPadded :: (Integral a, Show a) => Int -> a -> String
showBinPadded = showPaddedWith showBin
showsHexPadded :: (Integral a, Show a) => Int -> a -> ShowS
showsHexPadded = showsPaddedWith showHex
showHexPadded :: (Integral a, Show a) => Int -> a -> String
showHexPadded = showPaddedWith showHex
type SourceString a = Int -> a -- element by 0-based index
-- list
isSingleton :: [a] -> Bool
isSingleton xs = case xs of
[] -> False
(_ : xs') -> null xs'
safe :: ([a] -> b) -> [a] -> Maybe b
safe = mapNothingIf null
concatMapMaybe :: (a -> Maybe [b]) -> [a] -> [b]
concatMapMaybe f = concat . mapMaybe f
orderedPairWith :: (a -> a -> b) -> [a] -> [b]
orderedPairWith f = go
where
go [] = []
go (x : xs) = (f x <$> xs) ++ go xs
orderedPairs :: [a] -> [(a, a)]
orderedPairs = orderedPairWith (,)
orderedPairWithMaybe :: (a -> a -> Maybe b) -> [a] -> [b]
orderedPairWithMaybe f = go
where
go [] = []
go (x : xs) = mapMaybe (f x) xs ++ go xs
concatOrderedPairWith :: (a -> a -> [b]) -> [a] -> [b]
concatOrderedPairWith f = go
where
go [] = []
go (x : xs) = (f x =<< xs) ++ go xs
orderedTripleWith :: (a -> a -> a -> b) -> [a] -> [b]
orderedTripleWith f xs = ys
where
f0 [] = []
f0 (x0 : xs0) = orderedPairWith (f x0) xs0
ys = f0 =<< tails xs
orderedTriples :: [a] -> [(a, a, a)]
orderedTriples = orderedTripleWith (,,)
adjacentWith :: (a -> a -> b) -> [a] -> [b]
adjacentWith f xs = case xs of
[] -> []
(_ : xs') -> zipWith f xs xs'
adjacentPairs :: [a] -> [(a, a)]
adjacentPairs = adjacentWith (,)
adjacentWithMaybe :: (a -> a -> Maybe b) -> [a] -> [b]
adjacentWithMaybe f xs = case xs of
[] -> []
(_ : xs') -> zipWithMaybe f xs xs'
concatAdjacentWith :: (a -> a -> [b]) -> [a] -> [b]
concatAdjacentWith f xs = case xs of
[] -> []
(_ : xs') -> concatZipWith f xs xs'
adjacentWith3 :: (a -> a -> a -> b) -> [a] -> [b]
adjacentWith3 f xs = fromMaybe [] $ do
(_, xs') <- uncons xs
(_, xs'') <- uncons xs'
return $ zipWith3 f xs xs' xs''
adjacentTriples :: [a] -> [(a, a, a)]
adjacentTriples = adjacentWith3 (,,)
adjacentWith3Maybe :: (a -> a -> a -> Maybe b) -> [a] -> [b]
adjacentWith3Maybe f xs = fromMaybe [] $ do
(_, xs') <- uncons xs
(_, xs'') <- uncons xs'
return $ zipWith3Maybe f xs xs' xs''
zipWithMaybe :: (a -> b -> Maybe c) -> [a] -> [b] -> [c]
zipWithMaybe f = go
where
go [] _ = []
go _ [] = []
go (x0 : xs0) (y0 : ys0) = case f x0 y0 of
Nothing -> go xs0 ys0
Just z0 -> z0 : go xs0 ys0
zipWith3Maybe :: (a -> b -> c -> Maybe d) -> [a] -> [b] -> [c] -> [d]
zipWith3Maybe f = go
where
go [] _ _ = []
go _ [] _ = []
go _ _ [] = []
go (x0 : xs0) (y0 : ys0) (z0 : zs0) = case f x0 y0 z0 of
Nothing -> go xs0 ys0 zs0
Just w0 -> w0 : go xs0 ys0 zs0
concatZipWith :: (a -> b -> [c]) -> [a] -> [b] -> [c]
concatZipWith f = go
where
go [] _ = []
go _ [] = []
go (x0 : xs0) (y0 : ys0) = f x0 y0 ++ go xs0 ys0
sequentialPairWith :: (a -> a -> b) -> [a] -> [b]
-- supposes the argument's length is even.
sequentialPairWith f = unfoldr step0
where
step0 [] = Nothing
step0 [_] = Nothing
step0 (x0 : x1 : xs1) = Just (f x0 x1, xs1)
sequentialPairs :: [a] -> [(a, a)]
-- supposes the argument's length is even.
sequentialPairs = sequentialPairWith (,)
sequentialPairWithMaybe :: (a -> a -> Maybe b) -> [a] -> [b]
-- supposes the argument's length is even.
sequentialPairWithMaybe f = go
where
go [] = []
go [_] = []
go (xa0 : xb0 : xs0) = case f xa0 xb0 of
Nothing -> go xs0
Just y0 -> y0 : go xs0
liftA2Maybe :: (a -> b -> Maybe c) -> [a] -> [b] -> [c]
liftA2Maybe f xs ys = g =<< xs
where
g x = mapMaybe (f x) ys
interleave :: [a] -> [a] -> [a]
interleave = go
where
go xs0 ys0 = case xs0 of
[] -> []
(x0 : xs0') -> x0 : go ys0 xs0'
uninterleave :: [a] -> ([a], [a])
uninterleave = foldr (\x (xs0, xs1) -> (x : xs1, xs0)) ([], [])
summarizeBy :: Ord a => ([b] -> c) -> [(a, b)] -> [(a, c)]
summarizeBy summary = ((fst . head &&& summary . (snd <$>)) <$>) . groupOn fst . sortOn fst
summarizeByNE :: Ord a => (NE.NonEmpty b -> c) -> [(a, b)] -> [(a, c)]
summarizeByNE summary = ((fst . NE.head &&& summary . (snd <$>)) <$>) . NE.groupWith fst . sortOn fst
bundle :: Eq a => [(a, b)] -> [(a, [b])]
bundle = ((fst . head &&& (snd <$>)) <$>) . groupOn fst
bundleNE :: Eq a => [(a, b)] -> [(a, NE.NonEmpty b)]
bundleNE = ((fst . NE.head &&& (snd <$>)) <$>) . NE.groupWith fst
runLengths :: Eq a => [a] -> [(a, Int)]
runLengths = ((NE.head &&& NE.length) <$>) . NE.group
-- runLengths = ((head &&& length) <$>) . group
unRunLengths :: [(a, Int)] -> [a]
unRunLengths = (uncurry (flip replicate) =<<)
findBlock :: (Num a, Ord a) => a -> [a] -> Maybe (Int, a)
-- find the block to which x belongs.
-- x is supposed to be a accumulated value from left (0-based index etc) and
-- ys is supposeed to be a list of block sizes (all y <- ys should be non-negative).
-- roughly speaking, x is a sort of *boundary*.
findBlock = go 0
where
go _ _ [] = Nothing
go !i0 !x0 (y0 : ys0)
| x0 < y0 = Just (i0, x0)
| otherwise = go (i0 + 1) (x0 - y0) ys0
findBlockR :: (Num a, Ord a) => a -> [a] -> Maybe (Int, a)
-- find the block to which x belongs.
-- x is supposed to be a *positive* accumulated value from left (length etc) and
-- ys is supposeed to be a list of block sizes (all y <- ys should be non-negative).
-- note that x in the result (i, x) is in the range (1, length of i’s block),
-- not (0, length of i’s block - 1) as in findBlock.
-- roughly speaking, x is a sort of *length* (not a boundary).
findBlockR = go 0
where
go _ _ [] = Nothing
go !i0 !x0 (y0 : ys0)
| x0 <= y0 = Just (i0, x0)
| otherwise = go (i0 + 1) (x0 - y0) ys0
postscanl' :: (b -> a -> b) -> b -> [a] -> [b]
postscanl' f y xs = case scanl' f y xs of
[] -> undefined -- should not happen
(_ : ys) -> ys
unfoldrMaybe :: (b -> Maybe (Maybe a, b)) -> b -> [a]
unfoldrMaybe f = go
where
go y0 = case f y0 of
Nothing -> []
Just (mx0, y0') -> case mx0 of
Nothing -> go y0'
Just x0 -> x0 : go y0'
mapAccumMaybeL :: (a -> b -> (a, Maybe c)) -> a -> [b] -> (a, [c])
mapAccumMaybeL f = go
where
go !x0 [] = (x0, [])
go !x0 (y0 : ys0) = case mz0 of
Nothing -> go x0' ys0
Just z0 -> second (z0 :) $ go x0' ys0
where
(!x0', mz0) = f x0 y0
mapAccumMaybeR :: (a -> b -> (a, Maybe c)) -> a -> [b] -> (a, [c])
mapAccumMaybeR f x = second reverse . mapAccumMaybeL f x . reverse
swapAt :: Int -> Int -> [a] -> [a]
-- requires 0 <= i < n (== length xs) and 0 <= j < n.
swapAt !i !j xs
| i == j = xs
| otherwise = imap f0 xs
where
xi = xs !! i
xj = xs !! j
f0 !i0 x0
| i0 == i = xj
| i0 == j = xi
| otherwise = x0
slice :: Int -> Int -> [a] -> [a]
slice !i !n = take n . drop i
sliceFromTo :: Int -> Int -> [a] -> [a]
-- supposes l < r. note that [l, r) is a closed-open interval.
sliceFromTo !l !r = slice l (r - l)
count :: (a -> Bool) -> [a] -> Int
count = length .: filter
-- biapplicative
bothA2 :: Biapplicative p => (a -> b -> c) -> p a a -> p b b -> p c c
bothA2 = join biliftA2
-- tuple
curriedOrderedPair :: Ord a => a -> a -> (a, a)
curriedOrderedPair !x !y = (min x y, max x y)
orderedPair :: Ord a => (a, a) -> (a, a)
orderedPair = uncurry curriedOrderedPair
both3 :: (a -> b) -> (a, a, a) -> (b, b, b)
both3 f (xa, xb, xc) = (f xa, f xb, f xc)
insertFst3 :: a -> (b, c) -> (a, b, c)
insertFst3 x (y, z) = (x, y, z)
deleteFst3 :: (a, b, c) -> (b, c)
deleteFst3 (_, y, z) = (y, z)
insertSnd3 :: b -> (a, c) -> (a, b, c)
insertSnd3 y (x, z) = (x, y, z)
deleteSnd3 :: (a, b, c) -> (a, c)
deleteSnd3 (x, _, z) = (x, z)
insertThd3 :: c -> (a, b) -> (a, b, c)
insertThd3 z (x, y) = (x, y, z)
deleteThd3 :: (a, b, c) -> (a, b)
deleteThd3 (x, y, _) = (x, y)
rotateLeft3 :: (a, b, c) -> (b, c, a)
rotateLeft3 (x, y, z) = (y, z, x)
rotateRight3 :: (a, b, c) -> (c, a, b)
rotateRight3 (x, y, z) = (z, x, y)
swapLeftMiddle3 :: (a, b, c) -> (b, a, c)
swapLeftMiddle3 (x, y, z) = (y, x, z)
swapLeftRight3 :: (a, b, c) -> (c, b, a)
swapLeftRight3 (x, y, z) = (z, y, x)
swapMiddleRight3 :: (a, b, c) -> (a, c, b)
swapMiddleRight3 (x, y, z) = (x, z, y)
alpha :: (a, (b, c)) -> ((a, b), c)
alpha (x, (y, z)) = ((x, y), z)
invAlpha :: ((a, b), c) -> (a, (b, c))
invAlpha ((x, y), z) = (x, (y, z))
splitTripleLeft :: (a, b, c) -> (a, (b, c))
splitTripleLeft (x, y, z) = (x, (y, z))
splitTripleRight :: (a, b, c) -> ((a, b), c)
splitTripleRight (x, y, z) = ((x, y), z)
flattenTripleLeft :: (a, (b, c)) -> (a, b, c)
flattenTripleLeft (x, (y, z)) = (x, y, z)
flattenTripleRight :: ((a, b), c) -> (a, b, c)
flattenTripleRight ((x, y), z) = (x, y, z)
intersectsBounds :: Ord i => (i, i) -> (i, i) -> Bool
-- do intervals [ia, ja) and [ib, jb) intersect?
-- note that if (i, j) represents closed interval,
-- calculate intersectsBounds (ia, ja + 1) (ib, jb + 1) or use intersectsClosedBounds.
intersectsBounds (!ia, !ja) (!ib, !jb) = ib < ja && ia < jb
intersectsClosedBounds :: Ord i => (i, i) -> (i, i) -> Bool
-- do intervals [ia, ja] and [ib, jb] intersect?
intersectsClosedBounds (!ia, !ja) (!ib, !jb) = ib <= ja && ia <= jb
intersectionBounds :: Ord i => (i, i) -> (i, i) -> (i, i)
-- supposes intersectsBounds (i1, j1) (i2, j2).
intersectionBounds (!i1, !j1) (!i2, !j2) = (max i1 i2, min j1 j2)
curriedIx2 :: Num a => a -> a -> a -> a
-- no tuple created.
curriedIx2 = (+) .: (*)
ix2 :: Num a => a -> (a, a) -> a
ix2 = uncurry . curriedIx2
invIx2 :: Integral a => a -> a -> (a, a)
invIx2 = flip divMod
curriedIx3 :: Num a => a -> a -> a -> a -> a -> a
-- no tuple created.
curriedIx3 n m = curriedIx2 m .: curriedIx2 n
ix3 :: Num a => a -> a -> (a, a, a) -> a
ix3 = uncurry3 .: curriedIx3
invIx3 :: Integral a => a -> a -> a -> (a, a, a)
invIx3 n m = flattenTripleRight . first (invIx2 n) . invIx2 m
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 f (x, y, z, w) = f x y z w
-- num
square :: Num a => a -> a
square !x = x * x
cube :: Num a => a -> a
cube !x = x * x * x
absdiff :: Num a => a -> a -> a
absdiff !x !y = abs (x - y)
monus :: (Num a, Ord a) => a -> a -> a
monus !x !y = max 0 (x - y)
-- mod int
newtype ModInt = ModInt { getModInt :: Int }
deriving (Eq, Ord, Show, Renderable)
-- data constructor ModInt should not be used directly.
-- use modInt below instead.
-- the value inside ModInt is supposed to be ‘normalized’ by (`mod` modulus).
modInt :: Int -> ModInt
modInt !x = ModInt (x `mod` modulus)
modulus :: Int
modulus = 998_244_353
liftMod :: (Int -> Int) -> ModInt -> ModInt
liftMod op (ModInt !x) = modInt $ op x
liftMod2 :: (Int -> Int -> Int) -> ModInt -> ModInt -> ModInt
liftMod2 op (ModInt !x) (ModInt !y) = modInt $ op x y
instance Num ModInt where
(+) = liftMod2 (+)
(*) = liftMod2 (*)
abs = liftMod abs
signum = liftMod signum
fromInteger = modInt . fromInteger
(-) = liftMod2 (-)
instance Fractional ModInt where
recip (ModInt !x)
| x == 0 = undefined
| otherwise = modInt (modInverse modulus x)
fromRational !r = n / d
where
!n = fromInteger $ numerator r
!d = fromInteger $ denominator r
newtype instance VUM.MVector s ModInt = MV_ModInt (VUM.MVector s Int)
newtype instance VU.Vector ModInt = V_ModInt (VU.Vector Int)
deriving instance VGM.MVector VUM.MVector ModInt
deriving instance VG.Vector VU.Vector ModInt
instance VU.Unbox ModInt
instance Unboxable Int ModInt where
unbox = getModInt
box = modInt
factorials :: A.Array Int ModInt
factorials = A.listArray (0, facSize) vals
where
vals = scanl' (*) 1 (modInt <$> [1 .. facSize])
facSize :: Int
facSize = 100_000 -- adjust if necessary
inverses :: A.Array Int ModInt
inverses = xus
where
xus = fixArray (1, facSize) extendInverse
extendInverse :: A.Array Int ModInt -> Int -> ModInt
-- calculates the inverses (reciprocals) not by using recip but accumulatively.
-- requires 0 < x < modulus.
extendInverse xus x
| x == 1 = 1
| otherwise = y * z
where
(d, r) = divMod modulus x -- r /= 0
y = modInt (-d)
z = xus A.! r
inverseFactorials :: A.Array Int ModInt
inverseFactorials = A.listArray (0, facSize) vals
where
vals = scanl' (*) 1 $ A.elems inverses
combination :: Int -> Int -> ModInt
combination p q
| q < 0 || p < q = 0
| q == 0 || p == q = 1
| otherwise = permutation p q * (inverseFactorials A.! q)
permutation :: Int -> Int -> ModInt
permutation p q
| q < 0 || p < q = 0
| q == 0 = 1
| otherwise = (factorials A.! p) * (inverseFactorials A.! r)
where
r = p - q
-- overflow-able int’s
newtype OverflowInt = Overflow { getOverflow :: Int }
deriving (Eq, Ord, Show, Renderable)
overflow :: Int -> OverflowInt
overflow = Overflow . clamp (minBoundInt, maxBoundInt)
maxBoundInt :: Int
maxBoundInt = maxBound
minBoundInt :: Int
minBoundInt = minBound + 1
overflowedInt :: Int -> Bool
overflowedInt !x0 = x0 == minBoundInt || x0 == maxBoundInt
overflowed :: OverflowInt -> Bool
overflowed (Overflow x0) = overflowedInt x0
instance Num OverflowInt where
(Overflow x0) + (Overflow y0)
| x0 == 0 = Overflow y0
| y0 == 0 = Overflow x0
| overflowedInt x0 && signum x0 /= signum y0 = undefined -- not definite
| overflowedInt x0 && otherwise = Overflow x0
| overflowedInt y0 && signum x0 /= signum y0 = undefined -- not definite
| overflowedInt y0 && otherwise = Overflow y0
| x0 > 0 && y0 > 0 && y0 >= maxBoundInt - x0 = Overflow maxBoundInt
| x0 < 0 && y0 < 0 && y0 <= minBoundInt - x0 = Overflow minBoundInt
| otherwise = Overflow (x0 + y0)
(Overflow x0) * (Overflow y0)
| x0 == 0 || y0 == 0 = Overflow 0
| overflowedInt x0 && signum x0 /= signum y0 = Overflow minBoundInt
| overflowedInt x0 && otherwise = Overflow maxBoundInt
| overflowedInt y0 && signum x0 /= signum y0 = Overflow minBoundInt
| overflowedInt y0 && otherwise = Overflow maxBoundInt
| signum x0 == signum y0 && abs y0 >= maxBoundInt `divGE` abs x0 = Overflow maxBoundInt
| signum x0 /= signum y0 && -(abs y0) <= minBoundInt `div` abs x0 = Overflow minBoundInt
| otherwise = Overflow (x0 * y0)
abs (Overflow x0) = Overflow (abs x0)
signum (Overflow x0) = Overflow (signum x0)
fromInteger x0 = Overflow $ fromInteger $ clamp (fromIntegral minBoundInt, fromIntegral maxBoundInt) x0
negate (Overflow x0) = Overflow (negate x0)
instance Bounded OverflowInt where
minBound = Overflow minBoundInt
maxBound = Overflow maxBoundInt
newtype instance VUM.MVector s OverflowInt = MV_OverflowInt (VUM.MVector s Int)
newtype instance VU.Vector OverflowInt = V_OverflowInt (VU.Vector Int)
deriving instance VGM.MVector VUM.MVector OverflowInt
deriving instance VG.Vector VU.Vector OverflowInt
instance VU.Unbox OverflowInt
instance Unboxable Int OverflowInt where
unbox = getOverflow
box = overflow
sqrtLE :: Int -> Int
-- requires 0 <= n < maxBound.
sqrtLE = rootLE 2
sqrtGE :: Int -> Int
-- requires 0 <= n < maxBound.
sqrtGE = rootGE 2
rootLE :: Int -> Int -> Int
-- requires 1 <= d && 0 <= n < maxBound.
rootLE !d !n
| n <= 1 = n
| d == 1 = n
| not (cond n) = undefined -- should not happen
| otherwise = m - 1 -- n > 1 && d > 1 && cond n
where
n' = overflow n
cond !m0 = overflow m0 ^ d > n'
m = binarySearch cond (1, n)
rootGE :: Int -> Int -> Int
-- requires 1 <= d && 0 <= n < maxBound.
rootGE !d !n
| n <= 1 = n
| d == 1 = n
| overflowed n' = undefined -- should not happen
| otherwise = m -- n > 1 && d > 1 && not (overflowed n')
where
n' = overflow n
cond !m0 = overflow m0 ^ d >= n'
m = binarySearch cond (1, n)
logGE :: Int -> Int -> Int
-- requires 1 < b && 0 < n < maxBound.
-- the smallest k >= 0 which satisfies n <= b ^ k.
logGE !b !n = until ((>= overflow n) . (overflow b ^)) succ 0
logGT :: Int -> Int -> Int
-- requires 1 < b && 0 < n < maxBound.
-- the smallest k > 0 which satisfies n < b ^ k.
logGT !b !n = until ((> overflow n) . (overflow b ^)) succ 1
logLE :: Int -> Int -> Int
-- requires 1 < b && 0 < n < maxBound.
-- the largest k >= 0 which satisfies n >= b ^ k.
logLE !b !n = pred $ until ((> overflow n) . (overflow b ^)) succ 1
logLT :: Int -> Int -> Int
-- requires 1 < b && 1 < n < maxBound.
-- the largest k >= 0 which satisfies n > b ^ k.
logLT !b !n = pred $ until ((>= overflow n) . (overflow b ^)) succ 1
-- int
sumFromBy :: (Integral a, Num b) => a -> a -> a -> b
-- sum [ a + i * d | i <- [0 .. n - 1] ].
-- requires n >= 0.
sumFromBy !n !a !d
| even n = fromIntegral (n `div` 2) * (a' + a' + (n' - 1) * d')
| otherwise = n' * (a' + fromIntegral ((n - 1) `div` 2) * d')
-- (n * (a + a + (n - 1) * d)) `div` 2
where
a' = fromIntegral a
n' = fromIntegral n
d' = fromIntegral d
sumFromTo :: (Integral a, Num b) => a -> a -> b
-- supposes i - 1 <= j.
sumFromTo !i !j = sumFromBy (j - i + 1) i 1
sumFromToBy :: (Integral a, Num b) => a -> a -> a -> b
-- sum [a, a + d .. b].
-- requires d > 0. supposes a - 1 <= b.
sumFromToBy !a !b !d = sumFromBy n a d
where
n = 1 + (b - a) `div` d
sumTo :: (Integral a, Num b) => a -> b
sumTo = sumFromTo 1
perm2 :: Integral a => a -> a
perm2 !n = n * (n - 1)
comb2 :: Integral a => a -> a
comb2 = (`div` 2) . perm2
perm3 :: Integral a => a -> a
perm3 !n = n * (n - 1) * (n - 2)
comb3 :: Integral a => a -> a
comb3 = (`div` 6) . perm3
factorialNaive :: Int -> Int
factorialNaive = product . enumFromTo 1
combinationNaive :: Int -> Int -> Int
combinationNaive p q
| p < 0 || q < 0 || p < q = 0
| otherwise = foldl' step0 1 [1 .. q]
where
step0 !v0 !i0 = v0 * (p - q + i0) `div` i0
divLE :: Integral a => a -> a -> a
-- ensures z <= x `divLE` y <=> y * z <= x.
-- requires y /= 0.
divLE = div
infixl 7 `divLE`
divGE :: Integral a => a -> a -> a
-- ensures x `divGE` y <= z <=> x <= y * z, if y > 0.
-- requires y /= 0.
divGE !x !y = p + bool 1 0 (q == 0)
where
(p, q) = divMod x y
infixl 7 `divGE`
-- avoids the implementation below because the valid range is narrower.
-- divGE !x !y = (x + y - 1) `div` y -- x + y - 1 might overflow
divGT :: Integral a => a -> a -> a
-- ensures x `divGT` y <= z <=> x < y * z <=> x `div` y < z, if y > 0.
-- requires y /= 0.
divGT !x !y = (x `div` y) + 1
infixl 7 `divGT`
divLT :: Integral a => a -> a -> a
-- ensures z <= x `divLT` y <=> y * z < x <=> z < x `divGE` y, if y > 0.
-- requires y /= 0.
divLT !x !y = (x `divGE` y) - 1
infixl 7 `divLT`
divisibleBy :: Integral a => a -> a -> Bool
divisibleBy !x = (== 0) . mod x
infix 7 `divisibleBy`
divides :: Integral a => a -> a -> Bool
divides = flip divisibleBy
infix 7 `divides`
divRound :: Integral a => a -> a -> a
-- requires y /= 0.
-- supposes x >= 0 and y > 0. (if not, the result is not a ‘round’ value in a usual sense.)
divRound !x !y = z
where
(p, q) = divMod x y
z | 2 * q < y = p
| otherwise = p + 1
quotRound :: Integral a => a -> a -> a
-- requires y /= 0.
quotRound !x !y
| y == 0 = undefined
| y < 0 = negate $ quotRound (-x) (-y)
| x < 0 = negate $ quotRound (-x) y -- y > 0
| otherwise = (2 * x + y) `quot` (2 * y) -- y > 0 && x >= 0
multipleOfLE :: Int -> Int -> Int
multipleOfLE !k = (* k) . (`divLE` k)
multipleOfGE :: Int -> Int -> Int
multipleOfGE !k = (* k) . (`divGE` k)
multipleOfLT :: Int -> Int -> Int
multipleOfLT !k = (* k) . (`divLT` k)
multipleOfGT :: Int -> Int -> Int
multipleOfGT !k = (* k) . (`divGT` k)
linearBounds :: (Ord a, Integral a) =>
a -> a -> a -> a -> a -> a -> (a, a)
-- bounds of x which satisfies:
-- * l <= x <= r (supposes l <= r) and
-- * a <= p * x + q <= b (requires p /= 0, supposes a <= b).
linearBounds !l !r !p !q !a !b
| p == 0 = undefined
| p < 0 = linearBounds l r (-p) (-q) (-b) (-a)
| otherwise = (max l ((a - q) `divGE` p), min r ((b - q) `div` p))
linearRange :: (Ix a, Integral a) =>
a -> a -> a -> a -> a -> a -> [a]
linearRange = (((((range .) .) .) .) .) . linearBounds
primes :: Integral a => [a]
primes = 2 : 3 : filter isPrime [ 6 * i + j | i <- [1 ..], j <- [-1, 1] ]
isPrime :: Integral a => a -> Bool
-- requires x >= 2.
isPrime !x = not $ any (x `divisibleBy`) (takeWhile ((<= x) . square) primes)
factorize :: Integral a => a -> [(a, Int)]
factorize n = pqs
where
pqs = unfoldr stepFactorize (2, n)
factorizeV :: (Integral a, VG.Vector v (a, Int)) => a -> v (a, Int)
factorizeV n = pqs
where
pqs = VG.unfoldr stepFactorize (2, n)
stepFactorize :: Integral a => (a, a) -> Maybe ((a, Int), (a, a))
stepFactorize (!p, !n)
| n == 1 = Nothing
| p * p > n = Just ((n, 1), (n, 1))
| q > 0 = Just ((p, q), (p', n'))
| otherwise = stepFactorize (p', n)
where
(n', q) = n `factorizeBy` p
p' | p == 2 = 3
| p == 3 = 5
| p `mod` 6 == 1 = p + 4
| otherwise = p + 2
factorizeBy :: Integral a => a -> a -> (a, Int)
factorizeBy n p = until done0 step0 (n, 0)
where
done0 (!n0, _) = n0 `mod` p /= 0
step0 (!n0, !q0) = (n0 `div` p, q0 + 1)
divisors :: Integral a => a -> [a]
divisors n = ds
where
dds = divisorPairs n
(dsa, dsb) = unzip dds
ds = case safe last dsa of
Nothing -> []
Just da -> case dsb' of
[] -> undefined -- should not happen
(db : dsb'')
| da == db -> dsa ++ dsb''
| otherwise -> dsa ++ dsb'
where
dsb' = reverse dsb
divisorPairs :: Integral a => a -> [(a, a)]
divisorPairs n = dds
where
ds = filter (`divides` n) $ takeWhile (\i -> i * i <= n) [1 .. n]
dds = ((,) <*> (n `div`)) <$> ds
legendre :: Int -> Int -> Int
-- maximal q where p ^ q divides n!.
legendre p n = sum $ takeWhile (> 0) $ (n `div`) . (p ^) <$> [1 :: Int ..]
modInverse :: Integral a => a -> a -> a
-- the value y which satisfies
-- (x * y) `mod` k == g where g = gcd x k.
-- when k is a prime number and 0 < x && x < k, g == 1.
modInverse !k !x = y
where
(!p, _, _) = extGcd x k
!y = p `mod` k
extGcd :: Integral a => a -> a -> (a, a, a)
-- the triple (p, q, g) which satisfies
-- p * x + q * y == g where g = gcd x y.
-- requires x >= 0 && y >= 0.
-- note that max (abs p) (abs q) <= max x y holds.
extGcd !x !y
| y == 0 = (1, 0, x)
| otherwise = (q, p - q * d, g)
where
(d, m) = divMod x y
(p, q, g) = extGcd y m
-- see https://atcoder.jp/contests/practice2/editorial/579 .
floorSum :: (Integral a, Num b) => a -> a -> a -> a -> b
-- floorSum n m a b = sum [ (a * i + b) `div` m | i <- [0 .. n - 1] ].
-- requires 0 <= n and 0 < m.
floorSum = go
where
go !n0 !m0 !a0 !b0
| n0 == 0 = 0
| a0 == 0 = fromIntegral $ n0 * (b0 `div` m0)
| otherwise = sumFromBy n0 b1 a1 + go y0 a0' m0 z0
where
(a1, a0') = divMod a0 m0
(b1, b0') = divMod b0 m0
(y0, z0) = divMod (a0' * n0 + b0') m0
ceilingSum :: Integral a => a -> a -> a -> a -> a
-- ceilingSum n m a b = sum [ (a * i + b) `divGE` m | i <- [0 .. n - 1] ].
-- requires 0 <= n and 0 < m.
ceilingSum n m a b = negate $ floorSum n m (-a) (-b)
log2GE :: Int -> Int
-- requires 0 < n <= maxBound .>>. 1.
-- the smallest k >= 0 which satisfies n <= 2 ^ k.
log2GE !n = until ((>= n) . bit) succ 0
log2GT :: Int -> Int
-- requires 0 < n <= maxBound .>>. 1.
-- the smallest k > 0 which satisfies n < 2 ^ k.
log2GT !n = until ((> n) . bit) succ 1
log2LE :: Int -> Int
-- requires 0 < n <= maxBound .>>. 1.
-- the largest k >= 0 which satisfies n >= 2 ^ k.
log2LE !n = pred $ until ((> n) . bit) succ 1
log2LT :: Int -> Int
-- requires 1 < n <= maxBound .>>. 1.
-- the largest k >= 0 which satisfies n > 2 ^ k.
log2LT !n = pred $ until ((>= n) . bit) succ 1
valueOfBase :: Num a => a -> [a] -> a
valueOfBase !b = foldl' ((+) . (b *)) 0
valueOfBaseR :: Num a => a -> [a] -> a
valueOfBaseR !b = foldr ((. (b *)) . (+)) 0
valueOfBaseV :: (Num a, VG.Vector v a) => a -> v a -> a
valueOfBaseV !b = VG.foldl' ((+) . (b *)) 0
valueOfBaseRV :: (Num a, VG.Vector v a) => a -> v a -> a
valueOfBaseRV !b = VG.foldr' ((. (b *)) . (+)) 0
digitCountOfBase :: Integral a => a -> a -> Int
-- requires b > 1. supposes x > 0.
digitCountOfBase !b = length . digitsOfBase b
digitsOfBase :: Integral a => a -> a -> [a]
-- requires b > 1. supposes x > 0. if x == 0, the result is an empty list.
digitsOfBase !b !x = fst $ until done0 step0 ([], x)
where
done0 (_, !x0) = x0 == 0
step0 (ys0, !x0) = (y0 : ys0, x0')
where
(!x0', !y0) = divMod x0 b
digitsOfBaseR :: Integral a => a -> a -> [a]
-- requires b > 1. supposes x > 0. if x == 0, the result is an empty list.
digitsOfBaseR !b !x = unfoldr step0 x
where
step0 !x0
| x0 == 0 = Nothing
| otherwise = Just (y0, x0')
where
(!x0', !y0) = divMod x0 b
digitsOfBaseV :: (Integral a, VG.Vector v a) => a -> a -> v a
-- requires b > 1. supposes x > 0. if x == 0, the result is an empty vector.
digitsOfBaseV !b !x = VG.reverse $ digitsOfBaseRV b x
digitsOfBaseRV :: (Integral a, VG.Vector v a) => a -> a -> v a
-- requires b > 1. supposes x > 0. if x == 0, the result is an empty vector.
digitsOfBaseRV !b !x = VG.unfoldr step0 x
where
step0 !x0
| x0 == 0 = Nothing
| otherwise = Just (y0, x0')
where
(!x0', !y0) = divMod x0 b
digitsOfBaseN :: Integral a => a -> Int -> a -> [a]
-- n designates the minimal number of digits. supposes n > 0.
digitsOfBaseN !b !n !x = fst3 $ until done step0 ([], x, 0)
where
step0 (ys0, !x0, !i0) = (y0 : ys0, x0', i0')
where
(!x0', !y0) = divMod x0 b
!i0' = succ i0
done (_, !x0, !i0) = x0 == 0 && i0 >= n
digitsOfBaseNV :: (Integral a, VG.Vector v a) => a -> Int -> a -> v a
-- n designates the minimal number of digits. supposes n > 0.
digitsOfBaseNV !b !n !x = VG.reverse $ digitsOfBaseRNV b n x
digitsOfBaseRNV :: (Integral a, VG.Vector v a) => a -> Int -> a -> v a
-- n designates the minimal number of digits. supposes n > 0.
digitsOfBaseRNV !b !n !x = VG.unfoldrN n step0 x
where
step0 !x0 = Just (y0, x0')
where
(!x0', !y0) = divMod x0 b
binaryValue :: Bits a => [a] -> a
binaryValue = foldl' ((.|.) . (.<<. 1)) zeroBits
binaryValueV :: (Bits a, VG.Vector v a) => v a -> a
binaryValueV = VG.foldl' ((.|.) . (.<<. 1)) zeroBits
binaryDigits :: Bits a => a -> [a]
binaryDigits !x = fst $ until done0 step0 ([], x)
where
done0 (_, !x0) = x0 == zeroBits
step0 (ys0, !x0) = (y0 : ys0, x0')
where
!x0' = x0 .>>. 1
!y0 = x0 .&. bit 0
binaryDigitsR :: Bits a => a -> [a]
binaryDigitsR !x = unfoldr step0 x
where
step0 !x0
| x0 == zeroBits = Nothing
| otherwise = Just (y0, x0')
where
!x0' = x0 .>>. 1
!y0 = x0 .&. bit 0
binaryDigitsV :: (Bits a, VG.Vector v a) => a -> v a
binaryDigitsV = VG.reverse . binaryDigitsRV
binaryDigitsRV :: (Bits a, VG.Vector v a) => a -> v a
binaryDigitsRV !x = VG.unfoldr step0 x
where
step0 !x0
| x0 == zeroBits = Nothing
| otherwise = Just (y0, x0')
where
!x0' = x0 .>>. 1
!y0 = x0 .&. bit 0
binaryDigitsN :: Bits a => Int -> a -> [a]
-- n designates the minimal number of digits. supposes n > 0.
binaryDigitsN !n !x = fst3 $ until done step0 ([], x, 0)
where
step0 (ys0, !x0, !i0) = (y0 : ys0, x0', i0')
where
!x0' = x0 .>>. 1
!y0 = x0 .&. bit 0
!i0' = succ i0
done (_, !x0, !i0) = x0 == zeroBits && i0 >= n
binaryDigitsNV :: (Bits a, VG.Vector v a) => Int -> a -> v a
-- n designates the minimal number of digits. supposes n > 0.
binaryDigitsNV = VG.reverse .: binaryDigitsRNV
binaryDigitsRNV :: (Bits a, VG.Vector v a) => Int -> a -> v a
-- n designates the minimal number of digits. supposes n > 0.
binaryDigitsRNV !n !x = VG.unfoldrN n step0 x
where
step0 !x0 = Just (y0, x0')
where
!x0' = x0 .>>. 1
!y0 = x0 .&. bit 0
binaryDigitsCount :: FiniteBits a => a -> Int
-- requires x > 0.
-- the number of digits in binary representation of x.
binaryDigitsCount !x = finiteBitSize x - countLeadingZeros x
-- bool
-- note that Bits operators can be applied to Bool values since Bits Bool.
delta :: Num a => Bool -> a
-- group isomorphism from Bool to (Z/2Z, (+)).
delta = bool 0 1
invDelta :: (Eq a, Num a) => a -> Bool
invDelta 0 = False
invDelta 1 = True
invDelta _ = undefined
sign :: Num a => Bool -> a
-- group isomorphism from Bool to ([1, -1], (*)).
sign = bool 1 (-1)
invSign :: (Eq a, Num a) => a -> Bool
invSign (-1) = False
invSign 1 = True
invSign _ = undefined
-- group
class Monoid a => Group a where
invert :: a -> a
instance (Group a, Group b) => Group (a, b) where
invert (x, y) = (invert x, invert y)
instance Num a => Group (Sum a) where
invert (Sum x) = Sum (negate x)
-- unboxable
class Unboxable u e where
unbox :: e -> u
box :: u -> e
instance Unboxable Int Int where
unbox = id
box = id
instance Unboxable u e => Unboxable u (Sum e) where
unbox (Sum x) = unbox x
box x = Sum (box x)
instance Unboxable u e => Unboxable u (Product e) where
unbox (Product x) = unbox x
box x = Product (box x)
instance Unboxable u e => Unboxable u (Min e) where
unbox (Min x) = unbox x
box x = Min (box x)
instance Unboxable u e => Unboxable u (Max e) where
unbox (Max x) = unbox x
box x = Max (box x)
-- enum
enumFromStepTo :: Enum a => a -> Int -> a -> [a]
enumFromStepTo x i = enumFromThenTo x xnext
where
xnext = toEnum $ (+ i) $ fromEnum x
enumBetween :: Enum a => a -> a -> [a]
enumBetween x y
| ((<=) `on` fromEnum) x y = enumFromTo x y
| otherwise = enumFromThenTo x (pred x) y
-- ord
minOn :: Ord b => (a -> b) -> a -> a -> a
minOn f x y = minimumOn f [x, y]
maxOn :: Ord b => (a -> b) -> a -> a -> a
maxOn f x y = maximumOn f [x, y]
flipOrder :: Ordering -> Ordering
flipOrder LT = GT
flipOrder EQ = EQ
flipOrder GT = LT
isBetween :: Ord a => a -> a -> a -> Bool
isBetween xa xb x = min xa xb <= x && x <= max xa xb
-- binary search
binarySearch :: Integral a => (a -> Bool) -> (a, a) -> a
-- find the first x in [l .. u] which satisfies cond x.
-- requires that l <= u && cond u, and that cond is ‘monotonous’ in the following sense:
-- if cond x then cond (succ x).
binarySearch cond (!l, !u) = snd $ until done0 step0 (l, u)
where
done0 (!l0, !u0) = l0 == u0
-- invariant of step: cond u0.
step0 (!l0, !u0)
| cond m0 = (l0, m0)
| otherwise = (succ m0, u0)
where
!m0 = (l0 + u0) `div` 2
reverseBinarySearch :: Integral a => (a -> Bool) -> (a, a) -> a
-- find the last x in [l .. u] which satisfies cond x.
-- requires that l <= u && cond l, and that cond is ‘monotonous’ in the following sense:
-- if cond x then cond (pred x).
reverseBinarySearch cond (l, u) = l'
where
cond' x = cond $ u - x
u' = binarySearch cond' (0, u - l)
l' = u - u'
-- function
(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
(.:) = (.) . (.)
infixr 8 .:
(.:.) :: (d -> e) -> (a -> b -> c -> d) -> (a -> b -> c -> e)
(.:.) = (.) . (.:)
infixr 8 .:.
(.::) :: (e -> f) -> (a -> b -> c -> d -> e) -> (a -> b -> c -> d -> f)
(.::) = (.) . (.:.)
infixr 8 .::
applyN :: Int -> (a -> a) -> a -> a
applyN n f = go n
where
go 0 x0 = x0
go !n0 x0 = go n0' x0'
where
!n0' = pred n0
!x0' = f x0
const2 :: a -> b -> c -> a
const2 = const . const
const3 :: a -> b -> c -> d -> a
const3 = const . const . const
on3 :: (b -> b -> b -> c) -> (a -> b) -> a -> a -> a -> c
on3 f g x y z = f (g x) (g y) (g z)
infixl 0 `on3`
-- monad
join2 :: Monad m => m (m (m a)) -> m a
join2 = join . join
untilM :: Monad m => (a -> m Bool) -> (a -> m a) -> a -> m a
untilM condM stepM = goM
where
goM x0 = do
!b0 <- condM x0
if b0
then return x0
else do
!y0 <- stepM x0
goM y0
untilM_ :: Monad m => (a -> m Bool) -> (a -> m a) -> a -> m ()
untilM_ = void .:. untilM
untilLeft :: (a -> Either b a) -> a -> b
-- requires the step function returns a Left value eventually.
untilLeft = fromLeft undefined .: untilM (const (Right False))
untilNothingM :: Monad m => (a -> m (Maybe a)) -> a -> m ()
untilNothingM stepM = goM
where
goM = traverse_ goM <=< stepM
untilLeftM :: Monad m => (a -> m (Either b a)) -> a -> m b
untilLeftM stepM = goM
where
goM = either pure goM <=< stepM
-- maybe
mapNothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b
-- unfold for Maybe, essentially.
mapNothingIf = liftA2 $ bool Just $ const Nothing
mapJustIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b
mapJustIf = mapNothingIf . (not .)
nothingIf :: (a -> Bool) -> a -> Maybe a
nothingIf = (`mapNothingIf` id)
justIf :: (a -> Bool) -> a -> Maybe a
justIf = (`mapJustIf` id)
justOtherThan :: Eq a => a -> a -> Maybe a
justOtherThan = nothingIf . (==)
-- either
eitherFromMaybe :: a -> Maybe b -> Either a b
eitherFromMaybe x = maybe (Left x) Right
eitherIf :: a -> b -> Bool -> Either b a
eitherIf x y = bool (Left y) (Right x)
-- either 3
data Either3 a b c = Left3 a | Middle3 b | Right3 c
deriving (Eq, Ord, Show)
either3 :: (a -> d) -> (b -> d) -> (c -> d) -> Either3 a b c -> d
either3 f _ _ (Left3 x) = f x
either3 _ g _ (Middle3 y) = g y
either3 _ _ h (Right3 z) = h z
either3FromOrdering :: a -> b -> c -> Ordering -> Either3 a b c
either3FromOrdering x _ _ LT = Left3 x
either3FromOrdering _ y _ EQ = Middle3 y
either3FromOrdering _ _ z GT = Right3 z
instance (Renderable a, Renderable b, Renderable c) => Renderable (Either3 a b c) where
renderBS = either3 renderBS renderBS renderBS
-- default way of reading. declare a customized instance if the other way is needed.
instance (Readable a, Readable b , Readable c) => Readable (Either3 a b c) where
readBSM = do
!t <- readTypeIdM
case t of
1 -> Left3 <$> readBSM
2 -> Middle3 <$> readBSM
3 -> Right3 <$> readBSM
_ -> undefined
partitionEithers3 :: [Either3 a b c] -> ([a], [b], [c])
partitionEithers3 = foldr (either3 fl fm fr) ([], [], [])
where
fl = first3 . (:)
fm = second3 . (:)
fr = third3 . (:)
lefts3 :: [Either3 a b c] -> [a]
lefts3 = fst3 . partitionEithers3
middles3 :: [Either3 a b c] -> [b]
middles3 = snd3 . partitionEithers3
rights3 :: [Either3 a b c] -> [c]
rights3 = thd3 . partitionEithers3
-- IO (Readable)
class Readable a where
readBS :: B.ByteString -> Maybe (a, B.ByteString)
readBS = runStateT readBSM
readBSM :: StateT B.ByteString Maybe a
readBSM = StateT readBS
instance Readable () where
readBSM = pure ()
instance Readable Int where
readBS = B.readInt . B.dropSpace
instance Readable Integer where
readBS = B.readInteger . B.dropSpace
instance Readable Double where
readBSM = read <$> readBSM
instance Readable Char where
readBS = B.uncons . B.dropSpace
instance Readable B.ByteString where
readBS bs
| B.null bs' = Nothing
| otherwise = Just $ B.break isSpace bs'
where
bs' = B.dropSpace bs
instance {-# OVERLAPS #-} Readable String where
readBSM = B.unpack <$> readBSM
instance Readable a => Readable [a] where
readBS bs = Just (xs, B.empty)
where
xs = unfoldr readBS bs
instance Readable a => Readable (V.Vector a) where
readBS bs = Just (xs, B.empty)
where
xs = VG.unfoldr readBS bs
instance (Readable a, VU.Unbox a) => Readable (VU.Vector a) where
readBS bs = Just (xs, B.empty)
where
xs = VG.unfoldr readBS bs
instance (Readable a, Readable b) => Readable (a, b) where
readBSM = liftA2 (,) readBSM readBSM
instance (Readable a, Readable b, Readable c) => Readable (a, b, c) where
readBSM = liftA3 (,,) readBSM readBSM readBSM
instance (Readable a, Readable b, Readable c, Readable d) => Readable (a, b, c, d) where
readBSM = (,,,) <$> readBSM <*> readBSM <*> readBSM <*> readBSM
-- default way of reading. declare a customized instance if the other way is needed.
instance (Readable a, Readable b) => Readable (Either a b) where
readBSM = do
!t <- readTypeIdM
case t of
1 -> Left <$> readBSM
2 -> Right <$> readBSM
_ -> undefined
readTypeIdM :: StateT B.ByteString Maybe Int
readTypeIdM = readBSM
discardLineIO :: IO ()
discardLineIO = void B.getLine
readRA :: Readable a => B.ByteString -> a
-- requires the argument is readable as a value of type a.
readRA = fromJust . evalStateT readBSM -- should be Just
getLineIO :: Readable a => IO a
getLineIO = readRA <$> B.getLine
class Replicatable l a where
replicateRA :: Monad m => Int -> m a -> m (l a)
instance Replicatable [] a where
replicateRA = replicateM
instance Replicatable V.Vector a where
replicateRA = VG.replicateM
instance VU.Unbox a => Replicatable VU.Vector a where
replicateRA = VG.replicateM
getLinesIO :: (Readable a, Replicatable l a) => Int -> IO (l a)
getLinesIO = (`replicateRA` getLineIO)
getParagraphsIO :: (Readable a, Replicatable l a) => Int -> IO a -> IO (l a)
getParagraphsIO = replicateRA
readBSN :: (Readable a, Replicatable l a) => Int -> B.ByteString -> Maybe (l a, B.ByteString)
readBSN = runStateT . readBSNM
readBSNM :: (Readable a, Replicatable l a) => Int -> StateT B.ByteString Maybe (l a)
readBSNM = (`replicateRA` readBSM)
-- IO (Renderable)
class Renderable a where
renderBS :: a -> BB.Builder
-- default rendering. use eitherIf if other rendering is needed.
instance Renderable Bool where
renderBS True = renderBS $ B.pack "Yes"
renderBS False = renderBS $ B.pack "No"
instance Renderable Int where
renderBS = BB.intDec
instance Renderable Integer where
renderBS = BB.integerDec
instance Renderable Double where
renderBS = BB.doubleDec
instance Renderable Char where
renderBS = BB.charUtf8
instance Renderable B.ByteString where
renderBS = BB.byteString
instance Renderable BB.Builder where
renderBS = id
instance {-# OVERLAPS #-} Renderable String where
renderBS = BB.stringUtf8
-- default rendering. use eitherFromMaybe if other rendering is needed.
instance Renderable a => Renderable (Maybe a) where
renderBS Nothing = renderBS $ B.pack "-1"
renderBS (Just x) = renderBS x
instance Renderable a => Renderable [a] where
renderBS xs = case xs of
[] -> mempty
[x] -> renderBS x
(x : xs') -> renderBS x <> renderBS ' ' <> renderBS xs'
instance Renderable a => Renderable (V.Vector a) where
renderBS xs = case VG.uncons xs of
Nothing -> mempty
Just (x, xs')
| VG.null xs' -> renderBS x
| otherwise -> renderBS x <> renderBS ' ' <> renderBS xs'
instance (Renderable a, VU.Unbox a) => Renderable (VU.Vector a) where
renderBS xs = case VG.uncons xs of
Nothing -> mempty
Just (x, xs')
| VG.null xs' -> renderBS x
| otherwise -> renderBS x <> renderBS ' ' <> renderBS xs'
instance (Renderable a, Renderable b) => Renderable (a, b) where
renderBS (x, y) = renderBS x <> renderBS ' ' <> renderBS y
instance (Renderable a, Renderable b, Renderable c) => Renderable (a, b, c) where
renderBS (x, y, z) = renderBS x <> renderBS ' ' <> renderBS y <> renderBS ' ' <> renderBS z
instance (Renderable a, Renderable b) => Renderable (Either a b) where
renderBS = either renderBS renderBS
deriving instance Renderable a => Renderable (Down a)
deriving instance Renderable a => Renderable (Sum a)
deriving instance Renderable a => Renderable (Product a)
deriving instance Renderable a => Renderable (Max a)
deriving instance Renderable a => Renderable (Min a)
addNewLine :: BB.Builder -> BB.Builder
addNewLine = (<> renderBS '\n')
flushIO :: IO ()
flushIO = hFlush stdout
putBuilderIO :: BB.Builder -> IO ()
putBuilderIO = (>> flushIO) . BB.hPutBuilder stdout
putLineIO :: Renderable a => a -> IO ()
putLineIO = putLineWithIO id
putLineWithIO :: Renderable b => (a -> b) -> a -> IO ()
putLineWithIO f = putBuilderIO . addNewLine . renderBS . f
class Concatenatable l a where
concatMapCA :: Monoid m => (a -> m) -> l a -> m
instance Concatenatable [] a where
concatMapCA = foldMap
instance Concatenatable V.Vector a where
concatMapCA = VG.foldMap'
instance VU.Unbox a => Concatenatable VU.Vector a where
concatMapCA = VG.foldMap'
putLinesIO :: (Renderable a, Concatenatable l a) => l a -> IO ()
putLinesIO = putLinesWithIO id
putLinesWithIO :: (Renderable b, Concatenatable l a) => (a -> b) -> l a -> IO ()
putLinesWithIO f = putBuilderIO . concatMapCA (addNewLine . renderBS . f)
putParagraphsIO :: (Renderable a, Concatenatable l a) => l a -> (a -> IO ()) -> IO ()
putParagraphsIO = flip concatMapCA
-- for interactive problems ...
askLineIO :: (Renderable a, Readable b) => a -> IO b
askLineIO x = do
putLineIO ('?', x)
getLineIO
tellLineIO :: Renderable a => a -> IO ()
tellLineIO x = do
putLineIO ('!', x)
Submission Info
Compile Error
Configuration is affected by the following files:
- cabal.project
- cabal.project.freeze
- cabal.project.local
Configuration is affected by the following files:
- cabal.project
- cabal.project.freeze
- cabal.project.local
Judge Result
| Set Name |
Sample |
All |
| Score / Max Score |
0 / 0 |
200 / 200 |
| Status |
|
|
| Set Name |
Test Cases |
| Sample |
sample01.txt, sample02.txt, sample03.txt |
| All |
sample01.txt, sample02.txt, sample03.txt, in01.txt, in02.txt, in03.txt, in04.txt, in05.txt, in06.txt, in07.txt, in08.txt, in09.txt, in10.txt, in11.txt, in12.txt, in13.txt, in14.txt, in15.txt, in16.txt, in17.txt, in18.txt, in19.txt, in20.txt, in21.txt, in22.txt, in23.txt, in24.txt, in25.txt, in26.txt, in27.txt, in28.txt, in29.txt, in30.txt, in31.txt, in32.txt, in33.txt, in34.txt, in35.txt, in36.txt, in37.txt, in38.txt, in39.txt, in40.txt, in41.txt, in42.txt, in43.txt, in44.txt, in45.txt, in46.txt, in47.txt, in48.txt, in49.txt, in50.txt, in51.txt, in52.txt, in53.txt, in54.txt, in55.txt, in56.txt, in57.txt, in58.txt, in59.txt, in60.txt, in61.txt, in62.txt, in63.txt, in64.txt, in65.txt, in66.txt, in67.txt, in68.txt, in69.txt, in70.txt, in71.txt, in72.txt, in73.txt, in74.txt, in75.txt, in76.txt, in77.txt, in78.txt, in79.txt, in80.txt, in81.txt, in82.txt, in83.txt, in84.txt, in85.txt |
| Case Name |
Status |
Exec Time |
Memory |
| in01.txt |
AC |
21 ms |
8860 KiB |
| in02.txt |
AC |
2 ms |
8644 KiB |
| in03.txt |
AC |
2 ms |
8796 KiB |
| in04.txt |
AC |
2 ms |
8808 KiB |
| in05.txt |
AC |
2 ms |
8688 KiB |
| in06.txt |
AC |
2 ms |
8816 KiB |
| in07.txt |
AC |
2 ms |
8820 KiB |
| in08.txt |
AC |
23 ms |
17696 KiB |
| in09.txt |
AC |
2 ms |
8852 KiB |
| in10.txt |
AC |
2 ms |
9008 KiB |
| in11.txt |
AC |
22 ms |
17764 KiB |
| in12.txt |
AC |
22 ms |
17852 KiB |
| in13.txt |
AC |
2 ms |
8852 KiB |
| in14.txt |
AC |
2 ms |
9052 KiB |
| in15.txt |
AC |
2 ms |
8984 KiB |
| in16.txt |
AC |
22 ms |
17724 KiB |
| in17.txt |
AC |
23 ms |
17644 KiB |
| in18.txt |
AC |
21 ms |
17504 KiB |
| in19.txt |
AC |
21 ms |
17764 KiB |
| in20.txt |
AC |
2 ms |
8800 KiB |
| in21.txt |
AC |
2 ms |
8772 KiB |
| in22.txt |
AC |
22 ms |
17604 KiB |
| in23.txt |
AC |
22 ms |
17520 KiB |
| in24.txt |
AC |
20 ms |
17400 KiB |
| in25.txt |
AC |
21 ms |
17472 KiB |
| in26.txt |
AC |
22 ms |
17828 KiB |
| in27.txt |
AC |
21 ms |
17584 KiB |
| in28.txt |
AC |
21 ms |
17580 KiB |
| in29.txt |
AC |
22 ms |
17580 KiB |
| in30.txt |
AC |
20 ms |
17548 KiB |
| in31.txt |
AC |
21 ms |
17548 KiB |
| in32.txt |
AC |
2 ms |
8876 KiB |
| in33.txt |
AC |
2 ms |
8752 KiB |
| in34.txt |
AC |
2 ms |
8816 KiB |
| in35.txt |
AC |
2 ms |
8724 KiB |
| in36.txt |
AC |
2 ms |
8864 KiB |
| in37.txt |
AC |
2 ms |
8852 KiB |
| in38.txt |
AC |
2 ms |
8900 KiB |
| in39.txt |
AC |
2 ms |
8852 KiB |
| in40.txt |
AC |
22 ms |
17764 KiB |
| in41.txt |
AC |
2 ms |
8752 KiB |
| in42.txt |
AC |
2 ms |
9084 KiB |
| in43.txt |
AC |
2 ms |
8984 KiB |
| in44.txt |
AC |
2 ms |
8740 KiB |
| in45.txt |
AC |
21 ms |
17492 KiB |
| in46.txt |
AC |
22 ms |
17544 KiB |
| in47.txt |
AC |
2 ms |
9100 KiB |
| in48.txt |
AC |
2 ms |
8752 KiB |
| in49.txt |
AC |
2 ms |
8744 KiB |
| in50.txt |
AC |
2 ms |
8852 KiB |
| in51.txt |
AC |
2 ms |
8956 KiB |
| in52.txt |
AC |
22 ms |
17560 KiB |
| in53.txt |
AC |
2 ms |
8996 KiB |
| in54.txt |
AC |
2 ms |
9496 KiB |
| in55.txt |
AC |
22 ms |
17496 KiB |
| in56.txt |
AC |
13 ms |
15912 KiB |
| in57.txt |
AC |
2 ms |
9520 KiB |
| in58.txt |
AC |
2 ms |
9588 KiB |
| in59.txt |
AC |
2 ms |
8948 KiB |
| in60.txt |
AC |
2 ms |
9008 KiB |
| in61.txt |
AC |
2 ms |
8724 KiB |
| in62.txt |
AC |
2 ms |
8828 KiB |
| in63.txt |
AC |
22 ms |
17560 KiB |
| in64.txt |
AC |
22 ms |
17552 KiB |
| in65.txt |
AC |
2 ms |
8988 KiB |
| in66.txt |
AC |
22 ms |
17852 KiB |
| in67.txt |
AC |
2 ms |
8984 KiB |
| in68.txt |
AC |
2 ms |
8772 KiB |
| in69.txt |
AC |
2 ms |
9100 KiB |
| in70.txt |
AC |
2 ms |
8984 KiB |
| in71.txt |
AC |
2 ms |
8752 KiB |
| in72.txt |
AC |
2 ms |
8680 KiB |
| in73.txt |
AC |
2 ms |
8852 KiB |
| in74.txt |
AC |
2 ms |
8908 KiB |
| in75.txt |
AC |
2 ms |
8972 KiB |
| in76.txt |
AC |
2 ms |
9012 KiB |
| in77.txt |
AC |
2 ms |
9084 KiB |
| in78.txt |
AC |
2 ms |
8792 KiB |
| in79.txt |
AC |
2 ms |
8820 KiB |
| in80.txt |
AC |
2 ms |
8756 KiB |
| in81.txt |
AC |
2 ms |
8880 KiB |
| in82.txt |
AC |
2 ms |
8756 KiB |
| in83.txt |
AC |
2 ms |
8808 KiB |
| in84.txt |
AC |
22 ms |
17604 KiB |
| in85.txt |
AC |
22 ms |
17568 KiB |
| sample01.txt |
AC |
2 ms |
8648 KiB |
| sample02.txt |
AC |
2 ms |
8776 KiB |
| sample03.txt |
AC |
2 ms |
8784 KiB |