{-# LANGUAGE CPP, BangPatterns #-} -- | Consider the following function, which, given 'i' and 'k', finds the index of -- the minimum element in the range @i..i+k-1@. -- -- @ -- rangeMin :: 'G.Vector' v a => (a -> a -> 'Ordering') -> v a -> 'Int' -> 'Int' -> 'Int' -- rangeMin cmp xs i k = i + 'G.minIndexBy' cmp ('G.slice' i k xs) -- @ -- -- This module implements functions which, given a fixed comparison function, preprocess -- an array in /O(n)/ time to support queries of this form in /O(1)/ time. -- -- For all methods in this module, ties are broken by which element comes first in the array. -- -- When certain methods are called on an element type which has a natural, order-preserving -- injection into 'Int' -- specifically, on instances of 'Injective' -- this module is -- smart enough to (fusibly) convert the vector into a @'PV.Vector' 'Int'@, and to use -- 'unsafeIntRangeMin' or 'intRangeMin' as appropriate. Though you cannot make your -- own instances of 'Injective', 'unsafeInjectRangeMin' and 'injectRangeMin' work the same -- way. module Data.RangeMin ( -- * Utility types RangeMin, LEq, Index, Length, -- * Specialized range-mins unsafeIntRangeMin, intRangeMin, -- * @Vector@ range-mins unsafeVecRangeMinBy, unsafeVecRangeMin, unsafeVecRangeMax, vecRangeMinBy, vecRangeMin, vecRangeMax, -- * General range-mins unsafeRangeMinBy, unsafeRangeMin, unsafeRangeMax, rangeMinBy, rangeMin, rangeMax, -- * Specialized types Injective, unsafeInjectRangeMin, injectRangeMin) where import Control.Exception import Data.RangeMin.Common import qualified Data.RangeMin.Int.Linear as N import qualified Data.RangeMin.Int.NearLinear as NearN import qualified Data.RangeMin.Int.Linearithmic as Nlogn import qualified Data.RangeMin.Int.Quadratic as N2 import Data.RangeMin.Cartesian.Spec import qualified Data.Vector as V import qualified Data.Vector.Primitive as PV import qualified Data.Vector.Generic as G negativeStart :: Int -> String negativeStart i = "Data.RangeMin: starting index " ++ shows i " must be nonnegative" nonPositiveWidth :: Int -> String nonPositiveWidth m = "Data.RangeMin: query width " ++ shows m " must be positive" outOfBoundsQuery :: Int -> Int -> Int -> String outOfBoundsQuery n i m = "Data.RangeMin: query " ++ shows (i, m) (" is too big for a vector of size " ++ show n) checkBounds :: Int -> (Int -> Int -> a) -> Int -> Int -> a checkBounds !n f !i !m | i < 0 = throw (IndexOutOfBounds (negativeStart i)) | m < 1 = throw (IndexOutOfBounds (nonPositiveWidth m)) | i + m > n = throw (IndexOutOfBounds (outOfBoundsQuery n i m)) | otherwise = f i m internalIntRangeMin :: PV.Vector Int -> RM internalIntRangeMin !xs | n <= n2Cross = N2.rangeMin xs | n <= nlognCross = Nlogn.rangeMin xs | n <= nearNCross = NearN.rangeMin xs | otherwise = N.rangeMin xs where !n = PV.length xs -- | /O(n)/. Returns a range-min function on the vector, under the natural ordering of 'Int'. -- This function can be, depending on the 'G.Vector' implementation, three to four -- times as fast as @'unsafeVecRangeMinBy' ('<=')@. -- -- Example: -- -- @ -- 'unsafeIntRangeMin' ('PV.fromList' [0,7,-10,4,5,4]) 0 6 == 2 -- 'unsafeIntRangeMin' ('PV.fromList' [0,7,-10,4,5,4]) 2 3 == 2 -- 'unsafeIntRangeMin' ('PV.fromList' [0,7,-10,4,5,4]) 3 3 == 3 -- @ -- -- The returned function /does not/ do bounds checks. If @n@ is the length of the vector, -- and @i@ and @m@ are passed as arguments to the 'RangeMin', then if @i < 0@, @m < 1@, or -- @i + m > n@, a segfault may occur. unsafeIntRangeMin :: PV.Vector Int -- ^ A vector of 'Int's. -> RangeMin -- ^ A range-min function on the vector which runs in /O(1)/. unsafeIntRangeMin xs = runRM (internalIntRangeMin xs) -- | /O(n)/. Returns a range-min function on the vector, with the natural ordering of 'Int'. -- This function can be, depending on the 'G.Vector' implementation, three to four -- times as fast as @'vecRangeMinBy' ('<=')@. -- -- Equivalent to 'unsafeIntRangeMin', except that the returned function /does/ do bounds checks. -- When it receives a bad query, it throws an 'ArrayException'. intRangeMin :: PV.Vector Int -- ^ A vector of 'Int's. -> RangeMin -- ^ A range-min function on the vector which runs in /O(1)/. intRangeMin !xs = let !rM = internalIntRangeMin xs in checkBounds (PV.length xs) (runRM rM) {-# INLINE [1] unsafeVecRangeMinBy #-} -- | /O(n)/. Returns a range-min function on the vector, under the specified ordering. -- The returned function /does not/ do bounds checks; see 'unsafeIntRangeMin' for details. -- -- Example: -- -- @ -- -- Finding the element with the /largest absolute value/ in a subrange. -- 'unsafeVecRangeMinBy' (\\ i j -> 'abs' i '>=' 'abs' j) ('PV.fromList' [0,7,-10,4,5,4]) 0 6 == 2 -- 'unsafeVecRangeMinBy' (\\ i j -> 'abs' i '>=' 'abs' j) ('PV.fromList' [0,7,-10,4,5,4]) 2 3 == 2 -- 'unsafeVecRangeMinBy' (\\ i j -> 'abs' i '>=' 'abs' j) ('PV.fromList' [0,7,-10,4,5,4]) 3 3 == 4 -- @ -- unsafeVecRangeMinBy :: G.Vector v a => LEq a -- ^ A total ordering on the type @a@. -> v a -- ^ A vector of elements of type @a@. -> RangeMin -- ^ A range-min function on the vector which runs in /O(1)/. unsafeVecRangeMinBy (<=?) !xs = unsafeIntRangeMin (equivVectorBy (<=?) xs) {-# INLINE unsafeVecRangeMin #-} -- | /O(n)/. Equivalent to @'unsafeVecRangeMinBy' ('<=')@. Specialized for instances of 'Injective'. -- The returned function /does not/ do bounds checks; see 'unsafeIntRangeMin' for details. -- -- Example: -- -- @ -- -- In reality, these would be rewritten into calls to 'unsafeIntRangeMin', since 'Char' is an -- -- instance of 'Injective'. -- 'unsafeVecRangeMin' ('PV.fromList' \"banana\") 0 6 == 1 -- 'unsafeVecRangeMin' ('PV.fromList' \"banana\") 1 1 == 1 -- 'unsafeVecRangeMin' ('PV.fromList' \"banana\") 3 3 == 3 -- @ unsafeVecRangeMin :: (G.Vector v a, Ord a) => v a -- ^ A vector of elements of type @a@. -> RangeMin -- ^ A range-min function (under the natural ordering) -- on the vector which runs in /O(1)/. unsafeVecRangeMin xs = unsafeIntRangeMin (equivVectorMin xs) {-# INLINE unsafeVecRangeMax #-} -- | /O(n)/. Equivalent to @'unsafeVecRangeMinBy' ('>=')@. Specialized for instances of 'Injective'. -- The returned function /does not/ do bounds checks; see 'unsafeIntRangeMin' for details. -- -- Example: -- -- @ -- -- In reality, these would be rewritten into calls to 'unsafeIntRangeMin', since 'Char' -- -- is an instance of 'Injective'. -- 'unsafeVecRangeMax' ('PV.fromList' \"banana\") 0 6 == 2 -- 'unsafeVecRangeMax' ('PV.fromList' \"banana\") 1 1 == 1 -- 'unsafeVecRangeMax' ('PV.fromList' \"banana\") 3 3 == 4 -- @ unsafeVecRangeMax :: (G.Vector v a, Ord a) => v a -- ^ A vector of elements of type @a@. -> RangeMin -- ^ A range-max function (under the natural ordering) -- on the vector which runs in /O(1)/. unsafeVecRangeMax = unsafeIntRangeMin . equivVectorMax {-# INLINE [1] vecRangeMinBy #-} -- | /O(n)/. Returns a range-min function on the vector, under the specified ordering. -- The returned function /does/ do bounds checks; see 'intRangeMin' for details. vecRangeMinBy :: G.Vector v a => LEq a -- ^ A total ordering on the type @a@. -> v a -- ^ A vector of elements of type @a@. -> RangeMin -- ^ A range-min function on the vector which runs in /O(1)/. vecRangeMinBy (<=?) xs = intRangeMin (equivVectorBy (<=?) xs) {-# INLINE vecRangeMin #-} -- | /O(n)/. Equivalent to @'vecRangeMinBy' ('<=')@; a safer version of 'unsafeVecRangeMin'. -- Specialized for instances of 'Injective'. The returned function /does/ do bounds checks; -- see 'intRangeMin' for details. vecRangeMin :: (G.Vector v a, Ord a) => v a -- ^ A vector of elements of type @a@. -> RangeMin -- ^ A range-min function (under the natural ordering) -- on the vector which runs in /O(1)/. vecRangeMin xs = intRangeMin (equivVectorMin xs) {-# INLINE vecRangeMax #-} -- | /O(n)/. Equivalent to @'vecRangeMinBy' ('>=')@; a safer version of 'unsafeVecRangeMax'. -- Specialized for instances of 'Injective'. The returned function /does/ do bounds checks; -- see 'intRangeMin' for details. vecRangeMax :: (G.Vector v a, Ord a) => v a -- ^ A vector of elements of type @a@. -> RangeMin -- ^ A range-max function (under the natural ordering) -- on the vector which runs in /O(1)/. vecRangeMax xs = intRangeMin (equivVectorMax xs) {-# INLINE unsafeRangeMinBy #-} -- | /O(n)/. @'unsafeRangeMinBy' (<=?) n look@ is equivalent to -- @'unsafeVecRangeMinBy' (<=?) ('V.generate' n look)@. -- The returned function /does not/ do bounds checks; see 'unsafeIntRangeMin' for details. unsafeRangeMinBy :: LEq a -- ^ A total ordering on the type @a@. -> Length -- ^ The number of elements to generate. -> (Index -> a) -- ^ A function to generate the element at each index. -> RangeMin -- ^ A range-min function on the elements which runs in /O(1)/. unsafeRangeMinBy (<=?) !n look = unsafeVecRangeMinBy (<=?) (V.generate n look) {-# INLINE unsafeRangeMin #-} -- | /O(n)/. Equivalent to @'unsafeRangeMinBy' ('<=')@. Specialized for instances of 'Injective'. -- The returned function /does not/ do bounds checks; see 'unsafeIntRangeMin' for details. unsafeRangeMin :: Ord a => Length -- ^ The number of elements to generate. -> (Index -> a) -- ^ A function to generate the element at each index. -> RangeMin -- ^ A range-min function on the elements (under their natural ordering) -- which runs in /O(1)/. unsafeRangeMin n look = unsafeVecRangeMin (V.generate n look) {-# INLINE unsafeRangeMax #-} -- | /O(n)/. Equivalent to @'unsafeRangeMinBy' ('>=')@. Specialized for instances of 'Injective'. -- The returned function /does not/ do bounds checks; see 'unsafeIntRangeMin' for details. unsafeRangeMax :: Ord a => Length -- ^ The number of elements to generate. -> (Index -> a) -- ^ A function to generate the element at each index. -> RangeMin -- ^ A range-max function on the elements (under their natural ordering) -- which runs in /O(1)/. unsafeRangeMax n look = unsafeVecRangeMax (V.generate n look) {-# INLINE rangeMinBy #-} -- | /O(n)/. @'rangeMinBy' (<=?) n look@ is equivalent to -- @'vecRangeMinBy' (<=?) ('V.generate' n look)@, and is a safer version of -- @'unsafeRangeMinBy' (<=?) n look@. The returned function /does/ do bounds checks; see -- 'intRangeMin' for details. rangeMinBy :: LEq a -- ^ A total ordering on the type @a@. -> Length -- ^ The number of elements to generate. -> (Index -> a) -- ^ A function to generate the element at each index. -> RangeMin -- ^ A range-min function on the elements which runs in /O(1)/. rangeMinBy (<=?) !n look = vecRangeMinBy (<=?) (V.generate n look) {-# INLINE rangeMin #-} -- | /O(n)/. Equivalent to @'rangeMinBy' ('<=')@, and a safer version of 'unsafeRangeMin'. -- Specialized for instances of 'Injective'. -- The returned function /does/ do bounds checks; see 'intRangeMin' for details. rangeMin :: Ord a => Length -- ^ The number of elements to generate. -> (Index -> a) -- ^ A function to generate the element at each index. -> RangeMin -- ^ A range-min function on the elements (under their natural ordering) -- which runs in /O(1)/. rangeMin n look = vecRangeMin (V.generate n look) {-# INLINE rangeMax #-} -- | /O(n)/. Equivalent to @'rangeMinBy' ('>=')@, and a safer version of 'unsafeRangeMax'. -- Specialized for instances of 'Injective'. -- The returned function /does/ do bounds checks; see 'intRangeMin' for details. rangeMax :: Ord a => Length -- ^ The number of elements to generate. -> (Index -> a) -- ^ A function to generate the element at each index. -> RangeMin -- ^ A range-max function on the elements (under their natural ordering) -- which runs in /O(1)/. rangeMax n look = vecRangeMax (V.generate n look) {-# INLINE unsafeInjectRangeMin #-} -- | /O(n)/. @'unsafeInjectRangeMin' inject xs@ is equivalent to -- @'unsafeVecRangeMinBy' (\\ x y -> inject x '<=' inject y) xs@, but is frequently much faster, -- fusing with the input vector and converting it directly to a @'PV.Vector' 'Int'@. -- The returned function /does not/ do bounds checks; see 'unsafeIntRangeMin' for details. unsafeInjectRangeMin :: G.Vector v a => (a -> Int) -> v a -> RangeMin unsafeInjectRangeMin inject xs = unsafeIntRangeMin (G.unstream (fmap inject (G.stream xs))) {-# INLINE injectRangeMin #-} -- | /O(n)/. @'injectRangeMin' inject xs@ is equivalent to -- @'vecRangeMinBy' (\\ x y -> inject x '<=' inject y) xs@, but is frequently much faster, -- fusing with the input vector and converting it directly to a @'PV.Vector' 'Int'@. -- The returned function /does/ do bounds checks; see 'intRangeMin' for details. injectRangeMin :: G.Vector v a => (a -> Int) -> v a -> RangeMin injectRangeMin inject xs = intRangeMin (G.unstream (fmap inject (G.stream xs)))