{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Statistics.Distribution.Beta
-- Copyright   :  (C) 2012 Edward Kmett,
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  DeriveDataTypeable
--
----------------------------------------------------------------------------
module Statistics.Distribution.Beta
  ( BetaDistribution
    -- * Constructor
  , betaDistr
  , betaDistrE
  , improperBetaDistr
  , improperBetaDistrE
    -- * Accessors
  , bdAlpha
  , bdBeta
  ) where

import Control.Applicative
import Data.Aeson            (FromJSON(..), ToJSON, Value(..), (.:))
import Data.Binary           (Binary(..))
import Data.Data             (Data, Typeable)
import GHC.Generics          (Generic)
import Numeric.SpecFunctions (
  incompleteBeta, invIncompleteBeta, logBeta, digamma, log1p)
import Numeric.MathFunctions.Constants (m_NaN,m_neg_inf)
import qualified Statistics.Distribution as D
import Statistics.Internal


-- | The beta distribution
data BetaDistribution = BD
 { BetaDistribution -> Double
bdAlpha :: {-# UNPACK #-} !Double
   -- ^ Alpha shape parameter
 , BetaDistribution -> Double
bdBeta  :: {-# UNPACK #-} !Double
   -- ^ Beta shape parameter
 } deriving (BetaDistribution -> BetaDistribution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BetaDistribution -> BetaDistribution -> Bool
$c/= :: BetaDistribution -> BetaDistribution -> Bool
== :: BetaDistribution -> BetaDistribution -> Bool
$c== :: BetaDistribution -> BetaDistribution -> Bool
Eq, Typeable, Typeable BetaDistribution
BetaDistribution -> DataType
BetaDistribution -> Constr
(forall b. Data b => b -> b)
-> BetaDistribution -> BetaDistribution
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) -> BetaDistribution -> u
forall u. (forall d. Data d => d -> u) -> BetaDistribution -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BetaDistribution -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BetaDistribution -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BetaDistribution
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetaDistribution -> c BetaDistribution
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BetaDistribution)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BetaDistribution)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BetaDistribution -> m BetaDistribution
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BetaDistribution -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BetaDistribution -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BetaDistribution -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BetaDistribution -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BetaDistribution -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BetaDistribution -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BetaDistribution -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BetaDistribution -> r
gmapT :: (forall b. Data b => b -> b)
-> BetaDistribution -> BetaDistribution
$cgmapT :: (forall b. Data b => b -> b)
-> BetaDistribution -> BetaDistribution
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BetaDistribution)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BetaDistribution)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BetaDistribution)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BetaDistribution)
dataTypeOf :: BetaDistribution -> DataType
$cdataTypeOf :: BetaDistribution -> DataType
toConstr :: BetaDistribution -> Constr
$ctoConstr :: BetaDistribution -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BetaDistribution
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BetaDistribution
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetaDistribution -> c BetaDistribution
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BetaDistribution -> c BetaDistribution
Data, forall x. Rep BetaDistribution x -> BetaDistribution
forall x. BetaDistribution -> Rep BetaDistribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BetaDistribution x -> BetaDistribution
$cfrom :: forall x. BetaDistribution -> Rep BetaDistribution x
Generic)

instance Show BetaDistribution where
  showsPrec :: Int -> BetaDistribution -> ShowS
showsPrec Int
n (BD Double
a Double
b) = forall a b. (Show a, Show b) => [Char] -> a -> b -> Int -> ShowS
defaultShow2 [Char]
"improperBetaDistr" Double
a Double
b Int
n
instance Read BetaDistribution where
  readPrec :: ReadPrec BetaDistribution
readPrec = forall a b r.
(Read a, Read b) =>
[Char] -> (a -> b -> Maybe r) -> ReadPrec r
defaultReadPrecM2 [Char]
"improperBetaDistr" Double -> Double -> Maybe BetaDistribution
improperBetaDistrE

instance ToJSON BetaDistribution
instance FromJSON BetaDistribution where
  parseJSON :: Value -> Parser BetaDistribution
parseJSON (Object Object
v) = do
    Double
a <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bdAlpha"
    Double
b <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bdBeta"
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ Double -> Double -> [Char]
errMsgI Double
a Double
b) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Double -> Maybe BetaDistribution
improperBetaDistrE Double
a Double
b
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance Binary BetaDistribution where
  put :: BetaDistribution -> Put
