{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013-2015
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Numeric.Log
  ( Log(..)
  , sum
  ) where

import Prelude hiding (maximum, sum)
import Control.Comonad
import Control.DeepSeq
import Data.Binary as Binary
import Data.Bytes.Serial
import Data.Data
import Data.Distributive
import Data.Foldable as Foldable hiding (sum)
import Data.Functor.Bind
import Data.Functor.Classes
import Data.Functor.Extend
import Data.Hashable
import Data.Hashable.Lifted
import Data.Int
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty(..))
import Data.Semigroup
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Serialize as Serialize
import qualified Data.Vector.Unboxed as U
import Data.Vector.Unboxed (Unbox)
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import Foreign.Ptr
import Foreign.Storable
import GHC.Generics
import Numeric
import Text.Read as T
import Text.Show as T

-- $setup
-- >>> let Exp x ~= Exp y = abs ((exp x-exp y) / exp x) < 0.01

-- | @Log@-domain @Float@ and @Double@ values.
newtype Log a = Exp { Log a -> a
ln :: a } deriving (Log a -> Log a -> Bool
(Log a -> Log a -> Bool) -> (Log a -> Log a -> Bool) -> Eq (Log a)
forall a. Eq a => Log a -> Log a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Log a -> Log a -> Bool
$c/= :: forall a. Eq a => Log a -> Log a -> Bool
== :: Log a -> Log a -> Bool
$c== :: forall a. Eq a => Log a -> Log a -> Bool
Eq,Eq (Log a)
Eq (Log a)
-> (Log a -> Log a -> Ordering)
-> (Log a -> Log a -> Bool)
-> (Log a -> Log a -> Bool)
-> (Log a -> Log a -> Bool)
-> (Log a -> Log a -> Bool)
-> (Log a -> Log a -> Log a)
-> (Log a -> Log a -> Log a)
-> Ord (Log a)
Log a -> Log a -> Bool
Log a -> Log a -> Ordering
Log a -> Log a -> Log a
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
forall a. Ord a => Eq (Log a)
forall a. Ord a => Log a -> Log a -> Bool
forall a. Ord a => Log a -> Log a -> Ordering
forall a. Ord a => Log a -> Log a -> Log a
min :: Log a -> Log a -> Log a
$cmin :: forall a. Ord a => Log a -> Log a -> Log a
max :: Log a -> Log a -> Log a
$cmax :: forall a. Ord a => Log a -> Log a -> Log a
>= :: Log a -> Log a -> Bool
$c>= :: forall a. Ord a => Log a -> Log a -> Bool
> :: Log a -> Log a -> Bool
$c> :: forall a. Ord a => Log a -> Log a -> Bool
<= :: Log a -> Log a -> Bool
$c<= :: forall a. Ord a => Log a -> Log a -> Bool
< :: Log a -> Log a -> Bool
$c< :: forall a. Ord a => Log a -> Log a -> Bool
compare :: Log a -> Log a -> Ordering
$ccompare :: forall a. Ord a => Log a -> Log a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Log a)
Ord,Typeable (Log a)
DataType
Constr
Typeable (Log a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Log a -> c (Log a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Log a))
-> (Log a -> Constr)
-> (Log a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Log a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Log a)))
-> ((forall b. Data b => b -> b) -> Log a -> Log a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Log a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Log a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Log a -> m (Log a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Log a -> m (Log a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Log a -> m (Log a))
-> Data (Log a)
Log a -> DataType
Log a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Log a))
(forall b. Data b => b -> b) -> Log a -> Log a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Log a -> c (Log a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Log a)
forall a. Data a => Typeable (Log a)
forall a. Data a => Log a -> DataType
forall a. Data a => Log a -> Constr
forall a. Data a => (forall b. Data b => b -> b) -> Log a -> Log a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Log a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Log a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Log a -> m (Log a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Log a -> m (Log a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Log a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Log a -> c (Log a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Log a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Log a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Log a -> u
forall u. (forall d. Data d => d -> u) -> Log a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Log a -> m (Log a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Log a -> m (Log a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Log a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Log a -> c (Log a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Log a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Log a))
$cExp :: Constr
$tLog :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Log a -> m (Log a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Log a -> m (Log a)
gmapMp :: (forall d. Data d => d -> m d) -> Log a -> m (Log a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Log a -> m (Log a)
gmapM :: (forall d. Data d => d -> m d) -> Log a -> m (Log a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Log a -> m (Log a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Log a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Log a -> u
gmapQ :: (forall d. Data d => d -> u) -> Log a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Log a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Log a -> r
gmapT :: (forall b. Data b => b -> b) -> Log a -> Log a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Log a -> Log a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Log a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Log a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Log a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Log a))
dataTypeOf :: Log a -> DataType
$cdataTypeOf :: forall a. Data a => Log a -> DataType
toConstr :: Log a -> Constr
$ctoConstr :: forall a. Data a => Log a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Log a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Log a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Log a -> c (Log a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Log a -> c (Log a)
$cp1Data :: forall a. Data a => Typeable (Log a)
Data,(forall x. Log a -> Rep (Log a) x)
-> (forall x. Rep (Log a) x -> Log a) -> Generic (Log a)
forall x. Rep (Log a) x -> Log a
forall x. Log a -> Rep (Log a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Log a) x -> Log a
forall a x. Log a -> Rep (Log a) x
$cto :: forall a x. Rep (Log a) x -> Log a
$cfrom :: forall a x. Log a -> Rep (Log a) x
Generic)

instance (Floating a, Show a) => Show (Log a) where
  showsPrec :: Int -> Log a -> ShowS
showsPrec Int
d (Exp a
a) = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
T.showsPrec Int
d (a -> a
forall a. Floating a => a -> a
exp a
a)

instance (Floating a, Read a) => Read (Log a) where
  readPrec :: ReadPrec (Log a)
readPrec = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> (a -> a) -> a -> Log a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
log (a -> Log a) -> ReadPrec a -> ReadPrec (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
step ReadPrec a
forall a. Read a => ReadPrec a
T.readPrec

instance Binary a => Binary (Log a) where
  put :: Log a -> Put
put = a -> Put
forall t. Binary t => t -> Put
Binary.put (a -> Put) -> (Log a -> a) -> Log a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
  {-# INLINE put #-}
  get :: Get (Log a)
get = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> Get a -> Get (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
Binary.get
  {-# INLINE get #-}

instance Serialize a => Serialize (Log a) where
  put :: Putter (Log a)
put = Putter a
forall t. Serialize t => Putter t
Serialize.put Putter a -> (Log a -> a) -> Putter (Log a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
  {-# INLINE put #-}
  get :: Get (Log a)
get = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> Get a -> Get (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Serialize t => Get t
Serialize.get
  {-# INLINE get #-}

instance Serial a => Serial (Log a) where
  serialize :: Log a -> m ()
serialize = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (a -> m ()) -> (Log a -> a) -> Log a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
  deserialize :: m (Log a)
deserialize = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> m a -> m (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial1 Log where
  serializeWith :: (a -> m ()) -> Log a -> m ()
serializeWith a -> m ()
f = a -> m ()
f (a -> m ()) -> (Log a -> a) -> Log a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
  deserializeWith :: m a -> m (Log a)
deserializeWith m a
m = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> m a -> m (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m

instance Functor Log where
  fmap :: (a -> b) -> Log a -> Log b
fmap a -> b
f (Exp a
a) = b -> Log b
forall a. a -> Log a
Exp (a -> b
f a
a)
  {-# INLINE fmap #-}

instance Hashable a => Hashable (Log a) where
  hashWithSalt :: Int -> Log a -> Int
hashWithSalt Int
i (Exp a
a) = Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i a
a
  {-# INLINE hashWithSalt #-}

instance Hashable1 Log where
  liftHashWithSalt :: (Int -> a -> Int) -> Int -> Log a -> Int
liftHashWithSalt Int -> a -> Int
hws Int
i (Exp a
a) = Int -> a -> Int
hws Int
i a
a
  {-# INLINE liftHashWithSalt #-}

instance Eq1 Log where
  liftEq :: (a -> b -> Bool) -> Log a -> Log b -> Bool
liftEq a -> b -> Bool
eq (Exp a
a) (Exp b
b) = a -> b -> Bool
eq a
a b
b

instance Storable a => Storable (Log a) where
  sizeOf :: Log a -> Int
sizeOf = a -> Int
forall a. Storable a => a -> Int
sizeOf (a -> Int) -> (Log a -> a) -> Log a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
  {-# INLINE sizeOf #-}
  alignment :: Log a -> Int
alignment = a -> Int
forall a. Storable a => a -> Int
alignment (a -> Int) -> (Log a -> a) -> Log a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
  {-# INLINE alignment #-}
  peek :: Ptr (Log a) -> IO (Log a)
peek Ptr (Log a)
ptr = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> IO a -> IO (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr (Log a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Log a)
ptr)
  {-# INLINE peek #-}
  poke :: Ptr (Log a) -> Log a -> IO ()
poke Ptr (Log a)
ptr (Exp a
a) = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Log a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Log a)
ptr) a
a
  {-# INLINE poke #-}

instance NFData a => NFData (Log a) where
  rnf :: Log a -> ()
rnf (Exp a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  {-# INLINE rnf #-}

instance Foldable Log where
  foldMap :: (a -> m) -> Log a -> m
foldMap a -> m
f (Exp a
a) = a -> m
f a
a
  {-# INLINE foldMap #-}

instance Foldable1 Log where
  foldMap1 :: (a -> m) -> Log a -> m
foldMap1 a -> m
f (Exp a
a) = a -> m
f a
a
  {-# INLINE foldMap1 #-}

instance Traversable Log where
  traverse :: (a -> f b) -> Log a -> f (Log b)
traverse a -> f b
f (Exp a
a) = b -> Log b
forall a. a -> Log a
Exp (b -> Log b) -> f b -> f (Log b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  {-# INLINE traverse #-}

instance Traversable1 Log where
  traverse1 :: (a -> f b) -> Log a -> f (Log b)
traverse1 a -> f b
f (Exp a
a) = b -> Log b
forall a. a -> Log a
Exp (b -> Log b) -> f b -> f (Log b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  {-# INLINE traverse1 #-}

instance Distributive Log where
  distribute :: f (Log a) -> Log (f a)
distribute = f a -> Log (f a)
forall a. a -> Log a
Exp (f a -> Log (f a)) -> (f (Log a) -> f a) -> f (Log a) -> Log (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Log a -> a) -> f (Log a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Log a -> a
forall a. Log a -> a
ln
  {-# INLINE distribute #-}

instance Extend Log where
  extended :: (Log a -> b) -> Log a -> Log b
extended Log a -> b
f w :: Log a
w@Exp{} = b -> Log b
forall a. a -> Log a
Exp (Log a -> b
f Log a
w)
  {-# INLINE extended #-}

instance Comonad Log where
  extract :: Log a -> a
extract (Exp a
a) = a
a
  {-# INLINE extract #-}
  extend :: (Log a -> b) -> Log a -> Log b
extend Log a -> b
f w :: Log a
w@Exp{} = b -> Log b
forall a. a -> Log a
Exp (Log a -> b
f Log a
w)
  {-# INLINE extend #-}

instance Applicative Log where
  pure :: a -> Log a
pure = a -> Log a
forall a. a -> Log a
Exp
  {-# INLINE pure #-}
  Exp a -> b
f <*> :: Log (a -> b) -> Log a -> Log b
<*> Exp a
a = b -> Log b
forall a. a -> Log a
Exp (a -> b
f a
a)
  {-# INLINE (<*>) #-}

instance ComonadApply Log where
  Exp a -> b
f <@> :: Log (a -> b) -> Log a -> Log b
<@> Exp a
a = b -> Log b
forall a. a -> Log a
Exp (a -> b
f a
a)
  {-# INLINE (<@>) #-}

instance Apply Log where
  Exp a -> b
f <.> :: Log (a -> b) -> Log a -> Log b
<.> Exp a
a = b -> Log b
forall a. a -> Log a
Exp (a -> b
f a
a)
  {-# INLINE (<.>) #-}

instance Bind Log where
  Exp a
a >>- :: Log a -> (a -> Log b) -> Log b
>>- a -> Log b
f = a -> Log b
f a
a
  {-# INLINE (>>-) #-}

instance Monad Log where
  return :: a -> Log a
return = a -> Log a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  Exp a
a >>= :: Log a -> (a -> Log b) -> Log b
>>= a -> Log b
f = a -> Log b
f a
a
  {-# INLINE (>>=) #-}

instance (RealFloat a, Enum a) => Enum (Log a) where
  succ :: Log a -> Log a
succ Log a
a = Log a
a Log a -> Log a -> Log a
forall a. Num a => a -> a -> a
+ Log a
1
  {-# INLINE succ #-}
  pred :: Log a -> Log a
pred Log a
a = Log a
a Log a -> Log a -> Log a
forall a. Num a => a -> a -> a
- Log a
1
  {-# INLINE pred #-}
  toEnum :: Int -> Log a
toEnum   = Int -> Log a
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE toEnum #-}
  fromEnum :: Log a -> Int
fromEnum = a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Int) -> (Log a -> a) -> Log a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
exp (a -> a) -> (Log a -> a) -> Log a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
  {-# INLINE fromEnum #-}
  enumFrom :: Log a -> [Log a]
enumFrom (Exp a
a) = [ a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
log a
b) | a
b <- a -> [a]
forall a. Enum a => a -> [a]
Prelude.enumFrom (a -> a
forall a. Floating a => a -> a
exp a
a) ]
  {-# INLINE enumFrom #-}
  enumFromThen :: Log a -> Log a -> [Log a]
enumFromThen (Exp a
a) (Exp a
b) = [ a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
log a
c) | a
c <- a -> a -> [a]
forall a. Enum a => a -> a -> [a]
Prelude.enumFromThen (a -> a
forall a. Floating a => a -> a
exp a
a) (a -> a
forall a. Floating a => a -> a
exp a
b) ]
  {-# INLINE enumFromThen #-}
  enumFromTo :: Log a -> Log a -> [Log a]
enumFromTo (Exp a
a) (Exp a
b) = [ a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
log a
c) | a
c <- a -> a -> [a]
forall a. Enum a => a -> a -> [a]
Prelude.enumFromTo (a -> a
forall a. Floating a => a -> a
exp a
a) (a -> a
forall a. Floating a => a -> a
exp a
b) ]
  {-# INLINE enumFromTo #-}
  enumFromThenTo :: Log a -> Log a -> Log a -> [Log a]
enumFromThenTo (Exp a
a) (Exp a
b) (Exp a
c) = [ a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
log a
d) | a
d <- a -> a -> a -> [a]
forall a. Enum a => a -> a -> a -> [a]
Prelude.enumFromThenTo (a -> a
forall a. Floating a => a -> a
exp a
a) (a -> a
forall a. Floating a => a -> a
exp a
b) (a -> a
forall a. Floating a => a -> a
exp a
c) ]
  {-# INLINE enumFromThenTo #-}

-- | Negative infinity
negInf :: Fractional a => a
negInf :: a
negInf = -(a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
{-# INLINE negInf #-}

-- $LogNumTests
--
-- Subtraction
--
-- >>> (3 - 1 :: Log Double) ~= 2
-- True
--
-- >>> 1 - 3 :: Log Double
-- NaN
--
-- >>> (3 - 2 :: Log Float) ~= 1
-- True
--
-- >>> 1 - 3 :: Log Float
-- NaN
--
-- >>> Exp (1/0) - Exp (1/0) :: Log Double
-- NaN
--
-- >>> 0 - 0 :: Log Double
-- 0.0
--
-- >>> 0 - Exp (1/0) :: Log Double
-- NaN
--
-- >>> Exp (1/0) - 0.0 :: Log Double
-- Infinity
--
-- Multiplication
--
-- >>> (3 * 2 :: Log Double) ~= 6
-- True
--
-- >>> 0 * Exp (1/0) :: Log Double
-- NaN
--
-- >>> Exp (1/0) * Exp (1/0) :: Log Double
-- Infinity
--
-- >>> 0 * 0 :: Log Double
-- 0.0
--
-- >>> Exp (0/0) * 0 :: Log Double
-- NaN
--
-- >>> Exp (0/0) * Exp (1/0) :: Log Double
-- NaN
--
-- Addition
--
-- >>> (3 + 1 :: Log Double) ~= 4
-- True
--
-- >>> 0 + 0 :: Log Double
-- 0.0
--
-- >>> Exp (1/0) + Exp (1/0) :: Log Double
-- Infinity
--
-- >>> Exp (1/0) + 0 :: Log Double
-- Infinity
--
-- Division
--
-- >>> (3 / 2 :: Log Double) ~= 1.5
-- True
--
-- >>> 3 / 0 :: Log Double
-- Infinity
--
-- >>> Exp (1/0) / 0 :: Log Double
-- Infinity
--
-- >>> 0 / Exp (1/0) :: Log Double
-- 0.0
--
-- >>> Exp (1/0) / Exp (1/0) :: Log Double
-- NaN
--
-- >>> 0 / 0 :: Log Double
-- NaN
--
-- Negation
--
-- >>> ((-3) + 8 :: Log Double) ~= 8
-- False
--
-- >>> (-0) :: Log Double
-- 0.0
--
-- >>> (-(0/0)) :: Log Double
-- NaN
--
-- Signum
--
-- >>> signum 0 :: Log Double
-- 0.0
--
-- >>> signum 3 :: Log Double
-- 1.0
--
-- >>> signum (Exp (0/0)) :: Log Double
-- NaN

instance RealFloat a => Num (Log a) where
  Exp a
a * :: Log a -> Log a -> Log a
* Exp a
b = a -> Log a
forall a. a -> Log a
Exp (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b)
  {-# INLINE (*) #-}
  Exp a
a + :: Log a -> Log a -> Log a
+ Exp a
b
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
b = a -> Log a
forall a. a -> Log a
Exp a
a
    | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
b    = a -> Log a
forall a. a -> Log a
Exp (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1pexp (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a))
    | Bool
otherwise = a -> Log a
forall a. a -> Log a
Exp (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1pexp (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b))
  {-# INLINE (+) #-}
  Exp a
a - :: Log a -> Log a -> Log a
- Exp a
b
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
b Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a -> Log a
forall a. a -> Log a
Exp a
forall a. Fractional a => a
negInf
    | Bool
otherwise = a -> Log a
forall a. a -> Log a
Exp (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1mexp (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a))
  {-# INLINE (-) #-}
  signum :: Log a -> Log a
signum Log a
a
    | Log a
a Log a -> Log a -> Bool
forall a. Eq a => a -> a -> Bool
== Log a
0    = a -> Log a
forall a. a -> Log a
Exp a
forall a. Fractional a => a
negInf -- 0
    | Log a
a Log a -> Log a -> Bool
forall a. Ord a => a -> a -> Bool
> Log a
0     = a -> Log a
forall a. a -> Log a
Exp a
0      -- 1
    | Bool
otherwise = a -> Log a
forall a. a -> Log a
Exp (a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)  -- NaN
  {-# INLINE signum #-}
  negate :: Log a -> Log a
negate (Exp a
a)
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a -> Log a
forall a. a -> Log a
Exp a
forall a. Fractional a => a
negInf
    | Bool
otherwise             = a -> Log a
forall a. a -> Log a
Exp (a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
  {-# INLINE negate #-}
  abs :: Log a -> Log a
abs = Log a -> Log a
forall a. a -> a
id
  {-# INLINE abs #-}
  fromInteger :: Integer -> Log a
fromInteger = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> (Integer -> a) -> Integer -> Log a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
log (a -> a) -> (Integer -> a) -> Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance RealFloat a => Fractional (Log a) where
  -- n/0 == infinity is handled seamlessly for us, as is 0/0 and infinity/infinity NaNs, and 0/infinity == 0.
  Exp a
a / :: Log a -> Log a -> Log a
/ Exp a
b = a -> Log a
forall a. a -> Log a
Exp (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
b)
  {-# INLINE (/) #-}
  fromRational :: Rational -> Log a
fromRational = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> (Rational -> a) -> Rational -> Log a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
log (a -> a) -> (Rational -> a) -> Rational -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
  {-# INLINE fromRational #-}

-- $LogProperFractionTests
--
-- >>> (properFraction 3.5 :: (Integer, Log Double))
-- (3,0.5)
--
-- >>> (properFraction 0.5 :: (Integer, Log Double))
-- (0,0.5)

instance RealFloat a => RealFrac (Log a) where
  properFraction :: Log a -> (b, Log a)
properFraction Log a
l
    | Log a -> a
forall a. Log a -> a
ln Log a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0  = (b
0, Log a
l)
    | Bool
otherwise = (\(b
b,a
a) -> (b
b, a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> a -> Log a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
log a
a)) ((b, a) -> (b, Log a)) -> (b, a) -> (b, Log a)
forall a b. (a -> b) -> a -> b
$ a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (a -> (b, a)) -> a -> (b, a)
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
exp (Log a -> a
forall a. Log a -> a
ln Log a
l)

newtype instance U.MVector s (Log a) = MV_Log (U.MVector s a)
newtype instance U.Vector    (Log a) = V_Log  (U.Vector    a)

instance (RealFloat a, Unbox a) => Unbox (Log a)

instance Unbox a => M.MVector U.MVector (Log a) where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicInitialize #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength :: MVector s (Log a) -> Int
basicLength (MV_Log v) = MVector s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s a
v
  basicUnsafeSlice :: Int -> Int -> MVector s (Log a) -> MVector s (Log a)
basicUnsafeSlice Int
i Int
n (MV_Log v) = MVector s a -> MVector s (Log a)
forall s a. MVector s a -> MVector s (Log a)
MV_Log (MVector s a -> MVector s (Log a))
-> MVector s a -> MVector s (Log a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
i Int
n MVector s a
v
  basicOverlaps :: MVector s (Log a) -> MVector s (Log a) -> Bool
basicOverlaps (MV_Log v1) (MV_Log v2) = MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s a
v1 MVector s a
v2
  basicUnsafeNew :: Int -> m (MVector (PrimState m) (Log a))
basicUnsafeNew Int
n = MVector (PrimState m) a -> MVector (PrimState m) (Log a)
forall s a. MVector s a -> MVector s (Log a)
MV_Log (MVector (PrimState m) a -> MVector (PrimState m) (Log a))
-> m (MVector (PrimState m) a) -> m (MVector (PrimState m) (Log a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
n
  basicUnsafeReplicate :: Int -> Log a -> m (MVector (PrimState m) (Log a))
basicUnsafeReplicate Int
n (Exp a
x) = MVector (PrimState m) a -> MVector (PrimState m) (Log a)
forall s a. MVector s a -> MVector s (Log a)
MV_Log (MVector (PrimState m) a -> MVector (PrimState m) (Log a))
-> m (MVector (PrimState m) a) -> m (MVector (PrimState m) (Log a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> m (MVector (PrimState m) a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
n a
x
  basicUnsafeRead :: MVector (PrimState m) (Log a) -> Int -> m (Log a)
basicUnsafeRead (MV_Log v) Int
i = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> m a -> m (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) a -> Int -> m a
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) a
v Int
i
  basicUnsafeWrite :: MVector (PrimState m) (Log a) -> Int -> Log a -> m ()
basicUnsafeWrite (MV_Log v) Int
i (Exp a
x) = MVector (PrimState m) a -> Int -> a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) a
v Int
i a
x
  basicClear :: MVector (PrimState m) (Log a) -> m ()
basicClear (MV_Log v) = MVector (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) a
v
  basicInitialize :: MVector (PrimState m) (Log a) -> m ()
basicInitialize (MV_Log v) = MVector (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) a
v
  basicSet :: MVector (PrimState m) (Log a) -> Log a -> m ()
basicSet (MV_Log v) (Exp a
x) = MVector (PrimState m) a -> a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) a
v a
x
  basicUnsafeCopy :: MVector (PrimState m) (Log a)
-> MVector (PrimState m) (Log a) -> m ()
basicUnsafeCopy (MV_Log v1) (MV_Log v2) = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) a
v1 MVector (PrimState m) a
v2
  basicUnsafeGrow :: MVector (PrimState m) (Log a)
-> Int -> m (MVector (PrimState m) (Log a))
basicUnsafeGrow (MV_Log v) Int
n = MVector (PrimState m) a -> MVector (PrimState m) (Log a)
forall s a. MVector s a -> MVector s (Log a)
MV_Log (MVector (PrimState m) a -> MVector (PrimState m) (Log a))
-> m (MVector (PrimState m) a) -> m (MVector (PrimState m) (Log a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) a
v Int
n

instance (RealFloat a, Unbox a) => G.Vector U.Vector (Log a) where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze :: Mutable Vector (PrimState m) (Log a) -> m (Vector (Log a))
basicUnsafeFreeze (MV_Log v) = Vector a -> Vector (Log a)
forall a. Vector a -> Vector (Log a)
V_Log (Vector a -> Vector (Log a)) -> m (Vector a) -> m (Vector (Log a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) a -> m (Vector a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) a
Mutable Vector (PrimState m) a
v
  basicUnsafeThaw :: Vector (Log a) -> m (Mutable Vector (PrimState m) (Log a))
basicUnsafeThaw (V_Log v) = MVector (PrimState m) a -> MVector (PrimState m) (Log a)
forall s a. MVector s a -> MVector s (Log a)
MV_Log (MVector (PrimState m) a -> MVector (PrimState m) (Log a))
-> m (MVector (PrimState m) a) -> m (MVector (PrimState m) (Log a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> m (Mutable Vector (PrimState m) a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector a
v
  basicLength :: Vector (Log a) -> Int
basicLength (V_Log v) = Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector a
v
  basicUnsafeSlice :: Int -> Int -> Vector (Log a) -> Vector (Log a)
basicUnsafeSlice Int
i Int
n (V_Log v) = Vector a -> Vector (Log a)
forall a. Vector a -> Vector (Log a)
V_Log (Vector a -> Vector (Log a)) -> Vector a -> Vector (Log a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
n Vector a
v
  basicUnsafeIndexM :: Vector (Log a) -> Int -> m (Log a)
basicUnsafeIndexM (V_Log v) Int
i = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> m a -> m (Log a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> Int -> m a
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector a
v Int
i
  basicUnsafeCopy :: Mutable Vector (PrimState m) (Log a) -> Vector (Log a) -> m ()
basicUnsafeCopy (MV_Log mv) (V_Log v) = Mutable Vector (PrimState m) a -> Vector a -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) a
Mutable Vector (PrimState m) a
mv Vector a
v
  elemseq :: Vector (Log a) -> Log a -> b -> b
elemseq Vector (Log a)
_ (Exp a
x) = Vector a -> a -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: U.Vector a) a
x

instance (RealFloat a, Ord a) => Real (Log a) where
  toRational :: Log a -> Rational
toRational (Exp a
a) = a -> Rational
forall a. Real a => a -> Rational
toRational (a -> a
forall a. Floating a => a -> a
exp a
a)
  {-# INLINE toRational #-}

data Acc1 a = Acc1 {-# UNPACK #-} !Int64 !a

instance RealFloat a => Semigroup (Log a) where
  <> :: Log a -> Log a -> Log a
(<>) = Log a -> Log a -> Log a
forall a. Num a => a -> a -> a
(+)
  {-# INLINE (<>) #-}
  sconcat :: NonEmpty (Log a) -> Log a
sconcat (Exp a
z :| [Log a]
zs) = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> a -> Log a
forall a b. (a -> b) -> a -> b
$ case (Acc1 a -> Log a -> Acc1 a) -> Acc1 a -> [Log a] -> Acc1 a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Acc1 a -> Log a -> Acc1 a
forall a. Ord a => Acc1 a -> Log a -> Acc1 a
step1 (Int64 -> a -> Acc1 a
forall a. Int64 -> a -> Acc1 a
Acc1 Int64
0 a
z) [Log a]
zs of
    Acc1 Int64
nm1 a
a
      | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a -> a
a
      | Bool
otherwise    -> a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1p ((a -> Log a -> a) -> a -> [Log a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (a -> a -> Log a -> a
forall a. Floating a => a -> a -> Log a -> a
step2 a
a) a
0 [Log a]
zs a -> a -> a
forall a. Num a => a -> a -> a
+ Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nm1)
    where
      step1 :: Acc1 a -> Log a -> Acc1 a
step1 (Acc1 Int64
n a
y) (Exp a
x) = Int64 -> a -> Acc1 a
forall a. Int64 -> a -> Acc1 a
Acc1 (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
y)
      step2 :: a -> a -> Log a -> a
step2 a
a a
r (Exp a
x) = a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
expm1 (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
a)
  {-# INLINE sconcat #-}

instance RealFloat a => Monoid (Log a) where
  mempty :: Log a
mempty  = a -> Log a
forall a. a -> Log a
Exp a
forall a. Fractional a => a
negInf
  {-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif
  mconcat :: [Log a] -> Log a
mconcat [] = Log a
0
  mconcat (Log a
x:[Log a]
xs) = NonEmpty (Log a) -> Log a
forall a. Semigroup a => NonEmpty a -> a
sconcat (Log a
x Log a -> [Log a] -> NonEmpty (Log a)
forall a. a -> [a] -> NonEmpty a
:| [Log a]
xs)

logMap :: Floating a => (a -> a) -> Log a -> Log a
logMap :: (a -> a) -> Log a -> Log a
logMap a -> a
f = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> (Log a -> a) -> Log a -> Log a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
log (a -> a) -> (Log a -> a) -> Log a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> a) -> (Log a -> a) -> Log a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
exp (a -> a) -> (Log a -> a) -> Log a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log a -> a
forall a. Log a -> a
ln
{-# INLINE logMap #-}

data Acc a = Acc {-# UNPACK #-} !Int64 !a | None

-- | Efficiently and accurately compute the sum of a set of log-domain numbers
--
-- While folding with @(+)@ accomplishes the same end, it requires an
-- additional @n-2@ logarithms to sum @n@ terms. In addition,
-- here we introduce fewer opportunities for round-off error.
--
-- While for small quantities the naive sum accumulates error,
--
-- >>> let xs = Prelude.replicate 40000 (Exp 1e-4) :: [Log Float]
-- >>> Prelude.sum xs ~= 4.00e4
-- True
--
-- This sum gives a more accurate result,
--
-- >>> Numeric.Log.sum xs ~= 4.00e4
-- True
--
-- /NB:/ This does require two passes over the data.
sum :: (RealFloat a, Foldable f) => f (Log a) -> Log a
sum :: f (Log a) -> Log a
sum f (Log a)
xs = a -> Log a
forall a. a -> Log a
Exp (a -> Log a) -> a -> Log a
forall a b. (a -> b) -> a -> b
$ case (Acc a -> Log a -> Acc a) -> Acc a -> f (Log a) -> Acc a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Acc a -> Log a -> Acc a
forall a. Ord a => Acc a -> Log a -> Acc a
step1 Acc a
forall a. Acc a
None f (Log a)
xs of
  Acc a
None -> a
forall a. Fractional a => a
negInf
  Acc Int64
nm1 a
a
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
a -> a
a
    | Bool
otherwise    -> a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
log1p ((a -> Log a -> a) -> a -> f (Log a) -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (a -> a -> Log a -> a
forall a. Floating a => a -> a -> Log a -> a
step2 a
a) a
0 f (Log a)
xs a -> a -> a
forall a. Num a => a -> a -> a
+ Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nm1)
  where
    step1 :: Acc a -> Log a -> Acc a
step1 Acc a
None      (Exp a
x) = Int64 -> a -> Acc a
forall a. Int64 -> a -> Acc a
Acc Int64
0 a
x
    step1 (Acc Int64
n a
y) (Exp a
x) = Int64 -> a -> Acc a
forall a. Int64 -> a -> Acc a
Acc (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
y)
    step2 :: a -> a -> Log a -> a
step2 a
a a
r (Exp a
x) = a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
expm1 (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
a)
{-# INLINE sum #-}

instance RealFloat a => Floating (Log a) where
  pi :: Log a
pi = a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
log a
forall a. Floating a => a
pi)
  {-# INLINE pi #-}
  exp :: Log a -> Log a
exp (Exp a
a) = a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
exp a
a)
  {-# INLINE exp #-}
  log :: Log a -> Log a
log (Exp a
a) = a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
log a
a)
  {-# INLINE log #-}
  Exp a
b ** :: Log a -> Log a -> Log a
** Exp a
e = a -> Log a
forall a. a -> Log a
Exp (a
b a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
exp a
e)
  {-# INLINE (**) #-}
  sqrt :: Log a -> Log a
sqrt (Exp a
a) = a -> Log a
forall a. a -> Log a
Exp (a
a a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
  {-# INLINE sqrt #-}
  logBase :: Log a -> Log a -> Log a
logBase (Exp a
a) (Exp a
b) = a -> Log a
forall a. a -> Log a
Exp (a -> a
forall a. Floating a => a -> a
log (a -> a -> a
forall a. Floating a => a -> a -> a
logBase (a -> a
forall a. Floating a => a -> a
exp a
a) (a -> a
forall a. Floating a => a -> a
exp a
b)))
  {-# INLINE logBase #-}
  sin :: Log a -> Log a
sin = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
sin
  {-# INLINE sin #-}
  cos :: Log a -> Log a
cos = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
cos
  {-# INLINE cos #-}
  tan :: Log a -> Log a
tan = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
tan
  {-# INLINE tan #-}
  asin :: Log a -> Log a
asin = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
asin
  {-# INLINE asin #-}
  acos :: Log a -> Log a
acos = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
acos
  {-# INLINE acos #-}
  atan :: Log a -> Log a
atan = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
atan
  {-# INLINE atan #-}
  sinh :: Log a -> Log a
sinh = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
sinh
  {-# INLINE sinh #-}
  cosh :: Log a -> Log a
cosh = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
cosh
  {-# INLINE cosh #-}
  tanh :: Log a -> Log a
tanh = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
tanh
  {-# INLINE tanh #-}
  asinh :: Log a -> Log a
asinh = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
asinh
  {-# INLINE asinh #-}
  acosh :: Log a -> Log a
acosh = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
acosh
  {-# INLINE acosh #-}
  atanh :: Log a -> Log a
atanh = (a -> a) -> Log a -> Log a
forall a. Floating a => (a -> a) -> Log a -> Log a
logMap a -> a
forall a. Floating a => a -> a
atanh
  {-# INLINE atanh #-}

{-# RULES
"realToFrac" realToFrac = Exp . realToFrac . ln :: Log Double -> Log Float
"realToFrac" realToFrac = Exp . realToFrac . ln :: Log Float -> Log Double
"realToFrac" realToFrac = exp . ln :: Log Double -> Double
"realToFrac" realToFrac = exp . ln :: Log Float -> Float
"realToFrac" realToFrac = Exp . log :: Double -> Log Double
"realToFrac" realToFrac = Exp . log :: Float -> Log Float #-}