{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE StandaloneDeriving #-}
{-|
    Module      :  AERN2.MP.Float.Type
    Description :  Arbitrary precision floating point numbers (via cdar)
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    Arbitrary precision floating-point numbers, re-using CDAR Approx type.
-}
module AERN2.MP.Float.Type
  (
   -- * MPFloat numbers and their basic operations
   MPFloat(..)
   , lift1, lift2, lift2R
   , getErrorStepSizeLog
   , setPrecisionCEDU
   , p2cdarPrec
   , getBoundsCEDU
   )
where

import MixedTypesNumPrelude
import qualified Prelude as P

-- import Data.Bits (unsafeShiftL)
import Data.Typeable

import AERN2.Norm
import AERN2.MP.Precision
import AERN2.MP.Float.Auxi

import qualified Data.CDAR as MPLow
import Control.DeepSeq (NFData)
import GHC.Generics (Generic)

{-| Multiple-precision floating-point type based on CDAR.Approx with 0 radius. -}
newtype MPFloat = MPFloat { MPFloat -> Approx
unMPFloat :: MPLow.Approx }
  deriving ((forall x. MPFloat -> Rep MPFloat x)
-> (forall x. Rep MPFloat x -> MPFloat) -> Generic MPFloat
forall x. Rep MPFloat x -> MPFloat
forall x. MPFloat -> Rep MPFloat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MPFloat x -> MPFloat
$cfrom :: forall x. MPFloat -> Rep MPFloat x
Generic)

lift1 :: (MPLow.Approx -> MPLow.Approx) -> MPFloat -> MPFloat
lift1 :: (Approx -> Approx) -> MPFloat -> MPFloat
lift1 Approx -> Approx
f (MPFloat Approx
a) = Approx -> MPFloat
MPFloat (Approx -> Approx
f Approx
a)

lift2 :: 
  (MPLow.Approx -> MPLow.Approx -> MPLow.Approx) -> 
  (MPFloat -> MPFloat -> MPFloat)
lift2 :: (Approx -> Approx -> Approx) -> MPFloat -> MPFloat -> MPFloat
lift2 Approx -> Approx -> Approx
f (MPFloat Approx
a1) (MPFloat Approx
a2) = Approx -> MPFloat
MPFloat (Approx -> Approx -> Approx
f Approx
a1 Approx
a2)

lift2R :: 
  (MPLow.Approx -> MPLow.Approx -> t) -> 
  (MPFloat -> MPFloat -> t)
lift2R :: (Approx -> Approx -> t) -> MPFloat -> MPFloat -> t
lift2R Approx -> Approx -> t
f (MPFloat Approx
a1) (MPFloat Approx
a2) = Approx -> Approx -> t
f Approx
a1 Approx
a2

instance Show MPFloat where
  show :: MPFloat -> String
show MPFloat
x = Approx -> String
MPLow.showA (Approx -> String) -> Approx -> String
forall a b. (a -> b) -> a -> b
$ MPFloat -> Approx
unMPFloat MPFloat
x

deriving instance (Typeable MPFloat)
instance NFData MPFloat

p2cdarPrec :: Precision -> MPLow.Precision
p2cdarPrec :: Precision -> Int
p2cdarPrec = Integer -> Int
forall a. Num a => Integer -> a
P.fromInteger (Integer -> Int) -> (Precision -> Integer) -> Precision -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precision -> Integer
forall t. CanBeInteger t => t -> Integer
integer

getBoundsCEDU :: MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU :: MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU (MPFloat (MPLow.Approx Int
mb Integer
m Integer
e Int
s)) = 
  MPFloat -> MPFloat -> MPFloat -> MPFloat -> BoundsCEDU MPFloat
forall a. a -> a -> a -> a -> BoundsCEDU a
BoundsCEDU 
    (Approx -> MPFloat
MPFloat (Approx -> MPFloat) -> Approx -> MPFloat
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> Int -> Approx
MPLow.Approx Int
mb Integer
m Integer
0 Int
s) (Approx -> MPFloat
MPFloat (Approx -> MPFloat) -> Approx -> MPFloat
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> Int -> Approx
MPLow.approxMB Int
eb_mb Integer
e Integer
0 Int
s)
    (Approx -> MPFloat
MPFloat (Approx -> MPFloat) -> Approx -> MPFloat
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> Int -> Approx
MPLow.Approx Int
mb (Integer
mInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
e) Integer
0 Int
s) (Approx -> MPFloat
MPFloat (Approx -> MPFloat) -> Approx -> MPFloat
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> Int -> Approx
MPLow.Approx Int
mb (Integer
mInteger -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
e) Integer
0 Int
s)
getBoundsCEDU (MPFloat Approx
MPLow.Bottom) =
  MPFloat -> MPFloat -> MPFloat -> MPFloat -> BoundsCEDU MPFloat
forall a. a -> a -> a -> a -> BoundsCEDU a
BoundsCEDU
    (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom) (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom) 
    (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom) (Approx -> MPFloat
MPFloat Approx
MPLow.Bottom)

{-| The bit-size bound for the error bound in CEDU -}
eb_prec :: Precision
eb_prec :: Precision
eb_prec = Integer -> Precision
prec Integer
63

{-| The bit-size bound for the error bound in CEDU -}
eb_mb :: Int
eb_mb :: Int
eb_mb = Integer -> Int
forall t. CanBeInt t => t -> Int
int (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Precision -> Integer
forall t. CanBeInteger t => t -> Integer
integer Precision
eb_prec

instance HasPrecision MPFloat where
  getPrecision :: MPFloat -> Precision
getPrecision (MPFloat (MPLow.Approx Int
mb Integer
_ Integer
_ Int
_)) = Integer -> Precision
prec (Int -> Integer
forall a. Integral a => a -> Integer
P.toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
mb)
  getPrecision (MPFloat Approx
MPLow.Bottom) = String -> Precision
forall a. HasCallStack => String -> a
error String
"illegal MPFloat (Bottom)"
  
instance CanSetPrecision MPFloat where
  setPrecision :: Precision -> MPFloat -> MPFloat
setPrecision Precision
p = BoundsCEDU MPFloat -> MPFloat
forall a. BoundsCEDU a -> a
ceduCentre (BoundsCEDU MPFloat -> MPFloat)
-> (MPFloat -> BoundsCEDU MPFloat) -> MPFloat -> MPFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precision -> MPFloat -> BoundsCEDU MPFloat
setPrecisionCEDU Precision
p

setPrecisionCEDU :: Precision -> MPFloat -> BoundsCEDU MPFloat
setPrecisionCEDU :: Precision -> MPFloat -> BoundsCEDU MPFloat
setPrecisionCEDU Precision
pp = 
  MPFloat -> BoundsCEDU MPFloat
getBoundsCEDU (MPFloat -> BoundsCEDU MPFloat)
-> (MPFloat -> MPFloat) -> MPFloat -> BoundsCEDU MPFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Approx -> Approx) -> MPFloat -> MPFloat
lift1 Approx -> Approx
MPLow.enforceMB (MPFloat -> MPFloat) -> (MPFloat -> MPFloat) -> MPFloat -> MPFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Approx -> Approx) -> MPFloat -> MPFloat
lift1 (Int -> Approx -> Approx
MPLow.setMB (Precision -> Int
p2cdarPrec Precision
pp))

instance HasNorm MPFloat where
  getNormLog :: MPFloat -> NormLog
getNormLog (MPFloat (MPLow.Approx Int
_ Integer
m Integer
_ Int
s)) = (Integer -> NormLog
forall a. HasNorm a => a -> NormLog
getNormLog Integer
m) NormLog -> Integer -> AddType NormLog Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
s)
  getNormLog (MPFloat Approx
MPLow.Bottom) = String -> NormLog
forall a. HasCallStack => String -> a
error String
"getNormLog undefined for Bottom"

{-|
  Returns @s@ such that @2^s@ is the distance to the nearest other number with the same precision.
  Returns Nothing for Bottom.
-}
getErrorStepSizeLog :: MPLow.Approx -> Maybe Int
getErrorStepSizeLog :: Approx -> Maybe Int
getErrorStepSizeLog (MPLow.Approx Int
_ Integer
_ Integer
_ Int
s) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
s
getErrorStepSizeLog Approx
_ = Maybe Int
forall a. Maybe a
Nothing -- represents +Infinity