brush-strokes-0.1.0.0: src/lib/Math/Interval/Internal/RoundedHW.hs

module Math.Interval.Internal.RoundedHW
  ( 𝕀(𝕀, inf, sup)
  , scaleInterval
  )
  where

-- base
import Prelude hiding ( Num(..), Fractional(..), Floating(..) )
import qualified Prelude

-- brush-strokes
import Math.Ring

-- deepseq
import Control.DeepSeq
  ( NFData(..) )

-- rounded-hw
import Numeric.Rounded.Hardware
  ( Rounded(..) )
import qualified Numeric.Rounded.Hardware.Interval.NonEmpty as Interval
  ( Interval(..), powInt )

--------------------------------------------------------------------------------

-- | A non-empty interval of real numbers (possibly unbounded).
newtype 𝕀 = MkI { ival :: Interval.Interval Double }
  deriving newtype ( Prelude.Num, Prelude.Fractional, Prelude.Floating )
  deriving newtype NFData

{-# COMPLETE 𝕀 #-}
pattern 𝕀 :: Double -> Double -> 𝕀
pattern 𝕀 { inf, sup } = MkI ( Interval.I ( Rounded inf ) ( Rounded sup ) )

instance Ring 𝕀 where
  MkI i1 * MkI i2 = MkI $ i1 Prelude.* i2
  MkI x ^ n = MkI { ival = Interval.powInt x ( Prelude.fromIntegral n ) }
    -- This is very important, as x^2 is not the same as x * x
    -- in interval arithmetic. This ensures we don't
    -- accidentally use (^) from Prelude.

deriving via ViaPrelude 𝕀
  instance AbelianGroup 𝕀
deriving via ViaPrelude 𝕀
  instance Field 𝕀
deriving via ViaPrelude 𝕀
  instance Floating 𝕀
deriving via ViaPrelude 𝕀
  instance Transcendental 𝕀

scaleInterval :: Double -> 𝕀 -> 𝕀
scaleInterval s iv = 𝕀 s s * iv -- TODO: could be better