put (BD Double
a Double
b) = forall t. Binary t => t -> Put
put Double
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Double
b
  get :: Get BetaDistribution
get = do
    Double
a <- forall t. Binary t => Get t
get
    Double
b <- forall t. Binary t => Get t
get
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ Double -> Double -> [Char]
errMsgI Double
a Double
b) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Double -> Maybe BetaDistribution
improperBetaDistrE Double
a Double
b


-- | Create beta distribution. Both shape parameters must be positive.
betaDistr :: Double             -- ^ Shape parameter alpha
          -> Double             -- ^ Shape parameter beta
          -> BetaDistribution
betaDistr :: Double -> Double -> BetaDistribution
betaDistr Double
a Double
b = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Double -> Double -> [Char]
errMsg Double
a Double
b) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Double -> Double -> Maybe BetaDistribution
betaDistrE Double
a Double
b

-- | Create beta distribution. Both shape parameters must be positive.
betaDistrE :: Double             -- ^ Shape parameter alpha
          -> Double             -- ^ Shape parameter beta
          -> Maybe BetaDistribution
betaDistrE :: Double -> Double -> Maybe BetaDistribution
betaDistrE Double
a Double
b
  | Double
a forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
b forall a. Ord a => a -> a -> Bool
> Double
0 = forall a. a -> Maybe a
Just (Double -> Double -> BetaDistribution
BD Double
a Double
b)
  | Bool
otherwise      = forall a. Maybe a
Nothing

errMsg :: Double -> Double -> String
errMsg :: Double -> Double -> [Char]
errMsg Double
a Double
b = [Char]
"Statistics.Distribution.Beta.betaDistr: "
          forall a. [a] -> [a] -> [a]
++ [Char]
"shape parameters must be positive. Got a = "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
a
          forall a. [a] -> [a] -> [a]
++ [Char]
" b = "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
b


-- | Create beta distribution. Both shape parameters must be
-- non-negative. So it allows to construct improper beta distribution
-- which could be used as improper prior.
improperBetaDistr :: Double             -- ^ Shape parameter alpha
                  -> Double             -- ^ Shape parameter beta
                  -> BetaDistribution
improperBetaDistr :: Double -> Double -> BetaDistribution
improperBetaDistr Double
a Double
b
  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Double -> Double -> [Char]
errMsgI Double
a Double
b) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Double -> Double -> Maybe BetaDistribution
improperBetaDistrE Double
a Double
b

-- | Create beta distribution. Both shape parameters must be
-- non-negative. So it allows to construct improper beta distribution
-- which could be used as improper prior.
improperBetaDistrE :: Double             -- ^ Shape parameter alpha
                   -> Double             -- ^ Shape parameter beta
                   -> Maybe BetaDistribution
improperBetaDistrE :: Double -> Double -> Maybe BetaDistribution
improperBetaDistrE Double
a Double
b
  | Double
a forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
b forall a. Ord a => a -> a -> Bool
>= Double
0 = forall a. a -> Maybe a
Just (Double -> Double -> BetaDistribution
BD Double
a Double
b)
  | Bool
otherwise        = forall a. Maybe a
Nothing

errMsgI :: Double -> Double -> String
errMsgI :: Double -> Double -> [Char]
errMsgI Double
a Double
b
  =  [Char]
"Statistics.Distribution.Beta.betaDistr: "
  forall a. [a] -> [a] -> [a]
++ [Char]
"shape parameters must be non-negative. Got a = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
a
  forall a. [a] -> [a] -> [a]
++ [Char]
" b = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
b



instance D.Distribution BetaDistribution where
  cumulative :: BetaDistribution -> Double -> Double
cumulative (BD Double
a Double
b) Double
x
    | Double
x forall a. Ord a => a -> a -> Bool
<= Double
0    = Double
0
    | Double
x forall a. Ord a => a -> a -> Bool
>= Double
1    = Double
1
    | Bool
otherwise = Double -> Double -> Double -> Double
incompleteBeta Double
a Double
b Double
x
  complCumulative :: BetaDistribution -> Double -> Double
complCumulative (BD Double
a Double
b) Double
x
    | Double
x forall a. Ord a => a -> a -> Bool
<= Double
0    = Double
1
    | Double
x forall a. Ord a => a -> a -> Bool
>= Double
1    = Double
0
    -- For small x we use direct computation to avoid precision loss
    -- when computing (1-x)
    | Double
