{-# LANGUAGE BangPatterns #-} module Data.RangeMin.Generic ( unsafeRangeMinBy, unsafeRangeMin, unsafeRangeMax, rangeMinBy, rangeMin, rangeMax) where import Data.RangeMin.Common import Data.RangeMin.Vector import qualified Data.Vector as V {-# 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)/. {-# 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)/. {-# 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)/. {-# 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)/. {-# 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)/. {-# 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)/. unsafeRangeMinBy (<=?) !n look = unsafeVecRangeMinBy (<=?) (V.generate n look) unsafeRangeMin n look = unsafeVecRangeMin (V.generate n look) unsafeRangeMax n look = unsafeVecRangeMax (V.generate n look) rangeMinBy (<=?) n look = vecRangeMinBy (<=?) (V.generate n look) rangeMin n look = vecRangeMin (V.generate n look) rangeMax n look = vecRangeMax (V.generate n look)