{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
-- |
-- Module    : Statistics.Distribution.Geometric
-- Copyright : (c) 2009 Bryan O'Sullivan
-- License   : BSD3
--
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : portable
--
-- The Geometric distribution. There are two variants of
-- distribution. First is the probability distribution of the number
-- of Bernoulli trials needed to get one success, supported on the set
-- [1,2..] ('GeometricDistribution'). Sometimes it's referred to as
-- the /shifted/ geometric distribution to distinguish from another
-- one.
--
-- Second variant is probability distribution of the number of
-- failures before first success, defined over the set [0,1..]
-- ('GeometricDistribution0').
module Statistics.Distribution.Geometric
    (
      GeometricDistribution
    , GeometricDistribution0
    -- * Constructors
    , geometric
    , geometricE
    , geometric0
    , geometric0E
    -- ** Accessors
    , gdSuccess
    , gdSuccess0
    ) where

import Control.Applicative
import Control.Monad       (liftM)
import Data.Aeson          (FromJSON(..), ToJSON, Value(..), (.:))
import Data.Binary         (Binary(..))
import Data.Data           (Data, Typeable)
import GHC.Generics        (Generic)
import Numeric.MathFunctions.Constants (m_neg_inf)
import Numeric.SpecFunctions           (log1p,expm1)
import qualified System.Random.MWC.Distributions as MWC

import qualified Statistics.Distribution as D
import Statistics.Internal



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

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

instance Show GeometricDistribution where
  showsPrec :: Int -> GeometricDistribution -> ShowS
showsPrec Int
i (GD Double
x) = forall a. Show a => [Char] -> a -> Int -> ShowS
defaultShow1 [Char]
"geometric" Double
x Int
i
instance Read GeometricDistribution where
  readPrec :: ReadPrec GeometricDistribution
readPrec = forall a r. Read a => [Char] -> (a -> Maybe r) -> ReadPrec r
defaultReadPrecM1 [Char]
"geometric" Double -> Maybe GeometricDistribution
geometricE

instance ToJSON GeometricDistribution
instance FromJSON GeometricDistribution where
  parseJSON :: Value -> Parser GeometricDistribution
parseJSON (Object Object
v) = do
    Double
x <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gdSuccess"
    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 -> [Char]
errMsg Double
x) forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ Double -> Maybe GeometricDistribution
geometricE Double
x
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance Binary GeometricDistribution where
  put :: GeometricDistribution -> Put
put (GD Double
x) = forall t. Binary t => t -> Put
put Double
x
  get :: Get GeometricDistribution
get = do
    Double
x <- 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 -> [Char]
errMsg Double
x) forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ Double -> Maybe GeometricDistribution
geometricE Double
x


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

instance D.DiscreteDistr GeometricDistribution where
    probability :: GeometricDistribution -> Int -> Double
probability (GD Double
s) Int
n
      | Int
n forall a. Ord a => a -> a -> Bool
< Int
1     = Double
0
      | Double
s forall a. Ord a => a -> a -> Bool
>= Double
0.5  = Double
s forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
s)forall a b. (Num a, Integral b) => a -> b -> a
^(Int
n forall a. Num a => a -> a -> a
- Int
1)
      | Bool
otherwise = Double
s forall a. Num a => a -> a -> a
* (forall a. Floating a => a -> a
exp forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a
log1p (-Double
s) forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
- Double
1))
    logProbability :: GeometricDistribution -> Int -> Double
logProbability (GD Double
s) Int
n
       | Int
n forall a. Ord a => a -> a -> Bool
< Int
1     = Double
m_neg_inf
       | Bool
otherwise = forall a. Floating a => a -> a
log Double
s forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
log1p (-Double
s) forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
- Double
1)


instance D.Mean GeometricDistribution where
    mean :: GeometricDistribution -> Double
mean (GD Double
s) = Double
1 forall a. Fractional a => a -> a -> a
/ Double
s

instance D.Variance GeometricDistribution where
    variance :: GeometricDistribution -> Double
variance (GD Double
s) = (Double
1 forall a. Num a => a -> a -> a
- Double
s) forall a. Fractional a => a -> a -> a
/ (Double
s forall a. Num a => a -> a -> a
* Double
s)

instance D.MaybeMean GeometricDistribution where
    maybeMean :: GeometricDistribution -> 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.MaybeVariance GeometricDistribution where
    maybeStdDev :: GeometricDistribution -> Maybe Double
maybeStdDev   = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Variance d => d -> Double
D.stdDev
    maybeVariance :: GeometricDistribution -> 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 GeometricDistribution where
  entropy :: GeometricDistribution -> Double
entropy (GD Double
s)
    | Double
s forall a. Eq a => a -> a -> Bool
== Double
1 = Double
0
    | Bool
