{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Numeric.Rounded.Hardware.Interval.NonEmpty
( Interval(..)
, increasing
, maxI
, minI
, powInt
, null
, inf
, sup
, width
, hull
) where
import Control.DeepSeq (NFData (..))
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Base as A
import Data.Coerce
import Data.Ix
import Data.Primitive
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import GHC.Float (log1p, expm1)
import GHC.Generics (Generic)
import Numeric.Rounded.Hardware.Internal
import qualified Numeric.Rounded.Hardware.Interval.Class as C
import qualified Numeric.Rounded.Hardware.Interval.ElementaryFunctions as C
import Prelude hiding (null)
data Interval a
= I !(Rounded 'TowardNegInf a) !(Rounded 'TowardInf a)
deriving (Int -> Interval a -> ShowS
[Interval a] -> ShowS
Interval a -> String
(Int -> Interval a -> ShowS)
-> (Interval a -> String)
-> ([Interval a] -> ShowS)
-> Show (Interval a)
forall a. Show a => Int -> Interval a -> ShowS
forall a. Show a => [Interval a] -> ShowS
forall a. Show a => Interval a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval a] -> ShowS
$cshowList :: forall a. Show a => [Interval a] -> ShowS
show :: Interval a -> String
$cshow :: forall a. Show a => Interval a -> String
showsPrec :: Int -> Interval a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Interval a -> ShowS
Show,(forall x. Interval a -> Rep (Interval a) x)
-> (forall x. Rep (Interval a) x -> Interval a)
-> Generic (Interval a)
forall x. Rep (Interval a) x -> Interval a
forall x. Interval a -> Rep (Interval a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Interval a) x -> Interval a
forall a x. Interval a -> Rep (Interval a) x
$cto :: forall a x. Rep (Interval a) x -> Interval a
$cfrom :: forall a x. Interval a -> Rep (Interval a) x
Generic)
instance NFData a => NFData (Interval a)
increasing :: (forall r. Rounding r => Rounded r a -> Rounded r a) -> Interval a -> Interval a
increasing :: (forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a)
-> Interval a -> Interval a
increasing forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
f (I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b) = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
f Rounded 'TowardNegInf a
a) (Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
f Rounded 'TowardInf a
b)
negateI :: (Num a, RoundedRing a) => Interval a -> Interval a
negateI :: Interval a -> Interval a
negateI (I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b) = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Num a => a -> a
negate (Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
b)) (Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Num a => a -> a
negate (Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
a))
{-# INLINE [0] negateI #-}
addI, subI, mulI :: (Num a, RoundedRing a) => Interval a -> Interval a -> Interval a
I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b addI :: Interval a -> Interval a -> Interval a
`addI` I Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' = case Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalAdd Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' of
(Rounded 'TowardNegInf a
a'', Rounded 'TowardInf a
b'') -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
a'' Rounded 'TowardInf a
b''
I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b subI :: Interval a -> Interval a -> Interval a
`subI` I Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' = case Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalSub Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' of
(Rounded 'TowardNegInf a
a'', Rounded 'TowardInf a
b'') -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
a'' Rounded 'TowardInf a
b''
I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b mulI :: Interval a -> Interval a -> Interval a
`mulI` I Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' = case Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalMul Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' of
(Rounded 'TowardNegInf a
a'', Rounded 'TowardInf a
b'') -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
a'' Rounded 'TowardInf a
b''
mulAddI :: (Num a, RoundedRing a) => Interval a -> Interval a -> Interval a -> Interval a
mulAddI :: Interval a -> Interval a -> Interval a -> Interval a
mulAddI (I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b) (I Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b') (I Rounded 'TowardNegInf a
a'' Rounded 'TowardInf a
b'') = case Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalMulAdd Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' Rounded 'TowardNegInf a
a'' Rounded 'TowardInf a
b'' of
(Rounded 'TowardNegInf a
x, Rounded 'TowardInf a
y) -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y
normalizeDivisor :: (Ord a, Num a) => Interval a -> Interval a
normalizeDivisor :: Interval a -> Interval a
normalizeDivisor x :: Interval a
x@(I (Rounded a
a) (Rounded a
b))
| a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
a Bool -> Bool -> Bool
|| a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Interval a
x
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded a
0) (a -> Rounded 'TowardInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded a
b)
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded a
a) (a -> Rounded 'TowardInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (-a
0))
| Bool
otherwise = String -> Interval a
forall a. HasCallStack => String -> a
error String
"divide by zero"
divI :: (Num a, RoundedFractional a) => Interval a -> Interval a -> Interval a
I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b divI :: Interval a -> Interval a -> Interval a
`divI` Interval a
y = let I Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' = Interval a -> Interval a
forall a. (Ord a, Num a) => Interval a -> Interval a
normalizeDivisor Interval a
y
(Rounded 'TowardNegInf a
z, Rounded 'TowardInf a
z') = Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedFractional a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalDiv Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b'
in Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
z Rounded 'TowardInf a
z'
divAddI :: (Num a, RoundedFractional a) => Interval a -> Interval a -> Interval a -> Interval a
divAddI :: Interval a -> Interval a -> Interval a -> Interval a
divAddI (I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b) Interval a
y (I Rounded 'TowardNegInf a
a'' Rounded 'TowardInf a
b'') = let I Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' = Interval a -> Interval a
forall a. (Ord a, Num a) => Interval a -> Interval a
normalizeDivisor Interval a
y
(Rounded 'TowardNegInf a
z, Rounded 'TowardInf a
z') = Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedFractional a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalDivAdd Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b Rounded 'TowardNegInf a
a' Rounded 'TowardInf a
b' Rounded 'TowardNegInf a
a'' Rounded 'TowardInf a
b''
in Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
z Rounded 'TowardInf a
z'
{-# INLINE [0] addI #-}
{-# INLINE [0] subI #-}
{-# INLINE [0] mulI #-}
{-# INLINE [0] divI #-}
{-# INLINE mulAddI #-}
{-# INLINE divAddI #-}
{-# RULES
"Interval.NonEmpty/x*y+z" forall x y z. addI (mulI x y) z = mulAddI x y z
"Interval.NonEmpty/z+x*y" forall x y z. addI z (mulI x y) = mulAddI x y z
"Interval.NonEmpty/x*y-z" forall x y z. subI (mulI x y) z = mulAddI x y (negateI z)
"Interval.NonEmpty/z-x*y" forall x y z. subI z (mulI x y) = negateI (mulAddI x y (negateI z))
"Interval.NonEmpty/x/y+z" forall x y z. addI (divI x y) z = divAddI x y z
"Interval.NonEmpty/z+x/y" forall x y z. addI z (divI x y) = divAddI x y z
"Interval.NonEmpty/x/y-z" forall x y z. subI (divI x y) z = divAddI x y (negateI z)
"Interval.NonEmpty/z-x/y" forall x y z. subI z (divI x y) = negateI (divAddI x y (negateI z))
"Interval.NonEmpty/negate-negate" forall x. negateI (negateI x) = x
"Interval.NonEmpty/x+(-y)" forall x y. addI x (negateI y) = subI x y
"Interval.NonEmpty/(-y)+x" forall x y. addI (negateI y) x = subI x y
"Interval.NonEmpty/x-(-y)" forall x y. subI x (negateI y) = addI x y
#-}
instance (Num a, RoundedRing a) => Num (Interval a) where
+ :: Interval a -> Interval a -> Interval a
(+) = Interval a -> Interval a -> Interval a
forall a.
(Num a, RoundedRing a) =>
Interval a -> Interval a -> Interval a
addI
(-) = Interval a -> Interval a -> Interval a
forall a.
(Num a, RoundedRing a) =>
Interval a -> Interval a -> Interval a
subI
* :: Interval a -> Interval a -> Interval a
(*) = Interval a -> Interval a -> Interval a
forall a.
(Num a, RoundedRing a) =>
Interval a -> Interval a -> Interval a
mulI
negate :: Interval a -> Interval a
negate = Interval a -> Interval a
forall a. (Num a, RoundedRing a) => Interval a -> Interval a
negateI
abs :: Interval a -> Interval a
abs x :: Interval a
x@(I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b)
| Rounded 'TowardNegInf a
a Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a -> Bool
forall a. Ord a => a -> a -> Bool
>= Rounded 'TowardNegInf a
0 = Interval a
x
| Rounded 'TowardInf a
b Rounded 'TowardInf a -> Rounded 'TowardInf a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardInf a
0 = Interval a -> Interval a
forall a. Num a => a -> a
negate Interval a
x
| Bool
otherwise = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
0 (Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
max (Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Num a => a -> a
negate (Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
a)) Rounded 'TowardInf a
b)
signum :: Interval a -> Interval a
signum = (forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a)
-> Interval a -> Interval a
forall a.
(forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a)
-> Interval a -> Interval a
increasing forall a. Num a => a -> a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
signum
fromInteger :: Integer -> Interval a
fromInteger Integer
x = case Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger Integer
x of
(Rounded 'TowardNegInf a
y, Rounded 'TowardInf a
y') -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
y Rounded 'TowardInf a
y'
{-# INLINE (+) #-}
{-# INLINE (-) #-}
{-# INLINE negate #-}
{-# INLINE (*) #-}
{-# INLINE abs #-}
{-# INLINE signum #-}
{-# INLINE fromInteger #-}
instance (Num a, RoundedFractional a) => Fractional (Interval a) where
recip :: Interval a -> Interval a
recip Interval a
x = let I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b = Interval a -> Interval a
forall a. (Ord a, Num a) => Interval a -> Interval a
normalizeDivisor Interval a
x
(Rounded 'TowardNegInf a
y, Rounded 'TowardInf a
y') = Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedFractional a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalRecip Rounded 'TowardNegInf a
a Rounded 'TowardInf a
b
in Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
y Rounded 'TowardInf a
y'
/ :: Interval a -> Interval a -> Interval a
(/) = Interval a -> Interval a -> Interval a
forall a.
(Num a, RoundedFractional a) =>
Interval a -> Interval a -> Interval a
divI
fromRational :: Rational -> Interval a
fromRational Rational
x = case Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedFractional a =>
Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational Rational
x of
(Rounded 'TowardNegInf a
y, Rounded 'TowardInf a
y') -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
y Rounded 'TowardInf a
y'
{-# INLINE recip #-}
{-# INLINE (/) #-}
{-# INLINE fromRational #-}
maxI :: Ord a => Interval a -> Interval a -> Interval a
maxI :: Interval a -> Interval a -> Interval a
maxI (I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
a') (I Rounded 'TowardNegInf a
b Rounded 'TowardInf a
b') = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Ord a => a -> a -> a
max Rounded 'TowardNegInf a
a Rounded 'TowardNegInf a
b) (Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
max Rounded 'TowardInf a
a' Rounded 'TowardInf a
b')
{-# INLINE maxI #-}
minI :: Ord a => Interval a -> Interval a -> Interval a
minI :: Interval a -> Interval a -> Interval a
minI (I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
a') (I Rounded 'TowardNegInf a
b Rounded 'TowardInf a
b') = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Ord a => a -> a -> a
min Rounded 'TowardNegInf a
a Rounded 'TowardNegInf a
b) (Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
min Rounded 'TowardInf a
a' Rounded 'TowardInf a
b')
{-# INLINE minI #-}
powInt :: (Ord a, Num a, RoundedRing a) => Interval a -> Int -> Interval a
powInt :: Interval a -> Int -> Interval a
powInt (I Rounded 'TowardNegInf a
a Rounded 'TowardInf a
a') Int
n | Int -> Bool
forall a. Integral a => a -> Bool
odd Int
n Bool -> Bool -> Bool
|| Rounded 'TowardNegInf a
0 Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardNegInf a
a = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (Rounded 'TowardNegInf a
aRounded 'TowardNegInf a -> Int -> Rounded 'TowardNegInf a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) (Rounded 'TowardInf a
a'Rounded 'TowardInf a -> Int -> Rounded 'TowardInf a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n)
| Rounded 'TowardInf a
a' Rounded 'TowardInf a -> Rounded 'TowardInf a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardInf a
0 = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I ((Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce (Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Num a => a -> a
abs Rounded 'TowardInf a
a'))Rounded 'TowardNegInf a -> Int -> Rounded 'TowardNegInf a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) ((Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce (Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Num a => a -> a
abs Rounded 'TowardNegInf a
a))Rounded 'TowardInf a -> Int -> Rounded 'TowardInf a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n)
| Bool
otherwise = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
0 (Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
max ((Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce (Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Num a => a -> a
abs Rounded 'TowardNegInf a
a))Rounded 'TowardInf a -> Int -> Rounded 'TowardInf a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) (Rounded 'TowardInf a
a'Rounded 'TowardInf a -> Int -> Rounded 'TowardInf a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n))
{-# SPECIALIZE powInt :: Interval Float -> Int -> Interval Float #-}
{-# SPECIALIZE powInt :: Interval Double -> Int -> Interval Double #-}
null :: Interval a -> Bool
null :: Interval a -> Bool
null Interval a
_ = Bool
False
inf :: Interval a -> Rounded 'TowardNegInf a
inf :: Interval a -> Rounded 'TowardNegInf a
inf (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
_) = Rounded 'TowardNegInf a
x
sup :: Interval a -> Rounded 'TowardInf a
sup :: Interval a -> Rounded 'TowardInf a
sup (I Rounded 'TowardNegInf a
_ Rounded 'TowardInf a
y) = Rounded 'TowardInf a
y
width :: (Num a, RoundedRing a) => Interval a -> Rounded 'TowardInf a
width :: Interval a -> Rounded 'TowardInf a
width (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) = Rounded 'TowardInf a
y Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Num a => a -> a -> a
- Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
x
hull :: RoundedRing a => Interval a -> Interval a -> Interval a
hull :: Interval a -> Interval a -> Interval a
hull (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Ord a => a -> a -> a
min Rounded 'TowardNegInf a
x Rounded 'TowardNegInf a
x') (Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
max Rounded 'TowardInf a
y Rounded 'TowardInf a
y')
{-# SPECIALIZE C.expP :: Double -> Interval Double #-}
{-# SPECIALIZE C.expI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.expm1P :: Double -> Interval Double #-}
{-# SPECIALIZE C.expm1I :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.logP :: Double -> Interval Double #-}
{-# SPECIALIZE C.logI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.log1pP :: Double -> Interval Double #-}
{-# SPECIALIZE C.log1pI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.sin_small :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.cos_small :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.sinP :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.cosP :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.sinI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.cosI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.tanI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.atan_small :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.atanP :: Double -> Interval Double #-}
{-# SPECIALIZE C.atanI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.asinP :: Double -> Interval Double #-}
{-# SPECIALIZE C.asinI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.acosP :: Double -> Interval Double #-}
{-# SPECIALIZE C.acosI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.sinhP :: Double -> Interval Double #-}
{-# SPECIALIZE C.sinhI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.coshP :: Double -> Interval Double #-}
{-# SPECIALIZE C.coshI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.tanhP :: Double -> Interval Double #-}
{-# SPECIALIZE C.tanhI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.asinhP :: Double -> Interval Double #-}
{-# SPECIALIZE C.asinhI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.acoshP :: Double -> Interval Double #-}
{-# SPECIALIZE C.acoshI :: Interval Double -> Interval Double #-}
{-# SPECIALIZE C.atanhP :: Double -> Interval Double #-}
{-# SPECIALIZE C.atanhI :: Interval Double -> Interval Double #-}
instance (Num a, RoundedFractional a, RoundedSqrt a, Eq a, RealFloat a, RealFloatConstants a) => Floating (Interval a) where
pi :: Interval a
pi = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
forall a. RealFloatConstants a => Rounded 'TowardNegInf a
pi_down Rounded 'TowardInf a
forall a. RealFloatConstants a => Rounded 'TowardInf a
pi_up
exp :: Interval a -> Interval a
exp = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i),
RoundedFractional (EndPoint i)) =>
i -> i
C.expI
log :: Interval a -> Interval a
log = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i)) =>
i -> i
C.logI
sqrt :: Interval a -> Interval a
sqrt = Interval a -> Interval a
forall i. (IsInterval i, RoundedSqrt (EndPoint i)) => i -> i
C.sqrtI
sin :: Interval a -> Interval a
sin = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RoundedRing (EndPoint i),
RealFloatConstants (EndPoint i)) =>
i -> i
C.sinI
cos :: Interval a -> Interval a
cos = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RoundedRing (EndPoint i),
RealFloatConstants (EndPoint i)) =>
i -> i
C.cosI
tan :: Interval a -> Interval a
tan = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RoundedRing (EndPoint i),
RealFloatConstants (EndPoint i)) =>
i -> i
C.tanI
asin :: Interval a -> Interval a
asin = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RoundedRing (EndPoint i),
RoundedSqrt (EndPoint i), RealFloatConstants (EndPoint i)) =>
i -> i
C.asinI
acos :: Interval a -> Interval a
acos = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RoundedRing (EndPoint i),
RoundedSqrt (EndPoint i), RealFloatConstants (EndPoint i)) =>
i -> i
C.acosI
atan :: Interval a -> Interval a
atan = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RoundedRing (EndPoint i),
RealFloatConstants (EndPoint i)) =>
i -> i
C.atanI
sinh :: Interval a -> Interval a
sinh = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i),
RoundedFractional (EndPoint i)) =>
i -> i
C.sinhI
cosh :: Interval a -> Interval a
cosh = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i),
RoundedFractional (EndPoint i)) =>
i -> i
C.coshI
tanh :: Interval a -> Interval a
tanh = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i),
RoundedFractional (EndPoint i)) =>
i -> i
C.tanhI
asinh :: Interval a -> Interval a
asinh = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i),
RoundedSqrt (EndPoint i)) =>
i -> i
C.asinhI
acosh :: Interval a -> Interval a
acosh = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i),
RoundedSqrt (EndPoint i)) =>
i -> i
C.acoshI
atanh :: Interval a -> Interval a
atanh = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i)) =>
i -> i
C.atanhI
log1p :: Interval a -> Interval a
log1p = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i)) =>
i -> i
C.log1pI
expm1 :: Interval a -> Interval a
expm1 = Interval a -> Interval a
forall i.
(IsInterval i, Fractional i, Eq (EndPoint i),
RealFloat (EndPoint i), RealFloatConstants (EndPoint i),
RoundedFractional (EndPoint i)) =>
i -> i
C.expm1I
{-# SPECIALIZE instance Floating (Interval Float) #-}
{-# SPECIALIZE instance Floating (Interval Double) #-}
instance (RealFloat a, RoundedRing a) => C.IsInterval (Interval a) where
type EndPoint (Interval a) = a
makeInterval :: Rounded 'TowardNegInf (EndPoint (Interval a))
-> Rounded 'TowardInf (EndPoint (Interval a)) -> Interval a
makeInterval = Rounded 'TowardNegInf (EndPoint (Interval a))
-> Rounded 'TowardInf (EndPoint (Interval a)) -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I
width :: Interval a -> Rounded 'TowardInf (EndPoint (Interval a))
width = Interval a -> Rounded 'TowardInf (EndPoint (Interval a))
forall a.
(Num a, RoundedRing a) =>
Interval a -> Rounded 'TowardInf a
width
withEndPoints :: (Rounded 'TowardNegInf (EndPoint (Interval a))
-> Rounded 'TowardInf (EndPoint (Interval a)) -> Interval a)
-> Interval a -> Interval a
withEndPoints Rounded 'TowardNegInf (EndPoint (Interval a))
-> Rounded 'TowardInf (EndPoint (Interval a)) -> Interval a
f (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) = Rounded 'TowardNegInf (EndPoint (Interval a))
-> Rounded 'TowardInf (EndPoint (Interval a)) -> Interval a
f Rounded 'TowardNegInf a
Rounded 'TowardNegInf (EndPoint (Interval a))
x Rounded 'TowardInf a
Rounded 'TowardInf (EndPoint (Interval a))
y
hull :: Interval a -> Interval a -> Interval a
hull = Interval a -> Interval a -> Interval a
forall a. RoundedRing a => Interval a -> Interval a -> Interval a
hull
intersection :: Interval a -> Interval a -> Interval a
intersection (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') | Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x'' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y'' = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
x'' Rounded 'TowardInf a
y''
| Bool
otherwise = String -> Interval a
forall a. HasCallStack => String -> a
error String
"empty intersection"
where x'' :: Rounded 'TowardNegInf a
x'' = Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Ord a => a -> a -> a
max Rounded 'TowardNegInf a
x Rounded 'TowardNegInf a
x'
y'' :: Rounded 'TowardInf a
y'' = Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
min Rounded 'TowardInf a
y Rounded 'TowardInf a
y'
maybeIntersection :: Interval a -> Interval a -> Maybe (Interval a)
maybeIntersection (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') | Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x'' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y'' = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I Rounded 'TowardNegInf a
x'' Rounded 'TowardInf a
y'')
| Bool
otherwise = Maybe (Interval a)
forall a. Maybe a
Nothing
where x'' :: Rounded 'TowardNegInf a
x'' = Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall a. Ord a => a -> a -> a
max Rounded 'TowardNegInf a
x Rounded 'TowardNegInf a
x'
y'' :: Rounded 'TowardInf a
y'' = Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
min Rounded 'TowardInf a
y Rounded 'TowardInf a
y'
equalAsSet :: Interval a -> Interval a -> Bool
equalAsSet (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') = Rounded 'TowardNegInf a
x Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a -> Bool
forall a. Eq a => a -> a -> Bool
== Rounded 'TowardNegInf a
x' Bool -> Bool -> Bool
&& Rounded 'TowardInf a
y Rounded 'TowardInf a -> Rounded 'TowardInf a -> Bool
forall a. Eq a => a -> a -> Bool
== Rounded 'TowardInf a
y'
subset :: Interval a -> Interval a -> Bool
subset (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') = Rounded 'TowardNegInf a
x' Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardNegInf a
x Bool -> Bool -> Bool
&& Rounded 'TowardInf a
y Rounded 'TowardInf a -> Rounded 'TowardInf a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardInf a
y'
weaklyLess :: Interval a -> Interval a -> Bool
weaklyLess (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') = Rounded 'TowardNegInf a
x Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardNegInf a
x' Bool -> Bool -> Bool
&& Rounded 'TowardInf a
y Rounded 'TowardInf a -> Rounded 'TowardInf a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardInf a
y'
precedes :: Interval a -> Interval a -> Bool
precedes (I Rounded 'TowardNegInf a
_ Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
_) = Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x'
interior :: Interval a -> Interval a -> Bool
interior (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') = Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x' a -> a -> Bool
forall a. RealFloat a => a -> a -> Bool
<# Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x Bool -> Bool -> Bool
&& Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y a -> a -> Bool
forall a. RealFloat a => a -> a -> Bool
<# Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y'
where a
s <# :: a -> a -> Bool
<# a
t = a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
t Bool -> Bool -> Bool
|| (a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
s)
strictLess :: Interval a -> Interval a -> Bool
strictLess (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') = Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x a -> a -> Bool
forall a. RealFloat a => a -> a -> Bool
<# Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x' Bool -> Bool -> Bool
&& Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y a -> a -> Bool
forall a. RealFloat a => a -> a -> Bool
<# Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y'
where a
s <# :: a -> a -> Bool
<# a
t = a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
t Bool -> Bool -> Bool
|| (a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
s)
strictPrecedes :: Interval a -> Interval a -> Bool
strictPrecedes (I Rounded 'TowardNegInf a
_ Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
_) = Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x'
disjoint :: Interval a -> Interval a -> Bool
disjoint (I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y) (I Rounded 'TowardNegInf a
x' Rounded 'TowardInf a
y') = Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x' Bool -> Bool -> Bool
|| Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x
{-# INLINE makeInterval #-}
{-# INLINE width #-}
{-# INLINE withEndPoints #-}
{-# INLINE hull #-}
{-# INLINE intersection #-}
{-# INLINE maybeIntersection #-}
{-# INLINE equalAsSet #-}
{-# INLINE subset #-}
{-# INLINE weaklyLess #-}
{-# INLINE precedes #-}
{-# INLINE interior #-}
{-# INLINE strictLess #-}
{-# INLINE strictPrecedes #-}
{-# INLINE disjoint #-}
newtype instance VUM.MVector s (Interval a) = MV_Interval (VUM.MVector s (a, a))
newtype instance VU.Vector (Interval a) = V_Interval (VU.Vector (a, a))
intervalToPair :: Fractional a => Interval a -> (a, a)
intervalToPair :: Interval a -> (a, a)
intervalToPair (I (Rounded a
x) (Rounded a
y)) = (a
x, a
y)
{-# INLINE intervalToPair #-}
pairToInterval :: Ord a => (a, a) -> Interval a
pairToInterval :: (a, a) -> Interval a
pairToInterval (a
x, a
y) = Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
I (a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded a
x) (a -> Rounded 'TowardInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded a
y)
{-# INLINE pairToInterval #-}
instance (VU.Unbox a, Ord a, Fractional a) => VGM.MVector VUM.MVector (Interval a) where
basicLength :: MVector s (Interval a) -> Int
basicLength (MV_Interval mv) = MVector s (a, a) -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength MVector s (a, a)
mv
basicUnsafeSlice :: Int -> Int -> MVector s (Interval a) -> MVector s (Interval a)
basicUnsafeSlice Int
i Int
l (MV_Interval mv) = MVector s (a, a) -> MVector s (Interval a)
forall s a. MVector s (a, a) -> MVector s (Interval a)
MV_Interval (Int -> Int -> MVector s (a, a) -> MVector s (a, a)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.basicUnsafeSlice Int
i Int
l MVector s (a, a)
mv)
basicOverlaps :: MVector s (Interval a) -> MVector s (Interval a) -> Bool
basicOverlaps (MV_Interval mv) (MV_Interval mv') = MVector s (a, a) -> MVector s (a, a) -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VGM.basicOverlaps MVector s (a, a)
mv MVector s (a, a)
mv'
basicUnsafeNew :: Int -> m (MVector (PrimState m) (Interval a))
basicUnsafeNew Int
l = MVector (PrimState m) (a, a) -> MVector (PrimState m) (Interval a)
forall s a. MVector s (a, a) -> MVector s (Interval a)
MV_Interval (MVector (PrimState m) (a, a)
-> MVector (PrimState m) (Interval a))
-> m (MVector (PrimState m) (a, a))
-> m (MVector (PrimState m) (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) (a, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VGM.basicUnsafeNew Int
l
basicInitialize :: MVector (PrimState m) (Interval a) -> m ()
basicInitialize (MV_Interval mv) = MVector (PrimState m) (a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicInitialize MVector (PrimState m) (a, a)
mv
basicUnsafeReplicate :: Int -> Interval a -> m (MVector (PrimState m) (Interval a))
basicUnsafeReplicate Int
i Interval a
x = MVector (PrimState m) (a, a) -> MVector (PrimState m) (Interval a)
forall s a. MVector s (a, a) -> MVector s (Interval a)
MV_Interval (MVector (PrimState m) (a, a)
-> MVector (PrimState m) (Interval a))
-> m (MVector (PrimState m) (a, a))
-> m (MVector (PrimState m) (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (a, a) -> m (MVector (PrimState m) (a, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
VGM.basicUnsafeReplicate Int
i (Interval a -> (a, a)
forall a. Fractional a => Interval a -> (a, a)
intervalToPair Interval a
x)
basicUnsafeRead :: MVector (PrimState m) (Interval a) -> Int -> m (Interval a)
basicUnsafeRead (MV_Interval mv) Int
i = (a, a) -> Interval a
forall a. Ord a => (a, a) -> Interval a
pairToInterval ((a, a) -> Interval a) -> m (a, a) -> m (Interval a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (a, a) -> Int -> m (a, a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
VGM.basicUnsafeRead MVector (PrimState m) (a, a)
mv Int
i
basicUnsafeWrite :: MVector (PrimState m) (Interval a) -> Int -> Interval a -> m ()
basicUnsafeWrite (MV_Interval mv) Int
i Interval a
x = MVector (PrimState m) (a, a) -> Int -> (a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.basicUnsafeWrite MVector (PrimState m) (a, a)
mv Int
i (Interval a -> (a, a)
forall a. Fractional a => Interval a -> (a, a)
intervalToPair Interval a
x)
basicClear :: MVector (PrimState m) (Interval a) -> m ()
basicClear (MV_Interval mv) = MVector (PrimState m) (a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicClear MVector (PrimState m) (a, a)
mv
basicSet :: MVector (PrimState m) (Interval a) -> Interval a -> m ()
basicSet (MV_Interval mv) Interval a
x = MVector (PrimState m) (a, a) -> (a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
VGM.basicSet MVector (PrimState m) (a, a)
mv (Interval a -> (a, a)
forall a. Fractional a => Interval a -> (a, a)
intervalToPair Interval a
x)
basicUnsafeCopy :: MVector (PrimState m) (Interval a)
-> MVector (PrimState m) (Interval a) -> m ()
basicUnsafeCopy (MV_Interval mv) (MV_Interval mv') = MVector (PrimState m) (a, a)
-> MVector (PrimState m) (a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.basicUnsafeCopy MVector (PrimState m) (a, a)
mv MVector (PrimState m) (a, a)
mv'
basicUnsafeMove :: MVector (PrimState m) (Interval a)
-> MVector (PrimState m) (Interval a) -> m ()
basicUnsafeMove (MV_Interval mv) (MV_Interval mv') = MVector (PrimState m) (a, a)
-> MVector (PrimState m) (a, a) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.basicUnsafeMove MVector (PrimState m) (a, a)
mv MVector (PrimState m) (a, a)
mv'
basicUnsafeGrow :: MVector (PrimState m) (Interval a)
-> Int -> m (MVector (PrimState m) (Interval a))
basicUnsafeGrow (MV_Interval mv) Int
n = MVector (PrimState m) (a, a) -> MVector (PrimState m) (Interval a)
forall s a. MVector s (a, a) -> MVector s (Interval a)
MV_Interval (MVector (PrimState m) (a, a)
-> MVector (PrimState m) (Interval a))
-> m (MVector (PrimState m) (a, a))
-> m (MVector (PrimState m) (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (a, a)
-> Int -> m (MVector (PrimState m) (a, a))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
VGM.basicUnsafeGrow MVector (PrimState m) (a, a)
mv Int
n
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicOverlaps #-}
{-# INLINE basicUnsafeNew #-}
{-# INLINE basicInitialize #-}
{-# INLINE basicUnsafeReplicate #-}
{-# INLINE basicUnsafeRead #-}
{-# INLINE basicUnsafeWrite #-}
{-# INLINE basicClear #-}
{-# INLINE basicSet #-}
{-# INLINE basicUnsafeCopy #-}
{-# INLINE basicUnsafeMove #-}
{-# INLINE basicUnsafeGrow #-}
instance (VU.Unbox a, Ord a, Fractional a) => VG.Vector VU.Vector (Interval a) where
basicUnsafeFreeze :: Mutable Vector (PrimState m) (Interval a)
-> m (Vector (Interval a))
basicUnsafeFreeze (MV_Interval mv) = Vector (a, a) -> Vector (Interval a)
forall a. Vector (a, a) -> Vector (Interval a)
V_Interval (Vector (a, a) -> Vector (Interval a))
-> m (Vector (a, a)) -> m (Vector (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) (a, a) -> m (Vector (a, a))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
VG.basicUnsafeFreeze MVector (PrimState m) (a, a)
Mutable Vector (PrimState m) (a, a)
mv
basicUnsafeThaw :: Vector (Interval a)
-> m (Mutable Vector (PrimState m) (Interval a))
basicUnsafeThaw (V_Interval v) = MVector (PrimState m) (a, a) -> MVector (PrimState m) (Interval a)
forall s a. MVector s (a, a) -> MVector s (Interval a)
MV_Interval (MVector (PrimState m) (a, a)
-> MVector (PrimState m) (Interval a))
-> m (MVector (PrimState m) (a, a))
-> m (MVector (PrimState m) (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (a, a) -> m (Mutable Vector (PrimState m) (a, a))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
VG.basicUnsafeThaw Vector (a, a)
v
basicLength :: Vector (Interval a) -> Int
basicLength (V_Interval v) = Vector (a, a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.basicLength Vector (a, a)
v
basicUnsafeSlice :: Int -> Int -> Vector (Interval a) -> Vector (Interval a)
basicUnsafeSlice Int
i Int
l (V_Interval v) = Vector (a, a) -> Vector (Interval a)
forall a. Vector (a, a) -> Vector (Interval a)
V_Interval (Int -> Int -> Vector (a, a) -> Vector (a, a)
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.basicUnsafeSlice Int
i Int
l Vector (a, a)
v)
basicUnsafeIndexM :: Vector (Interval a) -> Int -> m (Interval a)
basicUnsafeIndexM (V_Interval v) Int
i = (a, a) -> Interval a
forall a. Ord a => (a, a) -> Interval a
pairToInterval ((a, a) -> Interval a) -> m (a, a) -> m (Interval a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (a, a) -> Int -> m (a, a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
VG.basicUnsafeIndexM Vector (a, a)
v Int
i
basicUnsafeCopy :: Mutable Vector (PrimState m) (Interval a)
-> Vector (Interval a) -> m ()
basicUnsafeCopy (MV_Interval mv) (V_Interval v) = Mutable Vector (PrimState m) (a, a) -> Vector (a, a) -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.basicUnsafeCopy MVector (PrimState m) (a, a)
Mutable Vector (PrimState m) (a, a)
mv Vector (a, a)
v
elemseq :: Vector (Interval a) -> Interval a -> b -> b
elemseq (V_Interval _) Interval a
x b
y = Interval a
x Interval a -> b -> b
`seq` b
y
{-# INLINE basicUnsafeFreeze #-}
{-# INLINE basicUnsafeThaw #-}
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicUnsafeIndexM #-}
{-# INLINE basicUnsafeCopy #-}
{-# INLINE elemseq #-}
instance (VU.Unbox a, Ord a, Fractional a) => VU.Unbox (Interval a)
instance (Prim a, Ord a, Fractional a) => A.MArray (A.STUArray s) (Interval a) (ST s) where
getBounds :: STUArray s i (Interval a) -> ST s (i, i)
getBounds (A.STUArray i
l i
u Int
_ MutableByteArray# s
_) = (i, i) -> ST s (i, i)
forall (m :: * -> *) a. Monad m => a -> m a
return (i
l, i
u)
getNumElements :: STUArray s i (Interval a) -> ST s Int
getNumElements (A.STUArray i
_ i
_ Int
n MutableByteArray# s
_) = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
unsafeNewArray_ :: (i, i) -> ST s (STUArray s i (Interval a))
unsafeNewArray_ = (i, i) -> ST s (STUArray s i (Interval a))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
A.newArray_
newArray_ :: (i, i) -> ST s (STUArray s i (Interval a))
newArray_ bounds :: (i, i)
bounds@(i
l,i
u) = do
let n :: Int
n = (i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
bounds
arr :: MutableByteArray s
arr@(MutableByteArray MutableByteArray# s
arr_) <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Prim a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
MutableByteArray (PrimState (ST s)) -> Int -> Int -> a -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
0 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) (a
0 :: a)
STUArray s i (Interval a) -> ST s (STUArray s i (Interval a))
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> i -> Int -> MutableByteArray# s -> STUArray s i (Interval a)
forall s i e.
i -> i -> Int -> MutableByteArray# s -> STUArray s i e
A.STUArray i
l i
u Int
n MutableByteArray# s
arr_)
unsafeRead :: STUArray s i (Interval a) -> Int -> ST s (Interval a)
unsafeRead (A.STUArray i
_ i
_ Int
_ MutableByteArray# s
byteArr) Int
i = do
a
x <- MutableByteArray (PrimState (ST s)) -> Int -> ST s a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
byteArr) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
a
y <- MutableByteArray (PrimState (ST s)) -> Int -> ST s a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
byteArr) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Interval a -> ST s (Interval a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, a) -> Interval a
forall a. Ord a => (a, a) -> Interval a
pairToInterval (a
x, a
y))
unsafeWrite :: STUArray s i (Interval a) -> Int -> Interval a -> ST s ()
unsafeWrite (A.STUArray i
_ i
_ Int
_ MutableByteArray# s
byteArr) Int
i Interval a
e = do
let (a
x, a
y) = Interval a -> (a, a)
forall a. Fractional a => Interval a -> (a, a)
intervalToPair Interval a
e
MutableByteArray (PrimState (ST s)) -> Int -> a -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
byteArr) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) a
x
MutableByteArray (PrimState (ST s)) -> Int -> a -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
byteArr) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
y
instance (Prim a, Ord a, Fractional a) => A.IArray A.UArray (Interval a) where
bounds :: UArray i (Interval a) -> (i, i)
bounds (A.UArray i
l i
u Int
_ ByteArray#
_) = (i
l,i
u)
numElements :: UArray i (Interval a) -> Int
numElements (A.UArray i
_ i
_ Int
n ByteArray#
_) = Int
n
unsafeArray :: (i, i) -> [(Int, Interval a)] -> UArray i (Interval a)
unsafeArray (i, i)
bounds [(Int, Interval a)]
el = (forall s. ST s (UArray i (Interval a))) -> UArray i (Interval a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UArray i (Interval a))) -> UArray i (Interval a))
-> (forall s. ST s (UArray i (Interval a)))
-> UArray i (Interval a)
forall a b. (a -> b) -> a -> b
$ do
STUArray s i (Interval a)
marr <- (i, i) -> ST s (STUArray s i (Interval a))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
A.newArray_ (i, i)
bounds
[(Int, Interval a)] -> ((Int, Interval a) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, Interval a)]
el (((Int, Interval a) -> ST s ()) -> ST s ())
-> ((Int, Interval a) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,Interval a
e) -> STUArray s i (Interval a) -> Int -> Interval a -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
A.unsafeWrite STUArray s i (Interval a)
marr Int
i Interval a
e
STUArray s i (Interval a) -> ST s (UArray i (Interval a))
forall s i e. STUArray s i e -> ST s (UArray i e)
A.unsafeFreezeSTUArray STUArray s i (Interval a)
marr
unsafeAt :: UArray i (Interval a) -> Int -> Interval a
unsafeAt (A.UArray i
_ i
_ Int
_ ByteArray#
byteArr) Int
i =
let x :: a
x = ByteArray -> Int -> a
forall a. Prim a => ByteArray -> Int -> a
indexByteArray (ByteArray# -> ByteArray
ByteArray ByteArray#
byteArr) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
y :: a
y = ByteArray -> Int -> a
forall a. Prim a => ByteArray -> Int -> a
indexByteArray (ByteArray# -> ByteArray
ByteArray ByteArray#
byteArr) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
in (a, a) -> Interval a
forall a. Ord a => (a, a) -> Interval a
pairToInterval (a
x, a
y)
{-# RULES
"fromIntegral/a->Interval Float"
fromIntegral = \x -> case intervalFromIntegral x of (l, u) -> I l u :: Interval Float
"fromIntegral/a->Interval Double"
fromIntegral = \x -> case intervalFromIntegral x of (l, u) -> I l u :: Interval Double
#-}