-- | An incomplete implementation of interval aritrhmetic.
module Data.Number.Interval(Interval, ival, getIval) where

data Interval a = I a a

ival :: (Ord a) => a -> a -> Interval a
ival :: a -> a -> Interval a
ival l :: a
l h :: a
h | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
h = a -> a -> Interval a
forall a. a -> a -> Interval a
I a
l a
h
         | Bool
otherwise = [Char] -> Interval a
forall a. HasCallStack => [Char] -> a
error "Interval.ival: low > high"

getIval :: Interval a -> (a, a)
getIval :: Interval a -> (a, a)
getIval (I l :: a
l h :: a
h) = (a
l, a
h)

instance (Ord a) => Eq (Interval a) where
    I l :: a
l h :: a
h == :: Interval a -> Interval a -> Bool
== I l' :: a
l' h' :: a
h'  =  a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h' Bool -> Bool -> Bool
&& a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
l'
    I l :: a
l h :: a
h /= :: Interval a -> Interval a -> Bool
/= I l' :: a
l' h' :: a
h'  =  a
h a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l' Bool -> Bool -> Bool
|| a
h' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l

instance (Ord a) => Ord (Interval a) where
    I l :: a
l h :: a
h < :: Interval a -> Interval a -> Bool
<  I l' :: a
l' h' :: a
h'  =  a
h a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
l'
    I l :: a
l h :: a
h <= :: Interval a -> Interval a -> Bool
<= I l' :: a
l' h' :: a
h'  =  a
h a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
l'
    I l :: a
l h :: a
h > :: Interval a -> Interval a -> Bool
>  I l' :: a
l' h' :: a
h'  =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
h'
    I l :: a
l h :: a
h >= :: Interval a -> Interval a -> Bool
>= I l' :: a
l' h' :: a
h'  =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
h'
    -- These funcions are partial, so we just leave them out.
    compare :: Interval a -> Interval a -> Ordering
compare _ _ = [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error "Interval compare"
    max :: Interval a -> Interval a -> Interval a
max _ _ = [Char] -> Interval a
forall a. HasCallStack => [Char] -> a
error "Interval max"
    min :: Interval a -> Interval a -> Interval a
min _ _ = [Char] -> Interval a
forall a. HasCallStack => [Char] -> a
error "Interval min"

instance (Eq a, Show a) => Show (Interval a) where
    showsPrec :: Int -> Interval a -> ShowS
showsPrec p :: Int
p (I l :: a
l h :: a
h) | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
l
                        | Bool
otherwise = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString ".." ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
h

instance (Ord a, Num a) => Num (Interval a) where
    I l :: a
l h :: a
h + :: Interval a -> Interval a -> Interval a
+ I l' :: a
l' h' :: a
h'  =  a -> a -> Interval a
forall a. a -> a -> Interval a
I (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
l') (a
h a -> a -> a
forall a. Num a => a -> a -> a
+ a
h')
    I l :: a
l h :: a
h - :: Interval a -> Interval a -> Interval a
- I l' :: a
l' h' :: a
h'  =  a -> a -> Interval a
forall a. a -> a -> Interval a
I (a
l a -> a -> a
forall a. Num a => a -> a -> a
- a
h') (a
h a -> a -> a
forall a. Num a => a -> a -> a
- a
l')
    I l :: a
l h :: a
h * :: Interval a -> Interval a -> Interval a
* I l' :: a
l' h' :: a
h'  =  a -> a -> Interval a
forall a. a -> a -> Interval a
I ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [a]
xs) ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
xs) where xs :: [a]
xs = [a
la -> a -> a
forall a. Num a => a -> a -> a
*a
l', a
la -> a -> a
forall a. Num a => a -> a -> a
*a
h', a
ha -> a -> a
forall a. Num a => a -> a -> a
*a
l', a
ha -> a -> a
forall a. Num a => a -> a -> a
*a
h']
    negate :: Interval a -> Interval a
negate (I l :: a
l h :: a
h)   =  a -> a -> Interval a
forall a. a -> a -> Interval a
I (-a
h) (-a
l)
    -- leave out abs and signum
    abs :: Interval a -> Interval a
abs _ = [Char] -> Interval a
forall a. HasCallStack => [Char] -> a
error "Interval abs"
    signum :: Interval a -> Interval a
signum _ = [Char] -> Interval a
forall a. HasCallStack => [Char] -> a
error "Interval signum"
    fromInteger :: Integer -> Interval a
fromInteger i :: Integer
i    =  a -> a -> Interval a
forall a. a -> a -> Interval a
I a
l a
l where l :: a
l = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i
 
instance (Ord a, Fractional a) => Fractional (Interval a) where
    I l :: a
l h :: a
h / :: Interval a -> Interval a -> Interval a
/ I l' :: a
l' h' :: a
h' | a -> a
forall a. Num a => a -> a
signum a
l' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Num a => a -> a
signum a
h' Bool -> Bool -> Bool
&& a
l' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 =  a -> a -> Interval a
forall a. a -> a -> Interval a
I ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [a]
xs) ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
xs)
                    | Bool
otherwise = [Char] -> Interval a
forall a. HasCallStack => [Char] -> a
error "Interval: division by 0"
                    where xs :: [a]
xs = [a
la -> a -> a
forall a. Fractional a => a -> a -> a
/a
l', a
la -> a -> a
forall a. Fractional a => a -> a -> a
/a
h', a
ha -> a -> a
forall a. Fractional a => a -> a -> a
/a
l', a
ha -> a -> a
forall a. Fractional a => a -> a -> a
/a
h']
    fromRational :: Rational -> Interval a
fromRational r :: Rational
r   =  a -> a -> Interval a
forall a. a -> a -> Interval a
I a
l a
l where l :: a
l = Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
r