{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}

-- Module      :  Data.Number.LogFloat
-- Copyright   :  Copyright (c) 2007--2015 wren gayle romano
-- License     :  BSD3
-- Maintainer  :  wren@community.haskell.org
-- Stability   :  stable
-- Portability :  portable (with CPP, FFI)
-- Link        :  https://hackage.haskell.org/package/logfloat

-- | A 'Field' in the log domain.
--
-- LogField is adapted from [logfloat](https://hackage.haskell.org/package/logfloat)
module NumHask.Data.LogField
  ( -- * @LogField@
    LogField (),
    logField,
    fromLogField,

    -- ** Isomorphism to log-domain
    logToLogField,
    logFromLogField,

    -- ** Additional operations
    accurateSum,
    accurateProduct,
    pow,
  )
where

import Data.Data (Data)
import qualified Data.Foldable as F
import GHC.Generics (Generic, Generic1)
import NumHask.Algebra.Additive
import NumHask.Algebra.Field
import NumHask.Algebra.Lattice
import NumHask.Algebra.Multiplicative
import NumHask.Algebra.Ring
import NumHask.Analysis.Metric
import NumHask.Data.Integral
import NumHask.Data.Rational
import Prelude hiding (Num (..), exp, fromIntegral, log, negate)

-- | A @LogField@ is just a 'Field' with a special interpretation.
-- The 'LogField' function is presented instead of the constructor,
-- in order to ensure semantic conversion. At present the 'Show'
-- instance will convert back to the normal-domain, and hence will
-- underflow at that point. This behavior may change in the future.
--
-- Because 'logField' performs the semantic conversion, we can use
-- operators which say what we *mean* rather than saying what we're
-- actually doing to the underlying representation. That is,
-- equivalences like the following are true[1] thanks to type-class
-- overloading:
--
-- > logField (p + q) == logField p + logField q
-- > logField (p * q) == logField p * logField q
--
-- Performing operations in the log-domain is cheap, prevents
-- underflow, and is otherwise very nice for dealing with miniscule
-- probabilities. However, crossing into and out of the log-domain
-- is expensive and should be avoided as much as possible. In
-- particular, if you're doing a series of multiplications as in
-- @lp * LogField q * LogField r@ it's faster to do @lp * LogField
-- (q * r)@ if you're reasonably sure the normal-domain multiplication
-- won't underflow; because that way you enter the log-domain only
-- once, instead of twice. Also note that, for precision, if you're
-- doing more than a few multiplications in the log-domain, you
-- should use 'NumHask.Algebra.Multiplication.product' rather than using '(*)' repeatedly.
--
-- Even more particularly, you should /avoid addition/ whenever
-- possible. Addition is provided because sometimes we need it, and
-- the proper implementation is not immediately apparent. However,
-- between two @LogField@s addition requires crossing the exp\/log
-- boundary twice; with a @LogField@ and a 'Double' it's three
-- times, since the regular number needs to enter the log-domain
-- first. This makes addition incredibly slow. Again, if you can
-- parenthesize to do normal-domain operations first, do it!
--
-- [1] That is, true up-to underflow and floating point fuzziness.
-- Which is, of course, the whole point of this module.
newtype LogField a
  = LogField a
  deriving
    ( LogField a -> LogField a -> Bool
(LogField a -> LogField a -> Bool)
-> (LogField a -> LogField a -> Bool) -> Eq (LogField a)
forall a. Eq a => LogField a -> LogField a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogField a -> LogField a -> Bool
$c/= :: forall a. Eq a => LogField a -> LogField a -> Bool
== :: LogField a -> LogField a -> Bool
$c== :: forall a. Eq a => LogField a -> LogField a -> Bool
Eq,
      Eq (LogField a)
Eq (LogField a)
-> (LogField a -> LogField a -> Ordering)
-> (LogField a -> LogField a -> Bool)
-> (LogField a -> LogField a -> Bool)
-> (LogField a -> LogField a -> Bool)
-> (LogField a -> LogField a -> Bool)
-> (LogField a -> LogField a -> LogField a)
-> (LogField a -> LogField a -> LogField a)
-> Ord (LogField a)
LogField a -> LogField a -> Bool
LogField a -> LogField a -> Ordering
LogField a -> LogField a -> LogField 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 (LogField a)
forall a. Ord a => LogField a -> LogField a -> Bool
forall a. Ord a => LogField a -> LogField a -> Ordering
forall a. Ord a => LogField a -> LogField a -> LogField a
min :: LogField a -> LogField a -> LogField a
$cmin :: forall a. Ord a => LogField a -> LogField a -> LogField a
max :: LogField a -> LogField a -> LogField a
$cmax :: forall a. Ord a => LogField a -> LogField a -> LogField a
>= :: LogField a -> LogField a -> Bool
$c>= :: forall a. Ord a => LogField a -> LogField a -> Bool
> :: LogField a -> LogField a -> Bool
$c> :: forall a. Ord a => LogField a -> LogField a -> Bool
<= :: LogField a -> LogField a -> Bool
$c<= :: forall a. Ord a => LogField a -> LogField a -> Bool
< :: LogField a -> LogField a -> Bool
$c< :: forall a. Ord a => LogField a -> LogField a -> Bool
compare :: LogField a -> LogField a -> Ordering
$ccompare :: forall a. Ord a => LogField a -> LogField a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (LogField a)
Ord,
      ReadPrec [LogField a]
ReadPrec (LogField a)
Int -> ReadS (LogField a)
ReadS [LogField a]
(Int -> ReadS (LogField a))
-> ReadS [LogField a]
-> ReadPrec (LogField a)
-> ReadPrec [LogField a]
-> Read (LogField a)
forall a. Read a => ReadPrec [LogField a]
forall a. Read a => ReadPrec (LogField a)
forall a. Read a => Int -> ReadS (LogField a)
forall a. Read a => ReadS [LogField a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogField a]
$creadListPrec :: forall a. Read a => ReadPrec [LogField a]
readPrec :: ReadPrec (LogField a)
$creadPrec :: forall a. Read a => ReadPrec (LogField a)
readList :: ReadS [LogField a]
$creadList :: forall a. Read a => ReadS [LogField a]
readsPrec :: Int -> ReadS (LogField a)
$creadsPrec :: forall a. Read a => Int -> ReadS (LogField a)
Read,
      Typeable (LogField a)
DataType
Constr
Typeable (LogField a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LogField a -> c (LogField a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (LogField a))
-> (LogField a -> Constr)
-> (LogField a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (LogField a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (LogField a)))
-> ((forall b. Data b => b -> b) -> LogField a -> LogField a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LogField a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LogField a -> r)
-> (forall u. (forall d. Data d => d -> u) -> LogField a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LogField a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LogField a -> m (LogField a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LogField a -> m (LogField a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LogField a -> m (LogField a))
-> Data (LogField a)
LogField a -> DataType
LogField a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (LogField a))
(forall b. Data b => b -> b) -> LogField a -> LogField a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogField a -> c (LogField a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LogField a)
forall a. Data a => Typeable (LogField a)
forall a. Data a => LogField a -> DataType
forall a. Data a => LogField a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> LogField a -> LogField a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> LogField a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> LogField a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LogField a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogField a -> c (LogField a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LogField a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LogField 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) -> LogField a -> u
forall u. (forall d. Data d => d -> u) -> LogField a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LogField a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogField a -> c (LogField a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (LogField a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LogField a))
$cLogField :: Constr
$tLogField :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
gmapMp :: (forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
gmapM :: (forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> LogField a -> m (LogField a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> LogField a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> LogField a -> u
gmapQ :: (forall d. Data d => d -> u) -> LogField a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> LogField a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LogField a -> r
gmapT :: (forall b. Data b => b -> b) -> LogField a -> LogField a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> LogField a -> LogField a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LogField a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LogField a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (LogField a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LogField a))
dataTypeOf :: LogField a -> DataType
$cdataTypeOf :: forall a. Data a => LogField a -> DataType
toConstr :: LogField a -> Constr
$ctoConstr :: forall a. Data a => LogField a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LogField a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LogField a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogField a -> c (LogField a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LogField a -> c (LogField a)
$cp1Data :: forall a. Data a => Typeable (LogField a)
Data,
      (forall x. LogField a -> Rep (LogField a) x)
-> (forall x. Rep (LogField a) x -> LogField a)
-> Generic (LogField a)
forall x. Rep (LogField a) x -> LogField a
forall x. LogField a -> Rep (LogField a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LogField a) x -> LogField a
forall a x. LogField a -> Rep (LogField a) x
$cto :: forall a x. Rep (LogField a) x -> LogField a
$cfrom :: forall a x. LogField a -> Rep (LogField a) x
Generic,
      (forall a. LogField a -> Rep1 LogField a)
-> (forall a. Rep1 LogField a -> LogField a) -> Generic1 LogField
forall a. Rep1 LogField a -> LogField a
forall a. LogField a -> Rep1 LogField a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 LogField a -> LogField a
$cfrom1 :: forall a. LogField a -> Rep1 LogField a
Generic1,
      a -> LogField b -> LogField a
(a -> b) -> LogField a -> LogField b
(forall a b. (a -> b) -> LogField a -> LogField b)
-> (forall a b. a -> LogField b -> LogField a) -> Functor LogField
forall a b. a -> LogField b -> LogField a
forall a b. (a -> b) -> LogField a -> LogField b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LogField b -> LogField a
$c<$ :: forall a b. a -> LogField b -> LogField a
fmap :: (a -> b) -> LogField a -> LogField b
$cfmap :: forall a b. (a -> b) -> LogField a -> LogField b
Functor,
      LogField a -> Bool
(a -> m) -> LogField a -> m
(a -> b -> b) -> b -> LogField a -> b
(forall m. Monoid m => LogField m -> m)
-> (forall m a. Monoid m => (a -> m) -> LogField a -> m)
-> (forall m a. Monoid m => (a -> m) -> LogField a -> m)
-> (forall a b. (a -> b -> b) -> b -> LogField a -> b)
-> (forall a b. (a -> b -> b) -> b -> LogField a -> b)
-> (forall b a. (b -> a -> b) -> b -> LogField a -> b)
-> (forall b a. (b -> a -> b) -> b -> LogField a -> b)
-> (forall a. (a -> a -> a) -> LogField a -> a)
-> (forall a. (a -> a -> a) -> LogField a -> a)
-> (forall a. LogField a -> [a])
-> (forall a. LogField a -> Bool)
-> (forall a. LogField a -> Int)
-> (forall a. Eq a => a -> LogField a -> Bool)
-> (forall a. Ord a => LogField a -> a)
-> (forall a. Ord a => LogField a -> a)
-> (forall a. Num a => LogField a -> a)
-> (forall a. Num a => LogField a -> a)
-> Foldable LogField
forall a. Eq a => a -> LogField a -> Bool
forall a. Num a => LogField a -> a
forall a. Ord a => LogField a -> a
forall m. Monoid m => LogField m -> m
forall a. LogField a -> Bool
forall a. LogField a -> Int
forall a. LogField a -> [a]
forall a. (a -> a -> a) -> LogField a -> a
forall m a. Monoid m => (a -> m) -> LogField a -> m
forall b a. (b -> a -> b) -> b -> LogField a -> b
forall a b. (a -> b -> b) -> b -> LogField a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: LogField a -> a
$cproduct :: forall a. Num a => LogField a -> a
sum :: LogField a -> a
$csum :: forall a. Num a => LogField a -> a
minimum :: LogField a -> a
$cminimum :: forall a. Ord a => LogField a -> a
maximum :: LogField a -> a
$cmaximum :: forall a. Ord a => LogField a -> a
elem :: a -> LogField a -> Bool
$celem :: forall a. Eq a => a -> LogField a -> Bool
length :: LogField a -> Int
$clength :: forall a. LogField a -> Int
null :: LogField a -> Bool
$cnull :: forall a. LogField a -> Bool
toList :: LogField a -> [a]
$ctoList :: forall a. LogField a -> [a]
foldl1 :: (a -> a -> a) -> LogField a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> LogField a -> a
foldr1 :: (a -> a -> a) -> LogField a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> LogField a -> a
foldl' :: (b -> a -> b) -> b -> LogField a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> LogField a -> b
foldl :: (b -> a -> b) -> b -> LogField a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> LogField a -> b
foldr' :: (a -> b -> b) -> b -> LogField a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> LogField a -> b
foldr :: (a -> b -> b) -> b -> LogField a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> LogField a -> b
foldMap' :: (a -> m) -> LogField a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> LogField a -> m
foldMap :: (a -> m) -> LogField a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> LogField a -> m
fold :: LogField m -> m
$cfold :: forall m. Monoid m => LogField m -> m
Foldable,
      Functor LogField
Foldable LogField
Functor LogField
-> Foldable LogField
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LogField a -> f (LogField b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LogField (f a) -> f (LogField a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LogField a -> m (LogField b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LogField (m a) -> m (LogField a))
-> Traversable LogField
(a -> f b) -> LogField a -> f (LogField b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => LogField (m a) -> m (LogField a)
forall (f :: * -> *) a.
Applicative f =>
LogField (f a) -> f (LogField a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogField a -> m (LogField b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LogField a -> f (LogField b)
sequence :: LogField (m a) -> m (LogField a)
$csequence :: forall (m :: * -> *) a. Monad m => LogField (m a) -> m (LogField a)
mapM :: (a -> m b) -> LogField a -> m (LogField b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogField a -> m (LogField b)
sequenceA :: LogField (f a) -> f (LogField a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
LogField (f a) -> f (LogField a)
traverse :: (a -> f b) -> LogField a -> f (LogField b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LogField a -> f (LogField b)
$cp2Traversable :: Foldable LogField
$cp1Traversable :: Functor LogField
Traversable
    )

----------------------------------------------------------------
-- To show it, we want to show the normal-domain value rather than
-- the log-domain value. Also, if someone managed to break our
-- invariants (e.g. by passing in a negative and noone's pulled on
-- the thunk yet) then we want to crash before printing the
-- constructor, rather than after.  N.B. This means the show will
-- underflow\/overflow in the same places as normal doubles since
-- we underflow at the @exp@. Perhaps this means we should show the
-- log-domain value instead.
instance (ExpField a, Show a) => Show (LogField a) where
  showsPrec :: Int -> LogField a -> ShowS
showsPrec Int
p (LogField a
x) =
    let y :: a
y = a -> a
forall a. ExpField a => a -> a
exp a
x
     in a
y a -> ShowS -> ShowS
`seq` Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (String -> ShowS
showString String
"LogField " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
y)

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

-- | Constructor which does semantic conversion from normal-domain
-- to log-domain. Throws errors on negative and NaN inputs. If @p@
-- is non-negative, then following equivalence holds:
--
-- > logField p == logToLogField (log p)
logField :: (ExpField a) => a -> LogField a
{-# INLINE [0] logField #-}
logField :: a -> LogField a
logField = a -> LogField a
forall a. a -> LogField a
LogField (a -> LogField a) -> (a -> a) -> a -> LogField a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. ExpField a => a -> a
log

-- | Constructor which assumes the argument is already in the
-- log-domain.
logToLogField :: a -> LogField a
logToLogField :: a -> LogField a
logToLogField = a -> LogField a
forall a. a -> LogField a
LogField

-- | Semantically convert our log-domain value back into the
-- normal-domain. Beware of overflow\/underflow. The following
-- equivalence holds (without qualification):
--
-- > fromLogField == exp . logFromLogField
fromLogField :: ExpField a => LogField a -> a
{-# INLINE [0] fromLogField #-}
fromLogField :: LogField a -> a
fromLogField (LogField a
x) = a -> a
forall a. ExpField a => a -> a
exp a
x

-- | Return the log-domain value itself without conversion.
logFromLogField :: LogField a -> a
logFromLogField :: LogField a -> a
logFromLogField (LogField a
x) = a
x

-- These are our module-specific versions of "log\/exp" and "exp\/log";
-- They do the same things but also have a @LogField@ in between
-- the logarithm and exponentiation. In order to ensure these rules
-- fire, we have to delay the inlining on two of the four
-- con-\/destructors.
{-# RULES
"log/fromLogField" forall x.
  log (fromLogField x) =
    logFromLogField x
"fromLogField/LogField" forall x. fromLogField (LogField x) = x
  #-}

log1p :: ExpField a => a -> a
{-# INLINE [0] log1p #-}
log1p :: a -> a
log1p a
x = a -> a
forall a. ExpField a => a -> a
log (a
forall a. Multiplicative a => a
one a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x)

expm1 :: (ExpField a) => a -> a
{-# INLINE [0] expm1 #-}
expm1 :: a -> a
expm1 a
x = a -> a
forall a. ExpField a => a -> a
exp a
x a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
forall a. Multiplicative a => a
one

{-# RULES
"expm1/log1p" forall x. expm1 (log1p x) = x
"log1p/expm1" forall x. log1p (expm1 x) = x
  #-}

instance
  (ExpField a, LowerBoundedField a, Ord a) =>
  Additive (LogField a)
  where
  x :: LogField a
x@(LogField a
x') + :: LogField a -> LogField a -> LogField a
+ y :: LogField a
y@(LogField a
y')
    | LogField a
x LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. Additive a => a
zero Bool -> Bool -> Bool
&& LogField a
y LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. Additive a => a
zero = LogField a
forall a. Additive a => a
zero
    | LogField a
x LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. Additive a => a
zero = LogField a
y
    | LogField a
y LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. Additive a => a
zero = LogField a
x
    | LogField a
x LogField a -> LogField a -> Bool
forall a. Ord a => a -> a -> Bool
>= LogField a
y = a -> LogField a
forall a. a -> LogField a
LogField (a
x' a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. ExpField a => a -> a
log1p (a -> a
forall a. ExpField a => a -> a
exp (a
y' a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x')))
    | Bool
otherwise = a -> LogField a
forall a. a -> LogField a
LogField (a
y' a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. ExpField a => a -> a
log1p (a -> a
forall a. ExpField a => a -> a
exp (a
x' a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
y')))

  zero :: LogField a
zero = a -> LogField a
forall a. a -> LogField a
LogField a
forall a. LowerBoundedField a => a
negInfinity

instance
  (ExpField a, Ord a, LowerBoundedField a, UpperBoundedField a) =>
  Subtractive (LogField a)
  where
  negate :: LogField a -> LogField a
negate LogField a
x
    | LogField a
x LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. Additive a => a
zero = LogField a
forall a. Additive a => a
zero
    | Bool
otherwise = LogField a
forall a. UpperBoundedField a => a
nan

instance
  (LowerBoundedField a, Eq a) =>
  Multiplicative (LogField a)
  where
  (LogField a
x) * :: LogField a -> LogField a -> LogField a
* (LogField a
y)
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. LowerBoundedField a => a
negInfinity Bool -> Bool -> Bool
|| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. LowerBoundedField a => a
negInfinity = a -> LogField a
forall a. a -> LogField a
LogField a
forall a. LowerBoundedField a => a
negInfinity
    | Bool
otherwise = a -> LogField a
forall a. a -> LogField a
LogField (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y)

  one :: LogField a
one = a -> LogField a
forall a. a -> LogField a
LogField a
forall a. Additive a => a
zero

instance
  (LowerBoundedField a, Eq a) =>
  Divisive (LogField a)
  where
  recip :: LogField a -> LogField a
recip (LogField a
x) = a -> LogField a
forall a. a -> LogField a
LogField (a -> LogField a) -> a -> LogField a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Subtractive a => a -> a
negate a
x

instance
  (Ord a, LowerBoundedField a, ExpField a) =>
  Distributive (LogField a)

instance (Field (LogField a), ExpField a, LowerBoundedField a, Ord a) => ExpField (LogField a) where
  exp :: LogField a -> LogField a
exp (LogField a
x) = a -> LogField a
forall a. a -> LogField a
LogField (a -> LogField a) -> a -> LogField a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. ExpField a => a -> a
exp a
x
  log :: LogField a -> LogField a
log (LogField a
x) = a -> LogField a
forall a. a -> LogField a
LogField (a -> LogField a) -> a -> LogField a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. ExpField a => a -> a
log a
x
  ** :: LogField a -> LogField a -> LogField a
(**) LogField a
x (LogField a
y) = LogField a -> a -> LogField a
forall a.
(ExpField a, LowerBoundedField a, Ord a) =>
LogField a -> a -> LogField a
pow LogField a
x (a -> LogField a) -> a -> LogField a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. ExpField a => a -> a
exp a
y

instance (FromIntegral a b, ExpField a) => FromIntegral (LogField a) b where
  fromIntegral :: b -> LogField a
fromIntegral = a -> LogField a
forall a. ExpField a => a -> LogField a
logField (a -> LogField a) -> (b -> a) -> b -> LogField a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
forall a b. FromIntegral a b => b -> a
fromIntegral

instance (ToIntegral a b, ExpField a) => ToIntegral (LogField a) b where
  toIntegral :: LogField a -> b
toIntegral = a -> b
forall a b. ToIntegral a b => a -> b
toIntegral (a -> b) -> (LogField a -> a) -> LogField a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogField a -> a
forall a. ExpField a => LogField a -> a
fromLogField

instance (FromRatio a b, ExpField a) => FromRatio (LogField a) b where
  fromRatio :: Ratio b -> LogField a
fromRatio = a -> LogField a
forall a. ExpField a => a -> LogField a
logField (a -> LogField a) -> (Ratio b -> a) -> Ratio b -> LogField a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio b -> a
forall a b. FromRatio a b => Ratio b -> a
fromRatio

instance (ToRatio a b, ExpField a) => ToRatio (LogField a) b where
  toRatio :: LogField a -> Ratio b
toRatio = a -> Ratio b
forall a b. ToRatio a b => a -> Ratio b
toRatio (a -> Ratio b) -> (LogField a -> a) -> LogField a -> Ratio b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogField a -> a
forall a. ExpField a => LogField a -> a
fromLogField

instance (Ord a) => JoinSemiLattice (LogField a) where
  \/ :: LogField a -> LogField a -> LogField a
(\/) = LogField a -> LogField a -> LogField a
forall a. Ord a => a -> a -> a
min

instance (Ord a) => MeetSemiLattice (LogField a) where
  /\ :: LogField a -> LogField a -> LogField a
(/\) = LogField a -> LogField a -> LogField a
forall a. Ord a => a -> a -> a
max

instance
  (Epsilon a, ExpField a, LowerBoundedField a, UpperBoundedField a, Ord a) =>
  Epsilon (LogField a)
  where
  epsilon :: LogField a
epsilon = a -> LogField a
forall a. ExpField a => a -> LogField a
logField a
forall a. Epsilon a => a
epsilon
  nearZero :: LogField a -> Bool
nearZero (LogField a
x) = a -> Bool
forall a. Epsilon a => a -> Bool
nearZero (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. ExpField a => a -> a
exp a
x
  aboutEqual :: LogField a -> LogField a -> Bool
aboutEqual (LogField a
x) (LogField a
y) = a -> a -> Bool
forall a. Epsilon a => a -> a -> Bool
aboutEqual (a -> a
forall a. ExpField a => a -> a
exp a
x) (a -> a
forall a. ExpField a => a -> a
exp a
y)

instance (Ord a, ExpField a, LowerBoundedField a, UpperBoundedField a) => Field (LogField a)

instance
  (Ord a, ExpField a, LowerBoundedField a, UpperBoundedField a) =>
  LowerBoundedField (LogField a)

instance
  (Ord a, ExpField a, LowerBoundedField a, UpperBoundedField a) =>
  UpperBoundedField (LogField a)

instance
  (Ord a, LowerBoundedField a, UpperBoundedField a, ExpField a) =>
  Signed (LogField a)
  where
  sign :: LogField a -> LogField a
sign LogField a
a
    | LogField a
a LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. LowerBoundedField a => a
negInfinity = LogField a
forall a. Additive a => a
zero
    | Bool
otherwise = LogField a
forall a. Multiplicative a => a
one
  abs :: LogField a -> LogField a
abs = LogField a -> LogField a
forall a. a -> a
id

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

-- | /O(1)/. Compute powers in the log-domain; that is, the following
-- equivalence holds (modulo underflow and all that):
--
-- > LogField (p ** m) == LogField p `pow` m
pow :: (ExpField a, LowerBoundedField a, Ord a) => LogField a -> a -> LogField a
{-# INLINE pow #-}

infixr 8 `pow`

pow :: LogField a -> a -> LogField a
pow x :: LogField a
x@(LogField a
x') a
m
  | LogField a
x LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. Additive a => a
zero Bool -> Bool -> Bool
&& a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Additive a => a
zero = a -> LogField a
forall a. a -> LogField a
LogField a
forall a. Additive a => a
zero
  | LogField a
x LogField a -> LogField a -> Bool
forall a. Eq a => a -> a -> Bool
== LogField a
forall a. Additive a => a
zero = LogField a
x
  | Bool
otherwise = a -> LogField a
forall a. a -> LogField a
LogField (a -> LogField a) -> a -> LogField a
forall a b. (a -> b) -> a -> b
$ a
m a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x'

-- Some good test cases:
-- for @logsumexp == log . accurateSum . map exp@:
--     logsumexp[0,1,0] should be about 1.55
-- for correctness of avoiding underflow:
--     logsumexp[1000,1001,1000]   ~~ 1001.55 ==  1000 + 1.55
--     logsumexp[-1000,-999,-1000] ~~ -998.45 == -1000 + 1.55
--

-- | /O(n)/. Compute the sum of a finite list of 'LogField's, being
-- careful to avoid underflow issues. That is, the following
-- equivalence holds (modulo underflow and all that):
--
-- > LogField . accurateSum == accurateSum . map LogField
--
-- /N.B./, this function requires two passes over the input. Thus,
-- it is not amenable to list fusion, and hence will use a lot of
-- memory when summing long lists.
{-# INLINE accurateSum #-}
accurateSum :: (ExpField a, Foldable f, Ord a) => f (LogField a) -> LogField a
accurateSum :: f (LogField a) -> LogField a
accurateSum f (LogField a)
xs = a -> LogField a
forall a. a -> LogField a
LogField (a
theMax a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. ExpField a => a -> a
log a
theSum)
  where
    LogField a
theMax = f (LogField a) -> LogField a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum f (LogField a)
xs
    -- compute @\log \sum_{x \in xs} \exp(x - theMax)@
    theSum :: a
theSum = (a -> LogField a -> a) -> a -> f (LogField a) -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\a
acc (LogField a
x) -> a
acc a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. ExpField a => a -> a
exp (a
x a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
theMax)) a
forall a. Additive a => a
zero f (LogField a)
xs

-- | /O(n)/. Compute the product of a finite list of 'LogField's,
-- being careful to avoid numerical error due to loss of precision.
-- That is, the following equivalence holds (modulo underflow and
-- all that):
--
-- > LogField . accurateProduct == accurateProduct . map LogField
{-# INLINE accurateProduct #-}
accurateProduct :: (ExpField a, Foldable f) => f (LogField a) -> LogField a
accurateProduct :: f (LogField a) -> LogField a
accurateProduct = a -> LogField a
forall a. a -> LogField a
LogField (a -> LogField a)
-> (f (LogField a) -> a) -> f (LogField a) -> LogField a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (f (LogField a) -> (a, a)) -> f (LogField a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogField a -> (a, a) -> (a, a))
-> (a, a) -> f (LogField a) -> (a, a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr LogField a -> (a, a) -> (a, a)
forall b. Subtractive b => LogField b -> (b, b) -> (b, b)
kahanPlus (a
forall a. Additive a => a
zero, a
forall a. Additive a => a
zero)
  where
    kahanPlus :: LogField b -> (b, b) -> (b, b)
kahanPlus (LogField b
x) (b
t, b
c) =
      let y :: b
y = b
x b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
c
          t' :: b
t' = b
t b -> b -> b
forall a. Additive a => a -> a -> a
+ b
y
          c' :: b
c' = (b
t' b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
t) b -> b -> b
forall a. Subtractive a => a -> a -> a
- b
y
       in (b
t', b
c')