Haskell Auxiliary Module: Interval data definition and functions

aux.hs

-- | Working with closed intervals.
--
-- See https://gist.github.com/vst/65ac335e452068ac0306dac61eceb13f
--
-- Alternative: https://hackage.haskell.org/package/intervals

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.Except (MonadError(throwError))


-- ** Data Definition
-- &dataDefinition


-- | Type encoding for closed intervals.
--
-- Values of this type are represented by two values: A lower endpoint and an
-- upper endpoint.
--
-- The lower endpoint should strictly be less than or equal to an upper endpoint
-- for a valid 'Interval' value:
--
-- \[
-- \mbox{Lower Endpoint} \leq \mbox{Upper Endpoint}
-- \]
--
-- Therefore, call-sites should use safe constructors to create 'Interval'
-- values. These are (1) 'interval' and (2) 'singletonInterval'. The former
-- expects that the endpoint type has instances for:
--
-- 1. 'Ord' (therefore 'Eq') to enforce the rule of \(\mbox{Lower Endpoint} \leq \mbox{Upper Endpoint}\), and
-- 2. 'Show' to produce better error messages if the above rule is violated.
--
-- Examples of successful 'interval' application are:
--
-- >>> interval 0 0 :: Either String (Interval Int)
-- Right {0,0}
-- >>> interval 0 1 :: Either String (Interval Integer)
-- Right {0,1}
-- >>> interval 0 1 :: Either String (Interval Float)
-- Right {0.0,1.0}
-- >>> interval 0 1 :: Either String (Interval Double)
-- Right {0.0,1.0}
-- >>> interval 0 1 :: Either String (Interval Data.Scientific.Scientific)
-- Right {0.0,1.0}
--
-- An example of failed 'interval' application is:
--
-- >>> interval 1 0 :: Either String (Interval Int)
-- Left "Inconsistent interval definition. Lower endpoint is greater than upper endpoint: 1 > 0"
--
-- An example of 'singletonInterval' application is:
--
-- >>> singletonInterval 0
-- {0,0}
--
-- For what it's worth, we can create intervals of ordered sum types, too.
--
-- >>> data Color = White | Red | Green | Blue | Black deriving (Eq, Ord, Show)
-- >>> interval Red Blue :: Either String (Interval Color)
-- Right {Red,Blue}
-- >>> interval Black White :: Either String (Interval Color)
-- Left "Inconsistent interval definition. Lower endpoint is greater than upper endpoint: Black > White"
--
-- Unsafe construction uses 'MkInterval' constructor directly on a 2-tuple of
-- endpoint values (first is lower endpoint and the second is the upper
-- endpoint):
--
-- >>> MkInterval (0, 1)
-- {0,1}
newtype Interval a = MkInterval { endpoints :: (a, a) }


-- | 'Show' instance for 'Interval' values.
--
-- >>> show (MkInterval (0, 0))
-- "{0,0}"
instance Show a => Show (Interval a) where
  show (MkInterval (x, y)) = "{" <> show x <> "," <> show y <> "}"


-- | 'Eq' instance for 'Interval' values.
--
-- >>> MkInterval (0, 0) == MkInterval (0, 0)
-- True
instance Eq a => Eq (Interval a) where
  (MkInterval x) == (MkInterval y) = x == y


-- | 'Ord' instance for 'Interval' values.
--
-- >>> MkInterval (0, 0) == MkInterval (0, 0)
-- True
instance (Eq a, Ord a) => Ord (Interval a) where
  compare (MkInterval x) (MkInterval y) = compare x y


-- ** Constructors
-- &constructors


-- | Smart constructor for 'Interval' values.
--
-- >>> interval 0 0 :: Either String (Interval Int)
-- Right {0,0}
-- >>> interval 1 0 :: Either String (Interval Int)
-- Left "Inconsistent interval definition. Lower endpoint is greater than upper endpoint: 1 > 0"
-- >>> interval 0 1 :: Either String (Interval Float)
-- Right {0.0,1.0}
-- >>> interval 1 0 :: Either String (Interval Float)
-- Left "Inconsistent interval definition. Lower endpoint is greater than upper endpoint: 1.0 > 0.0"
-- >>> interval 0 1 :: Either String (Interval Double)
-- Right {0.0,1.0}
-- >>> interval 1 0 :: Either String (Interval Double)
-- Left "Inconsistent interval definition. Lower endpoint is greater than upper endpoint: 1.0 > 0.0"
-- >>> interval 0 1 :: Either String (Interval Data.Scientific.Scientific)
-- Right {0.0,1.0}
-- >>> interval 1 0 :: Either String (Interval Data.Scientific.Scientific)
-- Left "Inconsistent interval definition. Lower endpoint is greater than upper endpoint: 1.0 > 0.0"
interval
  :: (MonadError String m, Ord a, Show a)
  => a  -- ^ Lower endpoint (inclusive)
  -> a  -- ^ Upper endpoint (inclusive)
  -> m (Interval a)
interval x y
  | x > y = throwError $ "Inconsistent interval definition. Lower endpoint is greater than upper endpoint: " <> show x <> " > " <> show y
  | otherwise = pure $ MkInterval (x, y)


