{-# LANGUAGE CPP, ForeignFunctionInterface, MultiParamTypeClasses #-}
{-# OPTIONS_GHC
-XGeneralizedNewtypeDeriving
-XScopedTypeVariables
-XInstanceSigs
#-}
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# OPTIONS_GHC -O2 -fexcess-precision -fenable-rewrite-rules #-}
module Data.Number.LogFloat
(
module Data.Number.Transfinite
, LogFloat()
, logFloat
, fromLogFloat
, logToLogFloat
, logFromLogFloat
, sum, product
, pow
, log1p, expm1
) where
import Prelude hiding (log, sum, product, isInfinite, isNaN)
import Data.List (foldl')
import Data.Number.Transfinite
import Data.Number.PartialOrd
import Data.Array.Base (IArray(..))
import Data.Array.Unboxed (UArray)
#ifdef __HUGS__
import Hugs.IOExts (unsafeCoerce)
#elif __NHC__
import NonStdUnsafeCoerce (unsafeCoerce)
#elif __GLASGOW_HASKELL__ >= 710
import Unsafe.Coerce (unsafeCoerce)
import Data.Ix (Ix)
#endif
#ifdef __GLASGOW_HASKELL__
import Foreign.Storable (Storable)
#endif
newtype LogFloat = LogFloat Double
deriving
( LogFloat -> LogFloat -> Bool
(LogFloat -> LogFloat -> Bool)
-> (LogFloat -> LogFloat -> Bool) -> Eq LogFloat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogFloat -> LogFloat -> Bool
$c/= :: LogFloat -> LogFloat -> Bool
== :: LogFloat -> LogFloat -> Bool
$c== :: LogFloat -> LogFloat -> Bool
Eq
, Eq LogFloat
Eq LogFloat
-> (LogFloat -> LogFloat -> Ordering)
-> (LogFloat -> LogFloat -> Bool)
-> (LogFloat -> LogFloat -> Bool)
-> (LogFloat -> LogFloat -> Bool)
-> (LogFloat -> LogFloat -> Bool)
-> (LogFloat -> LogFloat -> LogFloat)
-> (LogFloat -> LogFloat -> LogFloat)
-> Ord LogFloat
LogFloat -> LogFloat -> Bool
LogFloat -> LogFloat -> Ordering
LogFloat -> LogFloat -> LogFloat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogFloat -> LogFloat -> LogFloat
$cmin :: LogFloat -> LogFloat -> LogFloat
max :: LogFloat -> LogFloat -> LogFloat
$cmax :: LogFloat -> LogFloat -> LogFloat
>= :: LogFloat -> LogFloat -> Bool
$c>= :: LogFloat -> LogFloat -> Bool
> :: LogFloat -> LogFloat -> Bool
$c> :: LogFloat -> LogFloat -> Bool
<= :: LogFloat -> LogFloat -> Bool
$c<= :: LogFloat -> LogFloat -> Bool
< :: LogFloat -> LogFloat -> Bool
$c< :: LogFloat -> LogFloat -> Bool
compare :: LogFloat -> LogFloat -> Ordering
$ccompare :: LogFloat -> LogFloat -> Ordering
$cp1Ord :: Eq LogFloat
Ord
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__ < 710
, IArray UArray
#endif
, Ptr b -> Int -> IO LogFloat
Ptr b -> Int -> LogFloat -> IO ()
Ptr LogFloat -> IO LogFloat
Ptr LogFloat -> Int -> IO LogFloat
Ptr LogFloat -> Int -> LogFloat -> IO ()
Ptr LogFloat -> LogFloat -> IO ()
LogFloat -> Int
(LogFloat -> Int)
-> (LogFloat -> Int)
-> (Ptr LogFloat -> Int -> IO LogFloat)
-> (Ptr LogFloat -> Int -> LogFloat -> IO ())
-> (forall b. Ptr b -> Int -> IO LogFloat)
-> (forall b. Ptr b -> Int -> LogFloat -> IO ())
-> (Ptr LogFloat -> IO LogFloat)
-> (Ptr LogFloat -> LogFloat -> IO ())
-> Storable LogFloat
forall b. Ptr b -> Int -> IO LogFloat
forall b. Ptr b -> Int -> LogFloat -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr LogFloat -> LogFloat -> IO ()
$cpoke :: Ptr LogFloat -> LogFloat -> IO ()
peek :: Ptr LogFloat -> IO LogFloat
$cpeek :: Ptr LogFloat -> IO LogFloat
pokeByteOff :: Ptr b -> Int -> LogFloat -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> LogFloat -> IO ()
peekByteOff :: Ptr b -> Int -> IO LogFloat
$cpeekByteOff :: forall b. Ptr b -> Int -> IO LogFloat
pokeElemOff :: Ptr LogFloat -> Int -> LogFloat -> IO ()
$cpokeElemOff :: Ptr LogFloat -> Int -> LogFloat -> IO ()
peekElemOff :: Ptr LogFloat -> Int -> IO LogFloat
$cpeekElemOff :: Ptr LogFloat -> Int -> IO LogFloat
alignment :: LogFloat -> Int
$calignment :: LogFloat -> Int
sizeOf :: LogFloat -> Int
$csizeOf :: LogFloat -> Int
Storable
#endif
)
#if __GLASGOW_HASKELL__ >= 710
instance IArray UArray LogFloat where
{-# INLINE bounds #-}
bounds :: forall i. Ix i => UArray i LogFloat -> (i, i)
bounds :: UArray i LogFloat -> (i, i)
bounds = (UArray i Double -> (i, i)) -> UArray i LogFloat -> (i, i)
forall a b. a -> b
unsafeCoerce (UArray i Double -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds :: UArray i Double -> (i, i))
{-# INLINE numElements #-}
numElements :: forall i. Ix i => UArray i LogFloat -> Int
numElements :: UArray i LogFloat -> Int
numElements = (UArray i Double -> Int) -> UArray i LogFloat -> Int
forall a b. a -> b
unsafeCoerce (UArray i Double -> Int
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> Int
numElements :: UArray i Double -> Int)
{-# INLINE unsafeArray #-}
unsafeArray :: forall i. Ix i => (i,i) -> [(Int,LogFloat)] -> UArray i LogFloat
unsafeArray :: (i, i) -> [(Int, LogFloat)] -> UArray i LogFloat
unsafeArray = ((i, i) -> [(Int, Double)] -> UArray i Double)
-> (i, i) -> [(Int, LogFloat)] -> UArray i LogFloat
forall a b. a -> b
unsafeCoerce ((i, i) -> [(Int, Double)] -> UArray i Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(Int, e)] -> a i e
unsafeArray :: (i,i) -> [(Int,Double)] -> UArray i Double)
{-# INLINE unsafeAt #-}
unsafeAt :: forall i. Ix i => UArray i LogFloat -> Int -> LogFloat
unsafeAt :: UArray i LogFloat -> Int -> LogFloat
unsafeAt = (UArray i Double -> Int -> Double)
-> UArray i LogFloat -> Int -> LogFloat
forall a b. a -> b
unsafeCoerce (UArray i Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt :: UArray i Double -> Int -> Double)
{-# INLINE unsafeReplace #-}
unsafeReplace :: forall i. Ix i => UArray i LogFloat -> [(Int,LogFloat)] -> UArray i LogFloat
unsafeReplace :: UArray i LogFloat -> [(Int, LogFloat)] -> UArray i LogFloat
unsafeReplace = (UArray i Double -> [(Int, Double)] -> UArray i Double)
-> UArray i LogFloat -> [(Int, LogFloat)] -> UArray i LogFloat
forall a b. a -> b
unsafeCoerce (UArray i Double -> [(Int, Double)] -> UArray i Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(Int, e)] -> a i e
unsafeReplace :: UArray i Double -> [(Int,Double)] -> UArray i Double)
{-# INLINE unsafeAccum #-}
unsafeAccum :: forall i e. Ix i => (LogFloat -> e -> LogFloat) -> UArray i LogFloat -> [(Int,e)] -> UArray i LogFloat
unsafeAccum :: (LogFloat -> e -> LogFloat)
-> UArray i LogFloat -> [(Int, e)] -> UArray i LogFloat
unsafeAccum = ((Double -> e -> Double)
-> UArray i Double -> [(Int, e)] -> UArray i Double)
-> (LogFloat -> e -> LogFloat)
-> UArray i LogFloat
-> [(Int, e)]
-> UArray i LogFloat
forall a b. a -> b
unsafeCoerce ((Double -> e -> Double)
-> UArray i Double -> [(Int, e)] -> UArray i Double
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> a i e -> [(Int, e')] -> a i e
unsafeAccum :: (Double -> e -> Double) -> UArray i Double -> [(Int,e)] -> UArray i Double)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray :: forall i e. Ix i => (LogFloat -> e -> LogFloat) -> LogFloat -> (i,i) -> [(Int,e)] -> UArray i LogFloat
unsafeAccumArray :: (LogFloat -> e -> LogFloat)
-> LogFloat -> (i, i) -> [(Int, e)] -> UArray i LogFloat
unsafeAccumArray = ((Double -> e -> Double)
-> Double -> (i, i) -> [(Int, e)] -> UArray i Double)
-> (LogFloat -> e -> LogFloat)
-> LogFloat
-> (i, i)
-> [(Int, e)]
-> UArray i LogFloat
forall a b. a -> b
unsafeCoerce ((Double -> e -> Double)
-> Double -> (i, i) -> [(Int, e)] -> UArray i Double
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(Int, e')] -> a i e
unsafeAccumArray :: (Double -> e -> Double) -> Double -> (i,i) -> [(Int,e)] -> UArray i Double)
#elif __HUGS__ || __NHC__
(~>) :: (a -> b) -> (d -> c) -> (b -> d) -> a -> c
{-# INLINE (~>) #-}
infixr 2 ~>
f ~> g = (. f) . (g .)
($::) :: a -> (a -> b) -> b
{-# INLINE ($::) #-}
infixl 1 $::
($::) = flip ($)
{-# INLINE logFromLFAssocs #-}
logFromLFAssocs :: [(Int, LogFloat)] -> [(Int, Double)]
#if __GLASGOW_HASKELL__ >= 710
logFromLFAssocs = coerce
#else
logFromLFAssocs = unsafeCoerce
#endif
{-# INLINE logFromLFUArray #-}
logFromLFUArray :: UArray a LogFloat -> UArray a Double
logFromLFUArray = unsafeCoerce
{-# INLINE unsafeLogToLFUArray #-}
unsafeLogToLFUArray :: UArray a Double -> UArray a LogFloat
unsafeLogToLFUArray = unsafeCoerce
{-# INLINE unsafeLogToLFFunc #-}
unsafeLogToLFFunc :: (LogFloat -> a -> LogFloat) -> (Double -> a -> Double)
unsafeLogToLFFunc = ($:: unsafeLogToLogFloat ~> id ~> logFromLogFloat)
{-# INLINE unsafeLogToLogFloat #-}
unsafeLogToLogFloat :: Double -> LogFloat
unsafeLogToLogFloat = LogFloat
instance IArray UArray LogFloat where
{-# INLINE bounds #-}
bounds = bounds . logFromLFUArray
#if (!(defined(__HUGS__))) || (__HUGS__ > 200609)
{-# INLINE numElements #-}
numElements = numElements . logFromLFUArray
#endif
{-# INLINE unsafeArray #-}
unsafeArray =
unsafeArray $:: id ~> logFromLFAssocs ~> unsafeLogToLFUArray
{-# INLINE unsafeAt #-}
unsafeAt =
unsafeAt $:: logFromLFUArray ~> id ~> unsafeLogToLogFloat
{-# INLINE unsafeReplace #-}
unsafeReplace =
unsafeReplace $:: logFromLFUArray ~> logFromLFAssocs ~> unsafeLogToLFUArray
{-# INLINE unsafeAccum #-}
unsafeAccum =
unsafeAccum $:: unsafeLogToLFFunc ~> logFromLFUArray ~> id ~> unsafeLogToLFUArray
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray =
unsafeAccumArray $:: unsafeLogToLFFunc ~> logFromLogFloat ~> id ~> id ~> unsafeLogToLFUArray
#endif
instance PartialOrd LogFloat where
cmp :: LogFloat -> LogFloat -> Maybe Ordering
cmp (LogFloat Double
x) (LogFloat Double
y)
| Double -> Bool
forall a. Transfinite a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. Transfinite a => a -> Bool
isNaN Double
y = Maybe Ordering
forall a. Maybe a
Nothing
| Bool
otherwise = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$! Double
x Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Double
y
instance Read LogFloat where
readsPrec :: Int -> ReadS LogFloat
readsPrec Int
p String
s =
[(Double -> LogFloat
LogFloat (Double -> Double
forall a. (Floating a, Transfinite a) => a -> a
log Double
x), String
r) | (Double
x, String
r) <- Int -> ReadS Double
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
s, Bool -> Bool
not (Double -> Bool
forall a. Transfinite a => a -> Bool
isNaN Double
x), Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0]
errorOutOfRange :: String -> a
{-# NOINLINE errorOutOfRange #-}
errorOutOfRange :: String -> a
errorOutOfRange String
fun =
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$! String
"Data.Number.LogFloat."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
funString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": argument out of range"
guardNonNegative :: String -> Double -> Double
guardNonNegative :: String -> Double -> Double
guardNonNegative String
fun Double
x
| Double -> Bool
forall a. Transfinite a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = String -> Double
forall a. String -> a
errorOutOfRange String
fun
| Bool
otherwise = Double
x
guardIsANumber :: String -> Double -> Double
guardIsANumber :: String -> Double -> Double
guardIsANumber String
fun Double
x
| Double -> Bool
forall a. Transfinite a => a -> Bool
isNaN Double
x = String -> Double
forall a. String -> a
errorOutOfRange String
fun
| Bool
otherwise = Double
x
logFloat :: Double -> LogFloat
{-# INLINE [0] logFloat #-}
logFloat :: Double -> LogFloat
logFloat = Double -> LogFloat
LogFloat (Double -> LogFloat) -> (Double -> Double) -> Double -> LogFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. (Floating a, Transfinite a) => a -> a
log (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> Double
guardNonNegative String
"logFloat"
logToLogFloat :: Double -> LogFloat
logToLogFloat :: Double -> LogFloat
logToLogFloat = Double -> LogFloat
LogFloat (Double -> LogFloat) -> (Double -> Double) -> Double -> LogFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> Double
guardIsANumber String
"logToLogFloat"
fromLogFloat :: LogFloat -> Double
{-# INLINE [0] fromLogFloat #-}
fromLogFloat :: LogFloat -> Double
fromLogFloat (LogFloat Double
x) = Double -> Double
forall a. Floating a => a -> a
exp Double
x
logFromLogFloat :: LogFloat -> Double
logFromLogFloat :: LogFloat -> Double
logFromLogFloat (LogFloat Double
x) = Double
x
{-# RULES
-- Out of log-domain and back in
"log/fromLogFloat" forall x. log (fromLogFloat x) = logFromLogFloat x
"logFloat/fromLogFloat" forall x. logFloat (fromLogFloat x) = x
-- Into log-domain and back out
"fromLogFloat/logFloat" forall x. fromLogFloat (logFloat x) = x
#-}
instance Show LogFloat where
showsPrec :: Int -> LogFloat -> String -> String
showsPrec Int
p (LogFloat Double
x) =
let y :: Double
y = Double -> Double
forall a. Floating a => a -> a
exp Double
x in Double
y Double -> (String -> String) -> String -> String
`seq`
Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9)
( String -> String -> String
showString String
"logFloat "
(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Double
y
)
#ifdef __USE_FFI__
#define LOG1P_WHICH_VERSION FFI version.
#else
#define LOG1P_WHICH_VERSION naive version! \
Contact the maintainer with any FFI difficulties.
#endif
#ifdef __USE_FFI__
foreign import ccall unsafe "math.h log1p"
log1p :: Double -> Double
#else
log1p :: Double -> Double
{-# INLINE [0] log1p #-}
log1p x = log (1 + x)
#endif
#ifdef __USE_FFI__
foreign import ccall unsafe "math.h expm1"
expm1 :: Double -> Double
#else
expm1 :: Double -> Double
{-# INLINE [0] expm1 #-}
expm1 x = exp x - 1
#endif
#if !defined(__USE_FFI__)
{-# RULES
-- Into log-domain and back out
"expm1/log1p" forall x. expm1 (log1p x) = x
-- Out of log-domain and back in
"log1p/expm1" forall x. log1p (expm1 x) = x
#-}
#endif
instance Num LogFloat where
* :: LogFloat -> LogFloat -> LogFloat
(*) (LogFloat Double
x) (LogFloat Double
y)
| Double -> Bool
forall a. Transfinite a => a -> Bool
isInfinite Double
x
Bool -> Bool -> Bool
&& Double -> Bool
forall a. Transfinite a => a -> Bool
isInfinite Double
y
Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Double
forall a. Num a => a -> a
negate Double
y = Double -> LogFloat
LogFloat Double
forall a. Transfinite a => a
negativeInfinity
| Bool
otherwise = Double -> LogFloat
LogFloat (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y)
+ :: LogFloat -> LogFloat -> LogFloat
(+) (LogFloat Double
x) (LogFloat Double
y)
| Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y
Bool -> Bool -> Bool
&& Double -> Bool
forall a. Transfinite a => a -> Bool
isInfinite Double
x
Bool -> Bool -> Bool
&& Double -> Bool
forall a. Transfinite a => a -> Bool
isInfinite Double
y = Double -> LogFloat
LogFloat Double
x
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
y = Double -> LogFloat
LogFloat (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
log1p (Double -> Double
forall a. Floating a => a -> a
exp (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)))
| Bool
otherwise = Double -> LogFloat
LogFloat (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
log1p (Double -> Double
forall a. Floating a => a -> a
exp (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y)))
(-) (LogFloat Double
x) (LogFloat Double
y)
| Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Transfinite a => a
negativeInfinity
Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Transfinite a => a
negativeInfinity = Double -> LogFloat
LogFloat Double
forall a. Transfinite a => a
negativeInfinity
| Bool
otherwise =
Double -> LogFloat
LogFloat (String -> Double -> Double
guardIsANumber String
"(-)" (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
log1p (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double
forall a. Floating a => a -> a
exp (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)))))
signum :: LogFloat -> LogFloat
signum (LogFloat Double
x)
| Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Transfinite a => a
negativeInfinity = LogFloat
0
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
forall a. Transfinite a => a
negativeInfinity = LogFloat
1
| Bool
otherwise = String -> LogFloat
forall a. String -> a
errorOutOfRange String
"signum"
negate :: LogFloat -> LogFloat
negate LogFloat
_ = String -> LogFloat
forall a. String -> a
errorOutOfRange String
"negate"
abs :: LogFloat -> LogFloat
abs = LogFloat -> LogFloat
forall a. a -> a
id
fromInteger :: Integer -> LogFloat
fromInteger = Double -> LogFloat
LogFloat (Double -> LogFloat) -> (Integer -> Double) -> Integer -> LogFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. (Floating a, Transfinite a) => a -> a
log
(Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> Double
guardNonNegative String
"fromInteger" (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger
instance Fractional LogFloat where
/ :: LogFloat -> LogFloat -> LogFloat
(/) (LogFloat Double
x) (LogFloat Double
y)
| Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y
Bool -> Bool -> Bool
&& Double -> Bool
forall a. Transfinite a => a -> Bool
isInfinite Double
x
Bool -> Bool -> Bool
&& Double -> Bool
forall a. Transfinite a => a -> Bool
isInfinite Double
y = String -> LogFloat
forall a. String -> a
errorOutOfRange String
"(/)"
| Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Transfinite a => a
negativeInfinity = Double -> LogFloat
LogFloat Double
forall a. Transfinite a => a
negativeInfinity
| Bool
otherwise = Double -> LogFloat
LogFloat (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y)
fromRational :: Rational -> LogFloat
fromRational = Double -> LogFloat
LogFloat (Double -> LogFloat)
-> (Rational -> Double) -> Rational -> LogFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. (Floating a, Transfinite a) => a -> a
log
(Double -> Double) -> (Rational -> Double) -> Rational -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> Double
guardNonNegative String
"fromRational" (Double -> Double) -> (Rational -> Double) -> Rational -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
forall a. Fractional a => Rational -> a
fromRational
instance Real LogFloat where
toRational :: LogFloat -> Rational
toRational (LogFloat Double
x)
| Double -> Bool
forall a. Transfinite a => a -> Bool
isInfinite Double
ex Bool -> Bool -> Bool
|| Double -> Bool
forall a. Transfinite a => a -> Bool
isNaN Double
ex = String -> Rational
forall a. String -> a
errorOutOfRange String
"toRational"
| Bool
otherwise = Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ex
where
ex :: Double
ex = Double -> Double
forall a. Floating a => a -> a
exp Double
x
pow :: LogFloat -> Double -> LogFloat
{-# INLINE pow #-}
infixr 8 `pow`
pow :: LogFloat -> Double -> LogFloat
pow (LogFloat Double
x) Double
m
| Double -> Bool
forall a. Transfinite a => a -> Bool
isNaN Double
mx = Double -> LogFloat
LogFloat Double
0
| Bool
otherwise = Double -> LogFloat
LogFloat Double
mx
where
mx :: Double
mx = Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x
sum :: [LogFloat] -> LogFloat
sum :: [LogFloat] -> LogFloat
sum [LogFloat]
xs = Double -> LogFloat
LogFloat (Double
theMax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. (Floating a, Transfinite a) => a -> a
log Double
theSum)
where
LogFloat Double
theMax = [LogFloat] -> LogFloat
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [LogFloat]
xs
theSum :: Double
theSum = (Double -> LogFloat -> Double) -> Double -> [LogFloat] -> Double
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Double
acc (LogFloat Double
x) -> Double
acc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
exp (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
theMax)) Double
0 [LogFloat]
xs
product :: [LogFloat] -> LogFloat
product :: [LogFloat] -> LogFloat
product = Double -> Double -> [LogFloat] -> LogFloat
kahan Double
0 Double
0
where
kahan :: Double -> Double -> [LogFloat] -> LogFloat
kahan Double
t Double
c [LogFloat]
_ | Double
t Double -> Bool -> Bool
`seq` Double
c Double -> Bool -> Bool
`seq` Bool
False = LogFloat
forall a. HasCallStack => a
undefined
kahan Double
t Double
_ [] = Double -> LogFloat
LogFloat Double
t
kahan Double
t Double
c (LogFloat Double
x : [LogFloat]
xs)
| Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Transfinite a => a
negativeInfinity = Double -> LogFloat
LogFloat Double
forall a. Transfinite a => a
negativeInfinity
| Bool
otherwise =
let y :: Double
y = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c
t' :: Double
t' = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y
c' :: Double
c' = (Double
t' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y
in Double -> Double -> [LogFloat] -> LogFloat
kahan Double
t' Double
c' [LogFloat]
xs