otherwise = -(Double
s forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log Double
s forall a. Num a => a -> a -> a
+ (Double
1forall a. Num a => a -> a -> a
-Double
s) forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log1p (-Double
s)) forall a. Fractional a => a -> a -> a
/ Double
s

instance D.MaybeEntropy GeometricDistribution where
  maybeEntropy :: GeometricDistribution -> 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.DiscreteGen GeometricDistribution where
  genDiscreteVar :: forall g (m :: * -> *).
StatefulGen g m =>
GeometricDistribution -> g -> m Int
genDiscreteVar (GD Double
s) g
g = forall g (m :: * -> *). StatefulGen g m => Double -> g -> m Int
MWC.geometric1 Double
s g
g

instance D.ContGen GeometricDistribution where
  genContVar :: forall g (m :: * -> *).
StatefulGen g m =>
GeometricDistribution -> g -> m Double
genContVar GeometricDistribution
d g
g = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall d g (m :: * -> *).
(DiscreteGen d, StatefulGen g m) =>
d -> g -> m Int
D.genDiscreteVar GeometricDistribution
d g
g

cumulative :: GeometricDistribution -> Double -> Double
cumulative :: GeometricDistribution -> Double -> Double
cumulative (GD Double
s) Double
x
  | Double
x forall a. Ord a => a -> a -> Bool
< Double
1        = Double
0
  | forall a. RealFloat a => a -> Bool
isInfinite Double
x = Double
1
  | forall a. RealFloat a => a -> Bool
isNaN      Double
x = forall a. HasCallStack => [Char] -> a
error [Char]
"Statistics.Distribution.Geometric.cumulative: NaN input"
  | Double
s forall a. Ord a => a -> a -> Bool
>= Double
0.5     = Double
1 forall a. Num a => a -> a -> a
- (Double
1 forall a. Num a => a -> a -> a
- Double
s)forall a b. (Num a, Integral b) => a -> b -> a
^Int
k
  | Bool
otherwise    = forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a
expm1 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log1p (-Double
s)
    where k :: Int
k = forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x :: Int

complCumulative :: GeometricDistribution -> Double -> Double
complCumulative :: GeometricDistribution -> Double -> Double
complCumulative (GD Double
s) Double
x
  | Double
x forall a. Ord a => a -> a -> Bool
< Double
1        = Double
1
  | forall a. RealFloat a => a -> Bool
isInfinite Double
x = Double
0
  | forall a. RealFloat a => a -> Bool
isNaN      Double
x = forall a. HasCallStack => [Char] -> a
error [Char]
"Statistics.Distribution.Geometric.complCumulative: NaN input"
  | Double
s forall a. Ord a => a -> a -> Bool
>= Double
0.5     = (Double
1 forall a. Num a => a -> a -> a
- Double
s)forall a b. (Num a, Integral b) => a -> b -> a
^Int
k
  | Bool
otherwise    = forall a. Floating a => a -> a
exp forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log1p (-Double
s)
    where k :: Int
k = forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x :: Int


-- | Create geometric distribution.
geometric :: Double                -- ^ Success rate
          -> GeometricDistribution
geometric :: Double -> GeometricDistribution
geometric Double
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Double -> [Char]
errMsg Double
x) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Double -> Maybe GeometricDistribution
geometricE Double
x

-- | Create geometric distribution.
geometricE :: Double                -- ^ Success rate
           -> Maybe GeometricDistribution
geometricE :: Double -> Maybe GeometricDistribution
geometricE Double
x
  | Double
x forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
<= Double
1  = forall a. a -> Maybe a
Just (Double -> GeometricDistribution
GD Double
x)
  | Bool
otherwise        = forall a. Maybe a
Nothing

errMsg :: Double -> String
errMsg :: Double -> [Char]
errMsg Double
x = [Char]
"Statistics.Distribution.Geometric.geometric: probability must be in (0,1] range. Got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
x


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

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

instance Show GeometricDistribution0 where
  showsPrec :: Int -> GeometricDistribution0 -> ShowS
showsPrec Int
i (GD0 Double
x) = forall a. Show a => [Char] -> a -> Int -> ShowS
defaultShow1 [Char]
"geometric0" Double
x Int
i
instance Read GeometricDistribution0 where
  readPrec :: ReadPrec GeometricDistribution0
readPrec = forall a r. Read a => [Char] -> (a -> Maybe r) -> ReadPrec r
defaultReadPrecM1 [Char]
"geometric0" Double -> Maybe GeometricDistribution0
geometric0E

instance ToJSON GeometricDistribution0
instance FromJSON GeometricDistribution0 where
  parseJSON :: Value -> Parser GeometricDistribution0
parseJSON (Object Object
v) = do
    Double
x <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gdSuccess0"
    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 -> [Char]
