{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
-- |
-- Module    : Statistics.Distribution.Lognormal
-- Copyright : (c) 2020 Ximin Luo
-- License   : BSD3
--
-- Maintainer  : infinity0@pwned.gg
-- Stability   : experimental
-- Portability : portable
--
-- The log normal distribution.  This is a continuous probability
-- distribution that describes data whose log is clustered around a
-- mean. For example, the multiplicative product of many independent
-- positive random variables.

module Statistics.Distribution.Lognormal
    (
      LognormalDistribution
      -- * Constructors
    , lognormalDistr
    , lognormalDistrErr
    , lognormalDistrMeanStddevErr
    , lognormalStandard
    ) where

import Data.Aeson            (FromJSON, ToJSON)
import Data.Binary           (Binary (..))
import Data.Data             (Data, Typeable)
import GHC.Generics          (Generic)
import Numeric.MathFunctions.Constants (m_huge, m_sqrt_2_pi)
import Numeric.SpecFunctions (expm1, log1p)
import qualified Data.Vector.Generic as G

import qualified Statistics.Distribution as D
import qualified Statistics.Distribution.Normal as N
import Statistics.Internal


-- | The lognormal distribution.
newtype LognormalDistribution = LND N.NormalDistribution
    deriving (LognormalDistribution -> LognormalDistribution -> Bool
(LognormalDistribution -> LognormalDistribution -> Bool)
-> (LognormalDistribution -> LognormalDistribution -> Bool)
-> Eq LognormalDistribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LognormalDistribution -> LognormalDistribution -> Bool
$c/= :: LognormalDistribution -> LognormalDistribution -> Bool
== :: LognormalDistribution -> LognormalDistribution -> Bool
$c== :: LognormalDistribution -> LognormalDistribution -> Bool
Eq, Typeable, Typeable LognormalDistribution
DataType
Constr
Typeable LognormalDistribution
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> LognormalDistribution
    -> c LognormalDistribution)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LognormalDistribution)
-> (LognormalDistribution -> Constr)
-> (LognormalDistribution -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LognormalDistribution))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LognormalDistribution))
-> ((forall b. Data b => b -> b)
    -> LognormalDistribution -> LognormalDistribution)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> LognormalDistribution
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> LognormalDistribution
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LognormalDistribution -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LognormalDistribution -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LognormalDistribution -> m LognormalDistribution)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LognormalDistribution -> m LognormalDistribution)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LognormalDistribution -> m LognormalDistribution)
-> Data LognormalDistribution
LognormalDistribution -> DataType
LognormalDistribution -> Constr
(forall b. Data b => b -> b)
-> LognormalDistribution -> LognormalDistribution
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LognormalDistribution
-> c LognormalDistribution
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LognormalDistribution
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) -> LognormalDistribution -> u
forall u.
(forall d. Data d => d -> u) -> LognormalDistribution -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LognormalDistribution -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LognormalDistribution -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LognormalDistribution
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LognormalDistribution
-> c LognormalDistribution
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LognormalDistribution)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LognormalDistribution)
$cLND :: Constr
$tLognormalDistribution :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
gmapMp :: (forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
gmapM :: (forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LognormalDistribution -> m LognormalDistribution
gmapQi :: Int -> (forall d. Data d => d -> u) -> LognormalDistribution -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LognormalDistribution -> u
gmapQ :: (forall d. Data d => d -> u) -> LognormalDistribution -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> LognormalDistribution -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LognormalDistribution -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LognormalDistribution -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LognormalDistribution -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LognormalDistribution -> r
gmapT :: (forall b. Data b => b -> b)
-> LognormalDistribution -> LognormalDistribution
$cgmapT :: (forall b. Data b => b -> b)
-> LognormalDistribution -> LognormalDistribution
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LognormalDistribution)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LognormalDistribution)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LognormalDistribution)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LognormalDistribution)
dataTypeOf :: LognormalDistribution -> DataType
$cdataTypeOf :: LognormalDistribution -> DataType
toConstr :: LognormalDistribution -> Constr
$ctoConstr :: LognormalDistribution -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LognormalDistribution
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LognormalDistribution
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LognormalDistribution
-> c LognormalDistribution
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LognormalDistribution
-> c LognormalDistribution
$cp1Data :: Typeable LognormalDistribution
Data, (forall x. LognormalDistribution -> Rep LognormalDistribution x)
-> (forall x. Rep LognormalDistribution x -> LognormalDistribution)
-> Generic LognormalDistribution
forall x. Rep LognormalDistribution x -> LognormalDistribution
forall x. LognormalDistribution -> Rep LognormalDistribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LognormalDistribution x -> LognormalDistribution
$cfrom :: forall x. LognormalDistribution -> Rep LognormalDistribution x
Generic)

