{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Numeric.Rounded.Hardware.Interval
  ( Interval(..)
  , increasing
  , maxI
  , minI
  , powInt
  , null
  , inf
  , sup
  , width
  , widthUlp
  , hull
  , intersection
  ) 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 (expm1, log1mexp, log1p, log1pexp)
import           GHC.Generics (Generic)
import           Numeric.Rounded.Hardware.Internal
import qualified Numeric.Rounded.Hardware.Interval.Class as C
import qualified Numeric.Rounded.Hardware.Interval.NonEmpty as NE
import           Prelude hiding (null)

data Interval a
  = I !(Rounded 'TowardNegInf a) !(Rounded 'TowardInf a)
  | Empty
  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 f :: forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
f (I a :: Rounded 'TowardNegInf a
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
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)
increasing _ Empty   = Interval a
forall a. Interval a
Empty
{-# INLINE increasing #-}

instance (Num a, RoundedRing a) => Num (Interval a) where
  + :: Interval a -> Interval a -> Interval a
(+) = (Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
forall a.
(Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
liftBinaryNE Interval a -> Interval a -> Interval a
forall a. Num a => a -> a -> a
(+)
  (-) = (Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
forall a.
(Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
liftBinaryNE (-)
  negate :: Interval a -> Interval a
negate = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Num a => a -> a
negate
  * :: Interval a -> Interval a -> Interval a
(*) = (Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
forall a.
(Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
liftBinaryNE Interval a -> Interval a -> Interval a
forall a. Num a => a -> a -> a
(*)
  abs :: Interval a -> Interval a
abs = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Num a => a -> a
abs
  signum :: Interval a -> Interval a
signum = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Interval a
fromInteger x :: 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
                    (y :: Rounded 'TowardNegInf a
y, 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 -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Fractional a => a -> a
recip
  / :: Interval a -> Interval a -> Interval a
(/) = (Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
forall a.
(Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
liftBinaryNE Interval a -> Interval a -> Interval a
forall a. Fractional a => a -> a -> a
(/)
  fromRational :: Rational -> Interval a
fromRational x :: 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
                     (y :: Rounded 'TowardNegInf a
y, 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 a :: Rounded 'TowardNegInf a
a a' :: Rounded 'TowardInf a
a') (I b :: Rounded 'TowardNegInf a
b 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')
maxI _ _               = Interval a
forall a. Interval a
Empty
{-# SPECIALIZE maxI :: Interval Float -> Interval Float -> Interval Float #-}
{-# SPECIALIZE maxI :: Interval Double -> Interval Double -> Interval Double #-}

minI :: Ord a => Interval a -> Interval a -> Interval a
minI :: Interval a -> Interval a -> Interval a
minI (I a :: Rounded 'TowardNegInf a
a a' :: Rounded 'TowardInf a
a') (I b :: Rounded 'TowardNegInf a
b 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')
minI _ _               = Interval a
forall a. Interval a
Empty
{-# SPECIALIZE minI :: Interval Float -> Interval Float -> Interval Float #-}
{-# SPECIALIZE minI :: Interval Double -> Interval Double -> Interval Double #-}

powInt :: (Ord a, Num a, RoundedRing a) => Interval a -> Int -> Interval a
powInt :: Interval a -> Int -> Interval a
powInt (I a :: Rounded 'TowardNegInf a
a a' :: Rounded 'TowardInf a
a') n :: Int
n | Int -> Bool
forall a. Integral a => a -> Bool
odd Int
n Bool -> Bool -> Bool
|| 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
<= 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
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
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 0 (Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall a. Ord a => a -> a -> a
max ((Rounded 'TowardNegInf a -> Rounded 'TowardInf a
forall a b. Coercible a b => a -> b
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))
powInt Empty _ = Interval a
forall a. Interval a
Empty
{-# SPECIALIZE powInt :: Interval Float -> Int -> Interval Float #-}
{-# SPECIALIZE powInt :: Interval Double -> Int -> Interval Double #-}

null :: Interval a -> Bool
null :: Interval a -> Bool
null Empty = Bool
True
null _     = Bool
False

inf :: Interval a -> Rounded 'TowardNegInf a
inf :: Interval a -> Rounded 'TowardNegInf a
inf (I x :: Rounded 'TowardNegInf a
x _) = Rounded 'TowardNegInf a
x
inf _       = String -> Rounded 'TowardNegInf a
forall a. HasCallStack => String -> a
error "empty interval"

sup :: Interval a -> Rounded 'TowardInf a
sup :: Interval a -> Rounded 'TowardInf a
sup (I _ y :: Rounded 'TowardInf a
y) = Rounded 'TowardInf a
y
sup _       = String -> Rounded 'TowardInf a
forall a. HasCallStack => String -> a
error "empty interval"

width :: (Num a, RoundedRing a) => Interval a -> Rounded 'TowardInf a
width :: Interval a -> Rounded 'TowardInf a
width (I x :: Rounded 'TowardNegInf a
x y :: 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
forall a b. Coercible a b => a -> b
coerce Rounded 'TowardNegInf a
x
width Empty   = 0

widthUlp :: (RealFloat a) => Interval a -> Maybe Integer
widthUlp :: Interval a -> Maybe Integer
widthUlp (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) = a -> a -> Maybe Integer
forall a. RealFloat a => a -> a -> Maybe Integer
distanceUlp (Rounded 'TowardNegInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardNegInf a
x) (Rounded 'TowardInf a -> a
forall (r :: RoundingMode) a. Rounded r a -> a
getRounded Rounded 'TowardInf a
y)
widthUlp Empty   = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0

hull :: RoundedRing a => Interval a -> Interval a -> Interval a
hull :: Interval a -> Interval a -> Interval a
hull (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' 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
-> 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')
hull Empty v :: Interval a
v           = Interval a
v
hull u :: Interval a
u Empty           = Interval a
u

intersection :: RoundedRing a => Interval a -> Interval a -> Interval a
intersection :: Interval a -> Interval a -> Interval a
intersection (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' y' :: 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''
  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'
intersection _ _ = Interval a
forall a. Interval a
Empty

liftUnaryNE :: (NE.Interval a -> NE.Interval a) -> Interval a -> Interval a
liftUnaryNE :: (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE f :: Interval a -> Interval a
f (I x :: Rounded 'TowardNegInf a
x x' :: Rounded 'TowardInf a
x') = case Interval a -> Interval a
f (Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
NE.I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
x') of
                           NE.I y :: Rounded 'TowardNegInf a
y 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'
liftUnaryNE _f :: Interval a -> Interval a
_f Empty = Interval a
forall a. Interval a
Empty
{-# INLINE [1] liftUnaryNE #-}

liftBinaryNE :: (NE.Interval a -> NE.Interval a -> NE.Interval a) -> Interval a -> Interval a -> Interval a
liftBinaryNE :: (Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
liftBinaryNE f :: Interval a -> Interval a -> Interval a
f (I x :: Rounded 'TowardNegInf a
x x' :: Rounded 'TowardInf a
x') (I y :: Rounded 'TowardNegInf a
y y' :: Rounded 'TowardInf a
y') = case Interval a -> Interval a -> Interval a
f (Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
NE.I Rounded 'TowardNegInf a
x Rounded 'TowardInf a
x') (Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
forall a.
Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Interval a
NE.I Rounded 'TowardNegInf a
y Rounded 'TowardInf a
y') of
                                     NE.I z :: Rounded 'TowardNegInf a
z z' :: Rounded 'TowardInf a
z' -> 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'
liftBinaryNE _f :: Interval a -> Interval a -> Interval a
_f _ _ = Interval a
forall a. Interval a
Empty
{-# INLINE [1] liftBinaryNE #-}

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) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
exp
  log :: Interval a -> Interval a
log = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
log
  sqrt :: Interval a -> Interval a
sqrt = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
sqrt
  ** :: Interval a -> Interval a -> Interval a
(**) = (Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
forall a.
(Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
liftBinaryNE Interval a -> Interval a -> Interval a
forall a. Floating a => a -> a -> a
(**)
  logBase :: Interval a -> Interval a -> Interval a
logBase = (Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
forall a.
(Interval a -> Interval a -> Interval a)
-> Interval a -> Interval a -> Interval a
liftBinaryNE Interval a -> Interval a -> Interval a
forall a. Floating a => a -> a -> a
logBase
  sin :: Interval a -> Interval a
sin = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
sin
  cos :: Interval a -> Interval a
cos = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
cos
  tan :: Interval a -> Interval a
tan = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
tan
  asin :: Interval a -> Interval a
asin = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
asin
  acos :: Interval a -> Interval a
acos = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
acos
  atan :: Interval a -> Interval a
atan = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
atan
  sinh :: Interval a -> Interval a
sinh = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
sinh
  cosh :: Interval a -> Interval a
cosh = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
cosh
  tanh :: Interval a -> Interval a
tanh = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
tanh
  asinh :: Interval a -> Interval a
asinh = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
asinh
  acosh :: Interval a -> Interval a
acosh = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
acosh
  atanh :: Interval a -> Interval a
atanh = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
atanh
  log1p :: Interval a -> Interval a
log1p = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
log1p
  expm1 :: Interval a -> Interval a
expm1 = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
expm1
  log1pexp :: Interval a -> Interval a
log1pexp = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
log1pexp
  log1mexp :: Interval a -> Interval a
log1mexp = (Interval a -> Interval a) -> Interval a -> Interval a
forall a. (Interval a -> Interval a) -> Interval a -> Interval a
liftUnaryNE Interval a -> Interval a
forall a. Floating a => a -> a
log1mexp
  {-# INLINE exp #-}
  {-# INLINE log #-}
  {-# INLINE sqrt #-}
  {-# INLINE (**) #-}
  {-# INLINE logBase #-}
  {-# INLINE sin #-}
  {-# INLINE cos #-}
  {-# INLINE tan #-}
  {-# INLINE asin #-}
  {-# INLINE acos #-}
  {-# INLINE atan #-}
  {-# INLINE sinh #-}
  {-# INLINE cosh #-}
  {-# INLINE tanh #-}
  {-# INLINE asinh #-}
  {-# INLINE acosh #-}
  {-# INLINE atanh #-}
  {-# INLINE log1p #-}
  {-# INLINE expm1 #-}
  {-# INLINE log1pexp #-}
  {-# INLINE log1mexp #-}

instance (Num a, RoundedRing a, RealFloat 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 f :: Rounded 'TowardNegInf (EndPoint (Interval a))
-> Rounded 'TowardInf (EndPoint (Interval a)) -> Interval a
f (I x :: Rounded 'TowardNegInf a
x y :: 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
  withEndPoints _ Empty   = Interval a
forall a. Interval a
Empty
  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 = Interval a -> Interval a -> Interval a
forall a. RoundedRing a => Interval a -> Interval a -> Interval a
intersection
  maybeIntersection :: Interval a -> Interval a -> Maybe (Interval a)
maybeIntersection x :: Interval a
x y :: Interval a
y = case Interval a -> Interval a -> Interval a
forall a. RoundedRing a => Interval a -> Interval a -> Interval a
intersection Interval a
x Interval a
y of
                            Empty -> Maybe (Interval a)
forall a. Maybe a
Nothing
                            z :: Interval a
z     -> Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just Interval a
z
  equalAsSet :: Interval a -> Interval a -> Bool
equalAsSet (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' y' :: 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'
  equalAsSet Empty Empty       = Bool
True
  equalAsSet _ _               = Bool
False
  subset :: Interval a -> Interval a -> Bool
subset (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' y' :: 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'
  subset Empty _           = Bool
True
  subset I{} Empty         = Bool
False
  weaklyLess :: Interval a -> Interval a -> Bool
weaklyLess (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' y' :: 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 Empty Empty       = Bool
True
  weaklyLess _ _               = Bool
False
  precedes :: Interval a -> Interval a -> Bool
precedes (I _ y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' _) = 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'
  precedes _ _              = Bool
True
  interior :: Interval a -> Interval a -> Bool
interior (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' y' :: 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 s :: a
s <# :: a -> a -> Bool
<# t :: 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)
  interior Empty _ = Bool
True
  interior I{} Empty = Bool
False
  strictLess :: Interval a -> Interval a -> Bool
strictLess (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' y' :: 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 s :: a
s <# :: a -> a -> Bool
<# t :: 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 Empty Empty = Bool
True
  strictLess _ _ = Bool
False
  strictPrecedes :: Interval a -> Interval a -> Bool
strictPrecedes (I _ y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' _) = 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'
  strictPrecedes _ _              = Bool
True
  disjoint :: Interval a -> Interval a -> Bool
disjoint (I x :: Rounded 'TowardNegInf a
x y :: Rounded 'TowardInf a
y) (I x' :: Rounded 'TowardNegInf a
x' y' :: 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
  disjoint _ _ = Bool
True

--
-- Instance for Data.Vector.Unboxed.Unbox
--

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 x :: a
x) (Rounded y :: a
y)) = (a
x, a
y)
intervalToPair Empty                       = (1a -> a -> a
forall a. Fractional a => a -> a -> a
/0, -1a -> a -> a
forall a. Fractional a => a -> a -> a
/0)
{-# INLINE intervalToPair #-}

pairToInterval :: Ord a => (a, a) -> Interval a
pairToInterval :: (a, a) -> Interval a
pairToInterval (x :: a
x, y :: a
y) | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x = Interval a
forall a. Interval a
Empty
                      | Bool
otherwise = 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 i :: Int
i l :: 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 l :: 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 i :: Int
i x :: 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) i :: 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) i :: Int
i x :: 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) x :: 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) n :: 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 i :: Int
i l :: 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) i :: 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 _) x :: Interval a
x y :: b
y = Interval a
x Interval a -> b -> b
forall a b. 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)

--
-- Instances for Data.Array.Unboxed
--

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 l :: i
l u :: i
u _ _) = (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 _ _ n :: Int
n _) = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
  -- newArray: Use default
  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@(l :: i
l,u :: 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 arr_ :: MutableByteArray# s
arr_) <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (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 0 (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) (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 _ _ _ byteArr :: MutableByteArray# s
byteArr) i :: 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) (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) (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 _ _ _ byteArr :: MutableByteArray# s
byteArr) i :: Int
i e :: Interval a
e = do
    let (x :: a
x, y :: 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) (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) (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 l :: i
l u :: i
u _ _) = (i
l,i
u)
  numElements :: UArray i (Interval a) -> Int
numElements (A.UArray _ _ n :: Int
n _) = Int
n
  unsafeArray :: (i, i) -> [(Int, Interval a)] -> UArray i (Interval a)
unsafeArray bounds :: (i, i)
bounds el :: [(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
$ \(i :: Int
i,e :: 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 _ _ _ byteArr :: ByteArray#
byteArr) i :: Int
i =
    let x :: a
x = ByteArray -> Int -> a
forall a. Prim a => ByteArray -> Int -> a
indexByteArray (ByteArray# -> ByteArray
ByteArray ByteArray#
byteArr) (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) (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
    in (a, a) -> Interval a
forall a. Ord a => (a, a) -> Interval a
pairToInterval (a
x, a
y)
  -- unsafeReplace, unsafeAccum, unsafeAccumArray: Use default

{-# 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
  #-}