{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
-- |
-- Module    : Statistics.Distribution.Hypergeometric
-- Copyright : (c) 2009 Bryan O'Sullivan
-- License   : BSD3
--
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : portable
--
-- The Hypergeometric distribution.  This is the discrete probability
-- distribution that measures the probability of /k/ successes in /l/
-- trials, without replacement, from a finite population.
--
-- The parameters of the distribution describe /k/ elements chosen
-- from a population of /l/, with /m/ elements of one type, and
-- /l/-/m/ of the other (all are positive integers).

module Statistics.Distribution.Hypergeometric
    (
      HypergeometricDistribution
    -- * Constructors
    , hypergeometric
    , hypergeometricE
    -- ** Accessors
    , hdM
    , hdL
    , hdK
    ) 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.MathFunctions.Constants (m_epsilon,m_neg_inf)
import Numeric.SpecFunctions (choose,logChoose)

import qualified Statistics.Distribution as D
import Statistics.Internal


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

instance Show HypergeometricDistribution where
  showsPrec :: Int -> HypergeometricDistribution -> ShowS
showsPrec Int
i (HD Int
m Int
l Int
k) = forall a b c.
(Show a, Show b, Show c) =>
[Char] -> a -> b -> c -> Int -> ShowS
defaultShow3 [Char]
"hypergeometric" Int
m Int
l Int
k Int
i
instance Read HypergeometricDistribution where
  readPrec :: ReadPrec HypergeometricDistribution
readPrec = forall a b c r.
(Read a, Read b, Read c) =>
[Char] -> (a -> b -> c -> Maybe r) -> ReadPrec r
defaultReadPrecM3 [Char]
"hypergeometric" Int -> Int -> Int -> Maybe HypergeometricDistribution
hypergeometricE

instance ToJSON HypergeometricDistribution
instance FromJSON HypergeometricDistribution where
  parseJSON :: Value -> Parser HypergeometricDistribution
parseJSON (Object Object
v) = do
    Int
m <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hdM"
    Int
l <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hdL"
    Int
k <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hdK"
    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
$ Int -> Int -> Int -> [Char]
errMsg Int
m Int
l Int
k) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Maybe HypergeometricDistribution
hypergeometricE Int
m Int
l Int
k
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance Binary HypergeometricDistribution where
  put :: HypergeometricDistribution -> Put
put (HD Int
m Int
l Int
k) = forall t. Binary t => t -> Put
put Int
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Int
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Int
k
  get :: Get HypergeometricDistribution
get = do
    Int
m <- forall t. Binary t => Get t
get
    Int
l <- forall t. Binary t => Get t
get
    Int
k <- 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
$ Int -> Int -> Int -> [Char]
errMsg Int
m Int
l Int
k) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Maybe HypergeometricDistribution
hypergeometricE Int
m Int
l Int
k

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

instance D.DiscreteDistr HypergeometricDistribution where
    probability :: HypergeometricDistribution -> Int -> Double
probability    = HypergeometricDistribution -> Int -> Double
probability
    logProbability :: HypergeometricDistribution -> Int -> Double
logProbability = HypergeometricDistribution -> Int -> Double
logProbability

instance D.Mean HypergeometricDistribution where
    mean :: HypergeometricDistribution -> Double
mean = HypergeometricDistribution -> Double
mean

instance D.Variance HypergeometricDistribution where
    variance :: HypergeometricDistribution -> Double
variance = HypergeometricDistribution -> Double
variance

instance D.MaybeMean HypergeometricDistribution where
    maybeMean :: HypergeometricDistribution -> 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 HypergeometricDistribution where
    maybeStdDev :: HypergeometricDistribution -> 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 :: HypergeometricDistribution -> 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 HypergeometricDistribution where
  entropy :: HypergeometricDistribution -> Double
entropy = HypergeometricDistribution -> Double
directEntropy

instance D.MaybeEntropy HypergeometricDistribution where
  maybeEntropy :: HypergeometricDistribution -> 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