instance Show LognormalDistribution where
  showsPrec :: Int -> LognormalDistribution -> ShowS
showsPrec Int
i (LND NormalDistribution
d) = String -> Double -> Double -> Int -> ShowS
forall a b. (Show a, Show b) => String -> a -> b -> Int -> ShowS
defaultShow2 String
"lognormalDistr" Double
m Double
s Int
i
   where
    m :: Double
m = NormalDistribution -> Double
forall d. Mean d => d -> Double
D.mean NormalDistribution
d
    s :: Double
s = NormalDistribution -> Double
forall d. Variance d => d -> Double
D.stdDev NormalDistribution
d
instance Read LognormalDistribution where
  readPrec :: ReadPrec LognormalDistribution
readPrec = String
-> (Double -> Double -> Maybe LognormalDistribution)
-> ReadPrec LognormalDistribution
forall a b r.
(Read a, Read b) =>
String -> (a -> b -> Maybe r) -> ReadPrec r
defaultReadPrecM2 String
"lognormalDistr" ((Double -> Double -> Maybe LognormalDistribution)
 -> ReadPrec LognormalDistribution)
-> (Double -> Double -> Maybe LognormalDistribution)
-> ReadPrec LognormalDistribution
forall a b. (a -> b) -> a -> b
$
    ((String -> Maybe LognormalDistribution)
-> (LognormalDistribution -> Maybe LognormalDistribution)
-> Either String LognormalDistribution
-> Maybe LognormalDistribution
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe LognormalDistribution
-> String -> Maybe LognormalDistribution
forall a b. a -> b -> a
const Maybe LognormalDistribution
forall a. Maybe a
Nothing) LognormalDistribution -> Maybe LognormalDistribution
forall a. a -> Maybe a
Just (Either String LognormalDistribution
 -> Maybe LognormalDistribution)
-> (Double -> Either String LognormalDistribution)
-> Double
-> Maybe LognormalDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Double -> Either String LognormalDistribution)
 -> Double -> Maybe LognormalDistribution)
-> (Double -> Double -> Either String LognormalDistribution)
-> Double
-> Double
-> Maybe LognormalDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Either String LognormalDistribution
lognormalDistrErr

instance ToJSON LognormalDistribution
instance FromJSON LognormalDistribution

instance Binary LognormalDistribution where
  put :: LognormalDistribution -> Put
put (LND NormalDistribution
d) = Double -> Put
forall t. Binary t => t -> Put
put Double
m Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
s
   where
    m :: Double
m = NormalDistribution -> Double
forall d. Mean d => d -> Double
D.mean NormalDistribution
d
    s :: Double
s = NormalDistribution -> Double
forall d. Variance d => d -> Double
D.stdDev NormalDistribution
d
  get :: Get LognormalDistribution
get = do
    Double
m  <- Get Double
forall t. Binary t => Get t
get
    Double
sd <- Get Double
forall t. Binary t => Get t
get
    (String -> Get LognormalDistribution)
-> (LognormalDistribution -> Get LognormalDistribution)
-> Either String LognormalDistribution
-> Get LognormalDistribution
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get LognormalDistribution
forall (m :: * -> *) a. MonadFail m => String -> m a
fail LognormalDistribution -> Get LognormalDistribution
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String LognormalDistribution -> Get LognormalDistribution)
-> Either String LognormalDistribution -> Get LognormalDistribution
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Either String LognormalDistribution
lognormalDistrErr Double
m Double
sd

instance D.Distribution LognormalDistribution where
  cumulative :: LognormalDistribution -> Double -> Double
cumulative      = LognormalDistribution -> Double -> Double
cumulative
  complCumulative :: LognormalDistribution -> Double -> Double
complCumulative = LognormalDistribution -> Double -> Double
complCumulative

instance D.ContDistr LognormalDistribution where
  logDensity :: LognormalDistribution -> Double -> Double
logDensity    = LognormalDistribution -> Double -> Double
logDensity
  quantile :: LognormalDistribution -> Double -> Double
quantile      = LognormalDistribution -> Double -> Double
quantile
  complQuantile :: LognormalDistribution -> Double -> Double
complQuantile = LognormalDistribution -> Double -> Double
complQuantile

instance D.MaybeMean LognormalDistribution where
  maybeMean :: LognormalDistribution -> Maybe Double