-- | Creates a singleton interval with 'Fractional' endpoints.
--
-- >>> singletonInterval 0
-- {0,0}
singletonInterval :: a -> Interval a
singletonInterval x = MkInterval (x, x)


-- | Builds and returns a singleton interval from the lower endpoint.
--
-- >>> singletonFromLowerEndpoint (MkInterval (0, 1))
-- {0,0}
singletonFromLowerEndpoint :: Interval a -> Interval a
singletonFromLowerEndpoint = singletonInterval . fst . endpoints


-- | Builds and returns a singleton interval from the upper endpoint.
--
-- >>> singletonFromUpperEndpoint (MkInterval (0, 1))
-- {1,1}
singletonFromUpperEndpoint :: Interval a -> Interval a
singletonFromUpperEndpoint = singletonInterval . snd . endpoints


-- ** Pure Functions
-- &pureFunctions


-- | Returns the lower endpoint of an 'Interval'.
lowerEndpoint :: Interval a -> a
lowerEndpoint (MkInterval (x, _)) = x


-- | Returns the upper endpoint of an 'Interval'.
upperEndpoint :: Interval a -> a
upperEndpoint (MkInterval (_, x)) = x


-- | Predicate checking if the given 'Interval' is a singleton.
isSingleton :: (Eq a) => Interval a -> Bool
isSingleton = (==) <$> lowerEndpoint <*> upperEndpoint


-- | Returns ascending values for a given interval based on the 'Enum' instance
-- of the underlying endpoint type.
--
-- >>> enum (MkInterval (0, 0))
-- [0]
-- >>> enum (MkInterval (0, 1))
-- [0,1]
-- >>> enum (MkInterval (0, 1) :: Interval Double)
-- [0.0,1.0]
-- >>> enum (MkInterval (0, 1) :: Interval Double)
-- [0.0,1.0]
-- >>> data Color = White | Red | Green | Blue | Black deriving (Enum, Eq, Ord, Show)
-- >>> enum (MkInterval (Red, Blue))
-- [Red,Green,Blue]
enum :: Enum a => Interval a -> [a]
enum (MkInterval (x, y)) = enumFromTo x y


-- ** Specialized Functions
-- &functionsSpecialized


-- *** Over Fractional Endpooints
-- &functionsSpecializedFractional


-- | Returns the midpoint of an 'Interval' with 'Fractional' endpoints.
--
-- >>> midpointFractional (MkInterval (0, 0))
-- 0.0
-- >>> midpointFractional (MkInterval (0, 1))
-- 0.5
-- >>> midpointFractional (MkInterval (0, 2))
-- 1.0
-- >>> midpointFractional (MkInterval (0, 3))
-- 1.5
-- >>> midpointFractional (MkInterval (0, 4))
-- 2.0
-- >>> midpointFractional (MkInterval (-1, 0))
-- -0.5
-- >>> midpointFractional (MkInterval (-2, 0))
-- -1.0
-- >>> midpointFractional (MkInterval (-1, 1))
-- 0.0
-- >>> midpointFractional (MkInterval (-2, 1))
-- -0.5
midpointFractional :: Fractional a => Interval a -> a
midpointFractional = (/ 2) . ((+) <$> fst <*> snd) . endpoints


-- | Builds and returns a singleton interval from the lower endpoint.
--
-- >>> singletonFromMidpointFractional (MkInterval (0, 1))
-- {0.5,0.5}
singletonFromMidpointFractional :: Fractional a => Interval a -> Interval a
singletonFromMidpointFractional = singletonInterval . midpointFractional


-- *** Over Integral Endpoints
-- &functionsSpecializedIntegral


-- | Returns the midpoint of an 'Interval' with 'Integral' endpoints.
--
-- >>> midpointIntegral (MkInterval (0, 0))
-- 0
-- >>> midpointIntegral (MkInterval (0, 1))
-- 0
-- >>> midpointIntegral (MkInterval (0, 2))
-- 1
-- >>> midpointIntegral (MkInterval (0, 3))
-- 1
-- >>> midpointIntegral (MkInterval (0, 4))
-- 2
-- >>> midpointIntegral (MkInterval (-1, 0))
-- -1
-- >>> midpointIntegral (MkInterval (-2, 0))
-- -1
-- >>> midpointIntegral (MkInterval (-1, 1))
-- 0
-- >>> midpointIntegral (MkInterval (-2, 1))
-- -1
midpointIntegral :: Integral a => Interval a -> a
midpointIntegral = (`div` 2) . ((+) <$> fst <*> snd) . endpoints


-- | Builds and returns a singleton interval from the lower endpoint.
--
-- >>> singletonFromMidpointIntegral (MkInterval (0, 0))
-- {0,0}
-- >>> singletonFromMidpointIntegral (MkInterval (0, 1))
-- {0,0}
-- >>> singletonFromMidpointIntegral (MkInterval (0, 2))
-- {1,1}
singletonFromMidpointIntegral :: Integral a => Interval a -> Interval a
singletonFromMidpointIntegral = singletonInterval . midpointIntegral