{-# LANGUAGE BangPatterns #-} -- | This module addresses the specialized algorithmic problem of module Data.RangeMin ( -- * Comparison function types LEq, Comparator, -- * General range min operations RangeMin, rangeMinBy, rangeMin, -- ** Stable versions stableRangeMinBy, stableRangeMin, -- * Specialized 'G.Vector' range min operations vecRangeMinBy, vecRangeMin, -- ** Stable versions stableVecRangeMinBy, stableVecRangeMin) where import Data.RangeMin.Common.Types import qualified Data.Vector.Generic as G import qualified Data.RangeMin.Quadratic as N2 import qualified Data.RangeMin.Linearithmic as Nlogn import qualified Data.RangeMin.Linear as N type Comparator a = a -> a -> Ordering type RangeMin = Int -> Int -> Int {-# INLINE internalRangeMinBy #-} internalRangeMinBy :: SliceMin -> Int -> RangeMin internalRangeMinBy sM !n = \ i m -> runRM rM i (i+m) where !rM | n <= 8 = N2.rangeMin (runSliceMin sM 0) n | n <= 600 = Nlogn.rangeMin (runSliceMin sM 0) n | otherwise = N.rangeMin sM n {-# INLINE stable #-} stable :: (Int -> a) -> Comparator a -> MinIx stable look cmp = toMinIx $ \ i j -> case cmp (look i) (look j) of EQ -> i <= j LT -> True GT -> False {-# INLINE rangeMinBy #-} -- | Given a lookup function and a @(<=)@ comparison function, returns a function -- which takes a starting index @i@ and a range length @n@ and returns the index -- of a minimum element from the indices @a..a+n-1@. (For example, if @rM@ is the -- returned 'RangeMin' function, then the minimum element in the range @5..10@ is -- @rM 5 6@.) -- -- This method /does not do bounds checking/, and further makes no guarantees as to how -- ties are broken. Both of these guarantees /are/ made by 'stableRangeMinBy'. -- -- This function does /O(n)/ preprocessing, assuming that the lookup function is /O(1)/, -- but the returned 'RangeMin' function runs in /O(1)/. -- Thus, this function is suited for making frequent range-min queries. -- -- To make range-max queries, substitute @(>=)@ for @(<=)@. rangeMinBy :: LEq a -> Int -> (Int -> a) -> RangeMin rangeMinBy (<=?) n look = internalRangeMinBy sM n where sM = toSliceMin $ \ !off -> toMinIx $ \ i j -> look (i+off) <=? look (j+off) {-# INLINE rangeMin #-} -- | Equivalent to @'rangeMinBy' ('<=')@. rangeMin :: Ord a => Int -> (Int -> a) -> RangeMin rangeMin = rangeMinBy (<=) {-# INLINE stableRangeMinBy #-} -- | Equivalent to 'rangeMinBy', except that it breaks ties by picking the element which comes first, -- and provides bounds checking. This comes with some overhead, but has the same asymptotic guarantees. stableRangeMinBy :: Comparator a -> Int -> (Int -> a) -> RangeMin stableRangeMinBy cmp !n look = \ i m -> if i < 0 || m <= 0 || i+m > n then error "Error: bad range arguments to stableRangeMinBy" else rM i m where !rM = internalRangeMinBy sM n sM = toSliceMin $ \ !off -> stable (look . (off +)) cmp {-# INLINE stableRangeMin #-} -- | Equivalent to @'stableRangeMinBy' 'compare'@. stableRangeMin :: Ord a => Int -> (Int -> a) -> RangeMin stableRangeMin = stableRangeMinBy compare {-# INLINE [1] vecRangeMinBy #-} -- | @'vecRangeMinBy' (<=) xs@ is equivalent to @'rangeMinBy' (<=) ('G.length' xs) (xs 'G.!')@, -- but can frequently optimize better, especially on unboxed vectors. vecRangeMinBy :: G.Vector v a => LEq a -> v a -> RangeMin vecRangeMinBy (<=?) !xs = internalRangeMinBy sM n where !n = G.length xs sM = toSliceMin $ \ !off -> let {-# NOINLINE slice #-} !slice = G.unsafeDrop off xs look = G.unsafeIndex slice in toMinIx $ \ i j -> look i <=? look j {-# INLINE [1] vecRangeMin #-} -- | Equivalent to @'vecRangeMinBy' ('<=')@. vecRangeMin :: (G.Vector v a, Ord a) => v a -> Int -> Int -> Int vecRangeMin = vecRangeMinBy (<=) {-# INLINE stableVecRangeMinBy #-} -- | @'stableVecRangeMinBy' cmp xs@ is equivalent to @'stableRangeMinBy' cmp ('G.length' xs) (xs 'G.!')@, -- but can frequently optimize better, especially on unboxed vectors. stableVecRangeMinBy :: (G.Vector v a) => Comparator a -> v a -> RangeMin stableVecRangeMinBy cmp !xs = internalRangeMinBy sM n where !n = G.length xs sM = toSliceMin $ \ !off -> let {-# NOINLINE slice #-} !slice = G.unsafeDrop off xs look = G.unsafeIndex slice in stable look cmp {-# INLINE stableVecRangeMin #-} -- | 'stableVecRangeMin' is equivalent to @'stableVecRangeMinBy' 'compare'@. stableVecRangeMin :: (G.Vector v a, Ord a) => v a -> RangeMin stableVecRangeMin = stableVecRangeMinBy compare