maybeMean = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> (LognormalDistribution -> Double)
-> LognormalDistribution
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LognormalDistribution -> Double
forall d. Mean d => d -> Double
D.mean

instance D.Mean LognormalDistribution where
  mean :: LognormalDistribution -> Double
mean (LND NormalDistribution
d) = Double -> Double
forall a. Floating a => a -> a
exp (Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
   where
    m :: Double
m = NormalDistribution -> Double
forall d. Mean d => d -> Double
D.mean NormalDistribution
d
    v :: Double
v = NormalDistribution -> Double
forall d. Variance d => d -> Double
D.variance NormalDistribution
d

instance D.MaybeVariance LognormalDistribution where
  maybeStdDev :: LognormalDistribution -> Maybe Double
maybeStdDev   = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> (LognormalDistribution -> Double)
-> LognormalDistribution
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LognormalDistribution -> Double
forall d. Variance d => d -> Double
D.stdDev
  maybeVariance :: LognormalDistribution -> Maybe Double
maybeVariance = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> (LognormalDistribution -> Double)
-> LognormalDistribution
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LognormalDistribution -> Double
forall d. Variance d => d -> Double
D.variance

instance D.Variance LognormalDistribution where
  variance :: LognormalDistribution -> Double
variance (LND NormalDistribution
d) = Double -> Double
forall a. Floating a => a -> a
expm1 Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v)
   where
    m :: Double
m = NormalDistribution -> Double
forall d. Mean d => d -> Double
D.mean NormalDistribution
d
    v :: Double
v = NormalDistribution -> Double
forall d. Variance d => d -> Double
D.variance NormalDistribution
d

instance D.Entropy LognormalDistribution where
  entropy :: LognormalDistribution -> Double
entropy (LND NormalDistribution
d) = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m_sqrt_2_pi)
   where
    m :: Double
m = NormalDistribution -> Double
forall d. Mean d => d -> Double
D.mean NormalDistribution
d
    s :: Double
s = NormalDistribution -> Double
forall d. Variance d => d -> Double
D.stdDev NormalDistribution
d

instance D.MaybeEntropy LognormalDistribution where
  maybeEntropy :: LognormalDistribution -> Maybe Double
maybeEntropy = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> (LognormalDistribution -> Double)
-> LognormalDistribution
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LognormalDistribution -> Double
forall d. Entropy d => d -> Double
D.entropy

instance D.ContGen LognormalDistribution where
  genContVar :: LognormalDistribution -> g -> m Double
genContVar LognormalDistribution
d = LognormalDistribution -> g -> m Double
forall d g (m :: * -> *).
(ContDistr d, StatefulGen g m) =>
d -> g -> m Double
D.genContinuous LognormalDistribution
d

-- | Standard log normal distribution with mu 0 and sigma 1.
--
-- Mean is @sqrt e@ and variance is @(e - 1) * e@.
lognormalStandard :: LognormalDistribution
lognormalStandard :: LognormalDistribution
lognormalStandard = NormalDistribution -> LognormalDistribution
LND NormalDistribution
N.standard

-- | Create log normal distribution from parameters.
lognormalDistr
  :: Double            -- ^ Mu
  -> Double            -- ^ Sigma
  -> LognormalDistribution
lognormalDistr :: Double -> Double -> LognormalDistribution
lognormalDistr Double
mu Double
sig = (String -> LognormalDistribution)
-> (LognormalDistribution -> LognormalDistribution)
-> Either String LognormalDistribution
-> LognormalDistribution
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> LognormalDistribution
forall a. HasCallStack => String -> a
error LognormalDistribution -> LognormalDistribution
forall a. a -> a
id (Either String LognormalDistribution -> LognormalDistribution)
-> Either String LognormalDistribution -> LognormalDistribution
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Either String LognormalDistribution
lognormalDistrErr Double
mu Double
sig

-- | Create log normal distribution from parameters.
lognormalDistrErr
  :: Double            -- ^ Mu
  -> Double            -- ^ Sigma
  -> Either String LognormalDistribution
lognormalDistrErr :: Double -> Double -> Either String LognormalDistribution
lognormalDistrErr Double
mu Double
sig
  | Double
sig Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double
forall a. Floating a => a -> a
log Double
m_huge Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
mu) = String -> Either String LognormalDistribution
forall a b. a -> Either a b
Left (String -> Either String LognormalDistribution)
-> String -> Either String LognormalDistribution
forall a b. (a -> b) -> a -> b
$ Double -> Double -> String
errMsg Double
mu Double
sig
  | Bool