variance :: HypergeometricDistribution -> Double
variance :: HypergeometricDistribution -> Double
variance (HD Int
m Int
l Int
k) = (Double
k' forall a. Num a => a -> a -> a
* Double
ml) forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
ml) forall a. Num a => a -> a -> a
* (Double
l' forall a. Num a => a -> a -> a
- Double
k') forall a. Fractional a => a -> a -> a
/ (Double
l' forall a. Num a => a -> a -> a
- Double
1)
  where m' :: Double
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
        l' :: Double
l' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
        k' :: Double
k' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
        ml :: Double
ml = Double
m' forall a. Fractional a => a -> a -> a
/ Double
l'

mean :: HypergeometricDistribution -> Double
mean :: HypergeometricDistribution -> Double
mean (HD Int
m Int
l Int
k) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l

directEntropy :: HypergeometricDistribution -> Double
directEntropy :: HypergeometricDistribution -> Double
directEntropy d :: HypergeometricDistribution
d@(HD Int
m Int
_ Int
_)
  = forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
  forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
< forall a. Num a => a -> a
negate Double
m_epsilon)
  forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ord a => a -> a -> Bool
< forall a. Num a => a -> a
negate Double
m_epsilon))
    [ let x :: Double
x = HypergeometricDistribution -> Int -> Double
probability HypergeometricDistribution
d Int
n in Double
x forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log Double
x | Int
n <- [Int
0..Int
m]]


hypergeometric :: Int               -- ^ /m/
               -> Int               -- ^ /l/
               -> Int               -- ^ /k/
               -> HypergeometricDistribution
hypergeometric :: Int -> Int -> Int -> HypergeometricDistribution
hypergeometric Int
m Int
l Int
k
  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> [Char]
errMsg Int
m Int
l Int
k) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Maybe HypergeometricDistribution
hypergeometricE Int
m Int
l Int
k

hypergeometricE :: Int               -- ^ /m/
                -> Int               -- ^ /l/
                -> Int               -- ^ /k/
                -> Maybe HypergeometricDistribution
hypergeometricE :: Int -> Int -> Int -> Maybe HypergeometricDistribution
hypergeometricE Int
m Int
l Int
k
  | Bool -> Bool
not (Int
l forall a. Ord a => a -> a -> Bool
> Int
0)            = forall a. Maybe a
Nothing
  | Bool -> Bool
not (Int
m forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
<= Int
l) = forall a. Maybe a
Nothing
  | Bool -> Bool
not (Int
k forall a. Ord a => a -> a -> Bool
> Int
0  Bool -> Bool -> Bool
&& Int
k forall a. Ord a => a -> a -> Bool
<= Int
l) = forall a. Maybe a
Nothing
  | Bool
otherwise              = forall a. a -> Maybe a
Just (Int -> Int -> Int -> HypergeometricDistribution
HD Int
m Int
l Int
k)


errMsg :: Int -> Int -> Int -> String
errMsg :: Int -> Int -> Int -> [Char]
errMsg Int
m Int
l Int
k
  =  [Char]
"Statistics.Distribution.Hypergeometric.hypergeometric:"
  forall a. [a] -> [a] -> [a]
++ [Char]
" m=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
m
  forall a. [a] -> [a] -> [a]
++ [Char]
" l=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
l
  forall a. [a] -> [a] -> [a]
++ [Char]
" k=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k
  forall a. [a] -> [a] -> [a]
++ [Char]
" should hold: l>0 & m in [0,l] & k in (0,l]"

-- Naive implementation
probability :: HypergeometricDistribution -> Int -> Double
probability :: HypergeometricDistribution -> Int -> Double
probability (HD Int
mi Int
li Int
ki) Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max Int
0 (Int
miforall a. Num a => a -> a -> a
+Int
kiforall a. Num a => a -> a -> a
-Int
li) Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
> forall a. Ord a => a -> a -> a
min Int
mi Int
ki = Double
0
    -- No overflow
  | Int
li forall a. Ord a => a -> a -> Bool
< Int
1000 = Int -> Int -> Double
choose Int
mi Int
n forall a. Num a => a -> a -> a
* Int -> Int -> Double
choose (Int
li forall a. Num a => a -> a -> a
- Int
mi) (Int
ki forall a. Num a => a -> a -> a
- Int
n)
              forall a. Fractional a => a -> a -> a
/ Int -> Int -> Double
choose Int
li Int
ki
  | Bool