errMsg Double
x) forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ Double -> Maybe GeometricDistribution0
geometric0E Double
x
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance Binary GeometricDistribution0 where
  put :: GeometricDistribution0 -> Put
put (GD0 Double
x) = forall t. Binary t => t -> Put
put Double
x
  get :: Get GeometricDistribution0
get = do
    Double
x <- 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 -> [Char]
errMsg Double
x) forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ Double -> Maybe GeometricDistribution0
geometric0E Double
x


instance D.Distribution GeometricDistribution0 where
    cumulative :: GeometricDistribution0 -> Double -> Double
cumulative      (GD0 Double
s) Double
x = GeometricDistribution -> Double -> Double
cumulative      (Double -> GeometricDistribution
GD Double
s) (Double
x forall a. Num a => a -> a -> a
+ Double
1)
    complCumulative :: GeometricDistribution0 -> Double -> Double
complCumulative (GD0 Double
s) Double
x = GeometricDistribution -> Double -> Double
complCumulative (Double -> GeometricDistribution
GD Double
s) (Double
x forall a. Num a => a -> a -> a
+ Double
1)

instance D.DiscreteDistr GeometricDistribution0 where
    probability :: GeometricDistribution0 -> Int -> Double
probability    (GD0 Double
s) Int
n = forall d. DiscreteDistr d => d -> Int -> Double
D.probability    (Double -> GeometricDistribution
GD Double
s) (Int
n forall a. Num a => a -> a -> a
+ Int
1)
    logProbability :: GeometricDistribution0 -> Int -> Double
logProbability (GD0 Double
s) Int
n = forall d. DiscreteDistr d => d -> Int -> Double
D.logProbability (Double -> GeometricDistribution
GD Double
s) (Int
n forall a. Num a => a -> a -> a
+ Int
1)

instance D.Mean GeometricDistribution0 where
    mean :: GeometricDistribution0 -> Double
mean (GD0 Double
s) = Double
1 forall a. Fractional a => a -> a -> a
/ Double
s forall a. Num a => a -> a -> a
- Double
1

instance D.Variance GeometricDistribution0 where
    variance :: GeometricDistribution0 -> Double
variance (GD0 Double
s) = forall d. Variance d => d -> Double
D.variance (Double -> GeometricDistribution
GD Double
s)

instance D.MaybeMean GeometricDistribution0 where
    maybeMean :: GeometricDistribution0 -> 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.MaybeVariance GeometricDistribution0 where
    maybeStdDev :: GeometricDistribution0 -> Maybe Double
maybeStdDev   = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Variance d => d -> Double
D.stdDev
    maybeVariance :: GeometricDistribution0 -> 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 GeometricDistribution0 where
  entropy :: GeometricDistribution0 -> Double
entropy (GD0 Double
s) = forall d. Entropy d => d -> Double
D.entropy (Double -> GeometricDistribution
GD Double
s)

instance D.MaybeEntropy GeometricDistribution0 where
  maybeEntropy :: GeometricDistribution0 -> 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.DiscreteGen GeometricDistribution0 where
  genDiscreteVar :: forall g (m :: * -> *).
StatefulGen g m =>
GeometricDistribution0 -> g -> m Int
genDiscreteVar (GD0 Double
s) g
g = forall g (m :: * -> *). StatefulGen g m => Double -> g -> m Int
MWC.geometric0 Double
s g
g

instance D.ContGen GeometricDistribution0 where
  genContVar :: forall g (m :: * -> *).
StatefulGen g m =>
GeometricDistribution0 -> g -> m Double
genContVar GeometricDistribution0
d g
g = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall d g (m :: * -> *).
(DiscreteGen d, StatefulGen g m) =>
d -> g -> m Int
D.genDiscreteVar GeometricDistribution0
d g
g


-- | Create geometric distribution.
geometric0 :: Double                -- ^ Success rate
           -> GeometricDistribution0
geometric0 :: Double -> GeometricDistribution0
geometric0 Double
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Double -> [Char]
errMsg0 Double
x) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Double -> Maybe GeometricDistribution0
geometric0E Double
x

-- | Create geometric distribution.
geometric0E :: Double                -- ^ Success rate
            -> Maybe GeometricDistribution0
geometric0E :: Double -> Maybe GeometricDistribution0
geometric0E Double
x
  | Double
x forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
x forall a. Ord a => a -> a -> Bool
<= Double
1  = forall a. a -> Maybe a
Just (Double -> GeometricDistribution0
GD0 Double
x)
  | Bool
otherwise        = forall a. Maybe a
Nothing

errMsg0 :: Double -> String
errMsg0 :: Double -> [Char]
errMsg0 Double
x = [Char]
"Statistics.Distribution.Geometric.geometric0: probability must be in (0,1] range. Got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
x