otherwise = NormalDistribution -> LognormalDistribution
LND (NormalDistribution -> LognormalDistribution)
-> Either String NormalDistribution
-> Either String LognormalDistribution
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Double -> Either String NormalDistribution
N.normalDistrErr Double
mu Double
sig

errMsg :: Double -> Double -> String
errMsg :: Double -> Double -> String
errMsg Double
mu Double
sig =
  String
"Statistics.Distribution.Lognormal.lognormalDistr: sigma must be > 0 && < "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
lim String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
sig
  where lim :: Double
lim = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double
forall a. Floating a => a -> a
log Double
m_huge Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
mu)

-- | Create log normal distribution from mean and standard deviation.
lognormalDistrMeanStddevErr
  :: Double            -- ^ Mu
  -> Double            -- ^ Sigma
  -> Either String LognormalDistribution
lognormalDistrMeanStddevErr :: Double -> Double -> Either String LognormalDistribution
lognormalDistrMeanStddevErr Double
m Double
sd = NormalDistribution -> LognormalDistribution
LND (NormalDistribution -> LognormalDistribution)
-> Either String NormalDistribution
-> Either String LognormalDistribution
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Double -> Either String NormalDistribution
N.normalDistrErr Double
mu Double
sig
  where r :: Double
r = Double
sd Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
m
        sig2 :: Double
sig2 = Double -> Double
forall a. Floating a => a -> a
log1p (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r)
        sig :: Double
sig = Double -> Double
forall a. Floating a => a -> a
sqrt Double
sig2
        mu :: Double
mu = Double -> Double
forall a. Floating a => a -> a
log Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sig2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2

-- | Variance is estimated using maximum likelihood method
--   (biased estimation) over the log of the data.
--
--   Returns @Nothing@ if sample contains less than one element or
--   variance is zero (all elements are equal)
instance D.FromSample LognormalDistribution Double where
  fromSample :: v Double -> Maybe LognormalDistribution
fromSample = (NormalDistribution -> LognormalDistribution)
-> Maybe NormalDistribution -> Maybe LognormalDistribution
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NormalDistribution -> LognormalDistribution
LND (Maybe NormalDistribution -> Maybe LognormalDistribution)
-> (v Double -> Maybe NormalDistribution)
-> v Double
-> Maybe LognormalDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v Double -> Maybe NormalDistribution
forall d a (v :: * -> *).
(FromSample d a, Vector v a) =>
v a -> Maybe d
D.fromSample (v Double -> Maybe NormalDistribution)
-> (v Double -> v Double) -> v Double -> Maybe NormalDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> v Double -> v Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map Double -> Double
forall a. Floating a => a -> a
log

logDensity :: LognormalDistribution -> Double -> Double
logDensity :: LognormalDistribution -> Double -> Double
logDensity (LND NormalDistribution
d) Double
x
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = let lx :: Double
lx = Double -> Double
forall a. Floating a => a -> a
log Double
x in NormalDistribution -> Double -> Double
forall d. ContDistr d => d -> Double -> Double
D.logDensity NormalDistribution
d Double
lx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lx
  | Bool
otherwise = Double
0

cumulative :: LognormalDistribution -> Double -> Double
cumulative :: LognormalDistribution -> Double -> Double
cumulative (LND NormalDistribution
d) Double
x
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = NormalDistribution -> Double -> Double
forall d. Distribution d => d -> Double -> Double
D.cumulative NormalDistribution
d (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
log Double
x
  | Bool
otherwise = Double
0

complCumulative :: LognormalDistribution -> Double -> Double
complCumulative :: LognormalDistribution -> Double -> Double
complCumulative (LND NormalDistribution
d) Double
x
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = NormalDistribution -> Double -> Double
forall d. Distribution d => d -> Double -> Double
D.complCumulative NormalDistribution
d (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
log Double
x
  | Bool
otherwise = Double
1

quantile :: LognormalDistribution -> Double -> Double
quantile :: LognormalDistribution -> Double -> Double
quantile (LND NormalDistribution
d) = Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalDistribution -> Double -> Double
forall d. ContDistr d => d -> Double -> Double
D.quantile NormalDistribution
d

complQuantile :: LognormalDistribution -> Double -> Double
complQuantile :: LognormalDistribution -> Double -> Double
complQuantile (LND NormalDistribution
d) = Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalDistribution -> Double -> Double
forall d. ContDistr d => d -> Double -> Double
D.complQuantile NormalDistribution
d