otherwise = forall a. Floating a => a -> a
exp forall a b. (a -> b) -> a -> b
$ Int -> Int -> Double
logChoose Int
mi Int
n
                    forall a. Num a => a -> a -> a
+ Int -> Int -> Double
logChoose (Int
li forall a. Num a => a -> a -> a
- Int
mi) (Int
ki forall a. Num a => a -> a -> a
- Int
n)
                    forall a. Num a => a -> a -> a
- Int -> Int -> Double
logChoose Int
li Int
ki

logProbability :: HypergeometricDistribution -> Int -> Double
logProbability :: HypergeometricDistribution -> Int -> Double
logProbability (HD Int
mi Int
li Int
ki) Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max Int
0 (Int
miforall a. Num a => a -> a -> a
+Int
kiforall a. Num a => a -> a -> a
-Int
li) Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
> forall a. Ord a => a -> a -> a
min Int
mi Int
ki = Double
m_neg_inf
  | Bool
otherwise = Int -> Int -> Double
logChoose Int
mi Int
n
              forall a. Num a => a -> a -> a
+ Int -> Int -> Double
logChoose (Int
li forall a. Num a => a -> a -> a
- Int
mi) (Int
ki forall a. Num a => a -> a -> a
- Int
n)
              forall a. Num a => a -> a -> a
- Int -> Int -> Double
logChoose Int
li Int
ki

cumulative :: HypergeometricDistribution -> Double -> Double
cumulative :: HypergeometricDistribution -> Double -> Double
cumulative d :: HypergeometricDistribution
d@(HD Int
mi Int
li Int
ki) Double
x
  | forall a. RealFloat a => a -> Bool
isNaN Double
x      = forall a. HasCallStack => [Char] -> a
error [Char]
"Statistics.Distribution.Hypergeometric.cumulative: NaN argument"
  | forall a. RealFloat a => a -> Bool
isInfinite Double
x = if Double
x forall a. Ord a => a -> a -> Bool
> Double
0 then Double
1 else Double
0
  | Int
n forall a. Ord a => a -> a -> Bool
<  Int
minN    = Double
0
  | Int
n forall a. Ord a => a -> a -> Bool
>= Int
maxN    = Double
1
  | Bool
otherwise    = forall d. DiscreteDistr d => d -> Int -> Int -> Double
D.sumProbabilities HypergeometricDistribution
d Int
minN Int
n
  where
    n :: Int
n    = forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x
    minN :: Int
minN = forall a. Ord a => a -> a -> a
max Int
0 (Int
miforall a. Num a => a -> a -> a
+Int
kiforall a. Num a => a -> a -> a
-Int
li)
    maxN :: Int
maxN = forall a. Ord a => a -> a -> a
min Int
mi Int
ki

complCumulative :: HypergeometricDistribution -> Double -> Double
complCumulative :: HypergeometricDistribution -> Double -> Double
complCumulative d :: HypergeometricDistribution
d@(HD Int
mi Int
li Int
ki) Double
x
  | forall a. RealFloat a => a -> Bool
isNaN Double
x      = forall a. HasCallStack => [Char] -> a
error [Char]
"Statistics.Distribution.Hypergeometric.complCumulative: NaN argument"
  | forall a. RealFloat a => a -> Bool
isInfinite Double
x = if Double
x forall a. Ord a => a -> a -> Bool
> Double
0 then Double
0 else Double
1
  | Int
n forall a. Ord a => a -> a -> Bool
<  Int
minN    = Double
1
  | Int
n forall a. Ord a => a -> a -> Bool
>= Int
maxN    = Double
0
  | Bool
otherwise    = forall d. DiscreteDistr d => d -> Int -> Int -> Double
D.sumProbabilities HypergeometricDistribution
d (Int
n forall a. Num a => a -> a -> a
+ Int
1) Int
maxN
  where
    n :: Int
n    = forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x
    minN :: Int
minN = forall a. Ord a => a -> a -> a
max Int
0 (Int
miforall a. Num a => a -> a -> a
+Int
kiforall a. Num a => a -> a -> a
-Int
li)
    maxN :: Int
maxN = forall a. Ord a => a -> a -> a
min Int
mi Int
ki