----------------------------------------------------------------------------- -- -- Module : Numeric.Ranges.Internal -- Copyright : (c) 2015 Nicolas Del Piano -- License : MIT -- -- Maintainer : Nicolas Del Piano -- Stability : experimental -- Portability : -- -- | -- Module for internal representation of numeric ranges. -- ----------------------------------------------------------------------------- module Numeric.Ranges.Internal where import Control.Applicative ((<\$>)) import Data.Maybe (fromJust, fromMaybe) -- | Range -- -- It represents a range from a to b, with information about endpoints. -- Example: Rg (1, Closed) (2.4, Open) is equivalent to [1, 2.4) data Range a = Rg !(Endpoint a) !(Endpoint a) | Empty deriving Eq -- | Type for endpoints. data Endpoint a = E (a, Extreme) deriving (Eq, Show) -- | Data-type for including or excluding endpoints. data Extreme = Open | Closed deriving (Eq, Show) -- | Show instance for Range. instance (Show a) => Show (Range a) where show Empty = "Empty" show (Rg (E (x, l)) (E (y, r))) = showLeftB l ++ show x ++ ", " ++ show y ++ showRightB r where showLeftB Closed = "[" showLeftB Open = "(" showRightB Closed = "]" showRightB Open = ")" -- | Ord instance for Extreme. instance Ord Extreme where Closed <= Open = False _ <= _ = True -- | Ord instance for Endpoint a. instance (Num a, Ord a) => Ord (Endpoint a) where el <= er = value el < value er || (value el == value er && extreme el <= extreme er) -- | Num instance for Endpoint a. instance (Num a, Ord a) => Num (Endpoint a) where el + er = endpoint (value el + value er) \$ max (extreme el) (extreme er) el - er = endpoint (value el - value er) \$ min (extreme el) (extreme er) el * er = endpoint (value el * value er) \$ max (extreme el) (extreme er) abs = fmap abs signum = fmap signum fromInteger i = endpoint (fromInteger i) Closed -- | Num instance for Range a. -- -- re and le stand for right endpoint and left endpoint. instance (Num a, Ord a) => Num (Range a) where Rg le re + Rg le' re' = Rg (le + le') (re + re') _ + _ = Empty Rg le re - Rg le' re' = Rg (le - le') (re - re') _ - _ = Empty Rg le re * Rg le' re' = Rg (minimum prods) (maximum prods) where prods = [le * le', le * re', re * le', re * re'] _ * _ = Empty abs r@(Rg le re) | le >= 0 = r | re <= 0 = negate r -- we should do a deeper analysis for open endpoints | otherwise = 0 ~~ (value \$ max (-le) re) abs Empty = Empty signum = fmap signum fromInteger i = unitary \$ fromInteger i -- | Functor instance for endpoints. -- -- TODO: proofs. instance Functor Endpoint where fmap f e = endpoint (f \$ value e) \$ extreme e -- | Functor instance for Range. -- -- TODO: proofs. instance Functor Range where fmap _ Empty = Empty fmap f (Rg le re) = Rg (fmap f le) (fmap f re) infix 3 >< infix 3 >~ infix 3 ~< infix 3 ~~ -- | Constructs an open range, i.e., (a, b). (><) :: (Num a, Ord a) => a -> a -> Range a x >< y | x < y = Rg (E (x, Open)) (E (y, Open)) | otherwise = Empty -- | Constructs a left-opened range, i.e., (a, b]. (>~) :: (Num a, Ord a) => a -> a -> Range a x >~ y | x < y = Rg (E (x, Open)) (E (y, Closed)) | otherwise = Empty -- | Constructs a right-open range, i.e., [a, b). (~<) :: (Num a, Ord a) => a -> a -> Range a x ~< y | x < y = Rg (E (x, Closed)) (E (y, Open)) | otherwise = Empty -- | Constructs a closed range, i.e., [a, b]. (~~) :: (Num a, Ord a) => a -> a -> Range a x ~~ y | x <= y = Rg (E (x, Closed)) (E (y, Closed)) | otherwise = Empty -- | Gets the left endpoint from a range. leftBound :: Range a -> Maybe (Endpoint a) leftBound Empty = Nothing leftBound (Rg l _) = Just l -- | Gets the left endpoint from a range (unsafe). leftBound' :: Range a -> Endpoint a leftBound' Empty = error "leftBound': Empty range." leftBound' r = fromJust . leftBound \$ r -- | Gets the right endpoint from a range. rightBound :: Range a -> Maybe (Endpoint a) rightBound Empty = Nothing rightBound (Rg _ r) = Just r -- | Gets the right endpoint from a range (unsafe). rightBound' :: Range a -> Endpoint a rightBound' Empty = error "rightBound': Empty range." rightBound' r = fromJust . rightBound \$ r -- | Builds an endpoint. endpoint :: a -> Extreme -> Endpoint a endpoint x e = E (x, e) -- | Takes the extreme value from an endpoint. extreme :: Endpoint a -> Extreme extreme (E (_, e)) = e -- | Applies a function to the extreme value of an endpoint. applyExtreme :: (Extreme -> Extreme) -> Endpoint a -> Endpoint a applyExtreme f e = endpoint (value e) \$ f (extreme e) -- | Takes the endpoint number value from an endpoint. value :: Endpoint a -> a value (E (x, _)) = x -- | Switches the endpoints of a range. -- -- We can lose the invariant: [x, y] then x <= y. switch :: Range a -> Range a switch Empty = Empty switch (Rg x y) = Rg y x -- | Is a closed endpoint? isClosed :: Endpoint a -> Bool isClosed = (Closed ==) . extreme -- | Is an open endpoint? isOpen :: Endpoint a -> Bool isOpen = not . isClosed -- | Makes an endpoint closed. close :: Endpoint a -> Endpoint a close = applyExtreme (max Closed) -- | Makes an endpoint open. open :: Endpoint a -> Endpoint a open = applyExtreme (min Open) -- | Positive infinity inf :: (Fractional a) => a inf = 1/0 -- | Negative infinity ninf :: (Fractional a) => a ninf = -inf -- | The full range (-inf, inf) full :: (Fractional a, Ord a) => Range a full = ninf >< inf -- | An empty range empty :: (Ord a) => Range a empty = Empty -- | Degenerate. -- -- degenerate [a, a] = a degenerate :: (Num a, Ord a) => Range a -> Maybe a degenerate r | isUnitary r = Just . value . fromJust . rightBound \$ r | otherwise = Nothing -- | A unitary range. -- -- unitary a = [a, a] unitary :: (Num a, Ord a) => a -> Range a unitary x = x ~~ x -- | Is the given range a unitary element? isUnitary :: (Num a, Ord a) => Range a -> Bool isUnitary r@(Rg x y) = value x == value y && isClosedRange r isUnitary _ = False -- | Is the given range empty? isEmpty :: Range a -> Bool isEmpty Empty = True isEmpty _ = False -- | Is the given range closed? isClosedRange :: Range a -> Bool isClosedRange (Rg (E (_, Closed)) (E (_, Closed))) = True isClosedRange _ = False -- | Is the given range open? isOpenRange :: Range a -> Bool isOpenRange (Rg (E (_, Open)) (E (_, Open))) = True isOpenRange _ = False -- | Opens a range. openRange :: (Num a, Ord a) => Range a -> Range a openRange Empty = Empty openRange (Rg x y) = Rg (open x) (open y) -- | Range constructor. range :: Endpoint a -> Endpoint a -> Range a range = Rg -- | The infimum of a range. infimum :: (Num a, Ord a) => Range a -> a infimum r = fromMaybe (error "infimum: Empty range.") \$ value <\$> leftBound r -- | The supreme of a range. supreme :: (Num a, Ord a) => Range a -> a supreme r = fromMaybe (error "supreme: Empty range.") \$ value <\$> rightBound r -- | Range length. -- -- distance (a,b) = b - a distance :: (Num a, Ord a) => Range a -> a distance Empty = 0 distance r = supreme r - infimum r -- | Is the given element present in the range? -- -- As an example, consider: -- inX 3 \$ 1 >< 3 -> False -- inX 3 \$ 1 >~ 3 -> True inX :: (Num a, Ord a) => a -> Range a -> Bool inX _ Empty = False inX x rg@(Rg le re) | isOpenRange rg = x > l && x < r | isClosed le && isOpen re = x >= l && x < r | isOpen le && isClosed re = x > l && x <= r | otherwise = x >= l && x <= r where l = value le r = value re -- | Checks if the element `x` is not present in the range. notX :: (Num a, Ord a) => a -> Range a -> Bool notX x = not . inX x -- | Builds a range from a given number. -- -- Example: -- rangeFrom 3 = [3, inf) rangeFrom :: (Fractional a, Num a, Ord a) => a -> Range a rangeFrom = (~ a -> Range a openFrom = (> a -> Range a symmetric x | x >= 0 = (-x) >< x | otherwise = symmetric (-x) -- | Obtains the midpoint of a given range. midpoint :: (Fractional a, Ord a) => Range a -> a midpoint Empty = error "midpoint: Empty range." midpoint r = x + (y - x) / 2 where x = infimum r y = supreme r -- | Splits a range by a given number. splitBy :: (Fractional a, Num a, Ord a) => a -> Range a -> (Range a, Range a) splitBy x r | inX x r = (range leftE point, range point rightE) | otherwise = (empty, empty) where point = endpoint x Closed leftE = endpoint (infimum r) \$ extreme . leftBound' \$ r rightE = endpoint (supreme r) \$ extreme . rightBound' \$ r -- | Bisects a range. bisect :: (Fractional a, Ord a) => Range a -> (Range a, Range a) bisect Empty = error "bisect: Empty range." bisect r = splitBy (midpoint r) r -- | Extends both sides of a range. -- -- Example: extend 2 [1,4] = [-1,6] extend :: (Num a, Ord a) => a -> Range a -> Range a extend x r = r + symmetric x -- | -- -- cut :: (Num a, Ord a) => a -> Range a -> Range a cut = undefined -- | Tells us whether or not the given ranges intersect. intersect :: (Num a, Ord a) => Range a -> Range a -> Bool intersect Empty _ = False intersect _ Empty = False intersect lr rr = (supreme lr == infimum rr && (isClosed \$ rightBound' lr) && (isClosed \$ leftBound' rr)) || supreme lr > infimum rr -- | Applies a function f which depends on the endpoint's nature, that is, -- if they're open or closed. applyOnRanges :: (Ord a, Ord b, Ord c) => (Endpoint a -> Endpoint b -> Endpoint c) -> (Endpoint a -> Endpoint b -> Endpoint c) -> Range a -> Range b -> Range c applyOnRanges _ _ Empty _ = empty applyOnRanges _ _ _ Empty = empty applyOnRanges f g lr rr = range leftRange rightRange where leftRange = f (leftBound' lr) (leftBound' rr) rightRange = g (rightBound' lr) (rightBound' rr) -- | Applies a function `f` and `g` to the components -- of the provided endpoint. applyOnEndpoints :: (Ord a, Num a) => Endpoint a -> Endpoint a -> (a -> a -> a) -> (Extreme -> Extreme -> Extreme) -> Endpoint a applyOnEndpoints le re f g = endpoint (f vle vre) (g ele ere) where (ele, ere) = (extreme le, extreme re) (vle, vre) = (value le, value re) -- | Intersection between two ranges. -- -- Examples: -- [1,2] \cap [2,3] = [2,2] -- (1,2) \cap [2,3) = Empty -- (1,2) \cap (5,7] = Empty -- (1,9) \cap (7,12) = (7,9) -- [1,9) \cap (1,9) = (1,9) intersection :: (Num a, Ord a) => Range a -> Range a -> Range a intersection lr rr | intersect lr rr = range le re | otherwise = empty where le = applyOnEndpoints (leftBound' lr) (leftBound' rr) max min re = min (rightBound' lr) (rightBound' rr) -- | Calculates the smallest convex set that contains X. -- -- In general, -- [a,b] `hull` [c,d] = [a,d] hull :: (Ord a, Num a) => Range a -> Range a -> Range a hull Empty rr = rr hull lr Empty = lr hull lr rr = applyOnRanges min max lr rr