x forall a. Ord a => a -> a -> Bool
<  Double
0.5  = Double
1 forall a. Num a => a -> a -> a
- Double -> Double -> Double -> Double
incompleteBeta Double
a Double
b Double
x
    -- Otherwise we use property of incomplete beta:
    --  > I(x,a,b) = 1 - I(1-x,b,a)
    | Bool
otherwise = Double -> Double -> Double -> Double
incompleteBeta Double
b Double
a (Double
1forall a. Num a => a -> a -> a
-Double
x)

instance D.Mean BetaDistribution where
  mean :: BetaDistribution -> Double
mean (BD Double
a Double
b) = Double
a forall a. Fractional a => a -> a -> a
/ (Double
a forall a. Num a => a -> a -> a
+ Double
b)

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

instance D.Variance BetaDistribution where
  variance :: BetaDistribution -> Double
variance (BD Double
a Double
b) = Double
aforall a. Num a => a -> a -> a
*Double
b forall a. Fractional a => a -> a -> a
/ (Double
apbforall a. Num a => a -> a -> a
*Double
apbforall a. Num a => a -> a -> a
*(Double
apbforall a. Num a => a -> a -> a
+Double
1))
    where apb :: Double
apb = Double
a forall a. Num a => a -> a -> a
+ Double
b

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

instance D.Entropy BetaDistribution where
  entropy :: BetaDistribution -> Double
entropy (BD Double
a Double
b) =
    Double -> Double -> Double
logBeta Double
a Double
b
    forall a. Num a => a -> a -> a
- (Double
aforall a. Num a => a -> a -> a
-Double
1) forall a. Num a => a -> a -> a
* Double -> Double
digamma Double
a
    forall a. Num a => a -> a -> a
- (Double
bforall a. Num a => a -> a -> a
-Double
1) forall a. Num a => a -> a -> a
* Double -> Double
digamma Double
b
    forall a. Num a => a -> a -> a
+ (Double
aforall a. Num a => a -> a -> a
+Double
bforall a. Num a => a -> a -> a
-Double
2) forall a. Num a => a -> a -> a
* Double -> Double
digamma (Double
aforall a. Num a => a -> a -> a
+Double
b)

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

instance D.ContDistr BetaDistribution where
  density :: BetaDistribution -> Double -> Double
density (BD Double
a Double
b) Double
x
    | Double
a forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| Double
b forall a. Ord a => a -> a -> Bool
<= Double
0 = Double
m_NaN
    | Double
x forall a. Ord a => a -> a -> Bool
<= Double
0 = Double
0
    | Double
x forall a. Ord a => a -> a -> Bool
>= Double
1 = Double
0
    | Bool
otherwise = forall a. Floating a => a -> a
exp forall a b. (a -> b) -> a -> b
$ (Double
aforall a. Num a => a -> a -> a
-Double
1)forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
log Double
x forall a. Num a => a -> a -> a
+ (Double
bforall a. Num a => a -> a -> a
-Double
1) forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log1p (-Double
x) forall a. Num a => a -> a -> a
- Double -> Double -> Double
logBeta Double
a Double
b
  logDensity :: BetaDistribution -> Double -> Double
logDensity (BD Double
a Double
b) Double
x
    | Double
a forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| Double
b forall a. Ord a => a -> a -> Bool
<= Double
0 = Double
m_NaN
    | Double
x forall a. Ord a => a -> a -> Bool
<= Double
0 = Double
m_neg_inf
    | Double
x forall a. Ord a => a -> a -> Bool
>= Double
1 = Double
m_neg_inf
    | Bool
otherwise = (Double
aforall a. Num a => a -> a -> a
-Double
1)forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
log Double
x forall a. Num a => a -> a -> a
+ (Double
bforall a. Num a => a -> a -> a
-Double
1)forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
log1p (-Double
x) forall a. Num a => a -> a -> a
- Double -> Double -> Double
logBeta Double
a Double
b

  quantile :: BetaDistribution -> Double -> Double
quantile (BD Double
a Double
b) Double
p
    | Double
p forall a. Eq a => a -> a -> Bool
== Double
0         = Double
0
    | Double
p forall a. Eq a => a -> a -> Bool
== Double
1         = Double
1
    | Double
p forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
p forall a. Ord a => a -> a -> Bool
< Double
1 = Double -> Double -> Double -> Double
invIncompleteBeta Double
a Double
b Double
p
    | Bool
otherwise      =
        forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Double
p

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