add hyper pdfs and cdfs

.github/workflows/ci.yml

@@ -22,6 +22,7 @@ jobs:
   test:
     name: Julia ${{ matrix.version }} - ${{ matrix.os }} - ${{ github.event_name }}
     runs-on: ${{ matrix.os }}
+    timeout-minutes: 30
     strategy:
       fail-fast: false
       matrix:

src/distrs/hyper.jl

@@ -1,32 +1,86 @@
 # functions related to hyper-geometric distribution
 
-# Rmath implementations
-function hyperpdf(ms::Real, mf::Real, n::Real, x::Real)
-    T = float(Base.promote_typeof(ms, mf, n, x))
-    return convert(T, Rmath.dhyper(x, ms, mf, n, false))
+hyperpdf(ms::Real, mf::Real, n::Real, x::Real) = hyperpdf(promote(ms,mf,n,x)...)
+
+function hyperpdf(ms::T, mf::T, n::T, x::T) where T<:Real
+    M, N = ms, ms+mf
+    fxnprev = fMNprev = one(T)
+    fxn = 1 - 2x/n
+    fMN = 1 - 2M/N
+    eiprev = ones(T, Int(n+1))
+    k = 0:n
+    ei = 1 .- k .*(2/n)
+    square(x) = x^2
+    res = fma(fxn, fMN/sum(square, ei), 1/(n+1))
+    ei = collect(ei)
+    for i in 1:n-1
+        fxnnext = ((2i + 1) * (n - 2x) * fxn - i * (n + i + 1) * fxnprev) / ((i + 1) * (n - i))
+        fxn, fxnprev = fxnnext, fxn
+        fMNnext = ((2i + 1) * (N - 2M) * fMN - i * (N + i + 1) * fMNprev) / ((i + 1) * (N - i))
+        fMN, fMNprev = fMNnext, fMN
+        @. eiprev = ((2i + 1) * (n - 2k) * ei - i * (n + i + 1) * eiprev) / ((i + 1) * (n - i))
+        ei, eiprev = eiprev, ei
+        correction =  fxn*fMN/sum(square, ei)
+        abs(correction) < res*eps(T) && break
+        res += correction
+    end
+    res
 end
-function hyperlogpdf(ms::Real, mf::Real, n::Real, x::Real)
-    T = float(Base.promote_typeof(ms, mf, n, x))
-    return convert(T, Rmath.dhyper(x, ms, mf, n, true))
+
+hyperlogpdf(ms::Real, mf::Real, n::Real, x::Real) = hyperlogpdf(promote(ms,mf,n,x)...)
+function hyperlogpdf(ms::T, mf::T, n::T, x::T) where T<:Real
+    return log1p(ms+mf) - log1p(ms) - log1p(mf) + 
+    (logbeta(n + 1, ms + mf - n + 1) - logbeta(x + 1, ms - x + 1) - 
+    logbeta(n - x + 1, mf - n + x + 1))
 end
 
-function hypercdf(ms::Real, mf::Real, n::Real, x::Real)
-    T = float(Base.promote_typeof(ms, mf, n, x))
-    return convert(T, Rmath.phyper(x, ms, mf, n, true, false))
+_hypercdf(ms::Real, mf::Real, n::Real, x::Real, invert::Bool) = _hypercdf(promote(ms, mf, n, x)..., invert::Bool)
+function _hypercdf(ms::T, mf::T, n::T, x::T, invert::Bool) where T<:Real
+    N = ms+mf
+    mode = fld((n + 1) * (ms + 1), N + 2)
+    local result
+    if x < mode
+        result = diff = hyperpdf(ms, mf, n, x)
+        lower_limit = max(0, n+ms-N)
+        while x != lower_limit && diff > (invert ? result : 1)*eps(T)
+            diff *= x * (N + x - n - ms) / ((1+n-x)*(1+ms -x))
+            result += diff
+            x -= 1
+        end
+    else
+        invert = !invert
+        x += 1
+        result = diff = hyperpdf(ms, mf, n, x)
+        upper_limit = min(ms, n)
+        while x != upper_limit && diff > (invert ? 1 : result)*eps(T)
+            diff *= (n-x) * (ms-x) / ((1+x) * (N+x+1-n-ms))
+            result += diff
+            x += 1
+        end
+    end
+    result, invert
 end
-function hyperccdf(ms::Real, mf::Real, n::Real, x::Real)
-    T = float(Base.promote_typeof(ms, mf, n, x))
-    return convert(T, Rmath.phyper(x, ms, mf, n, false, false))
+
+function hypercdf(ms, mf, n, x)
+    result, invert = _hypercdf(ms, mf, n, x, false)
+    invert ? 1-result : result
 end
-function hyperlogcdf(ms::Real, mf::Real, n::Real, x::Real)
-    T = float(Base.promote_typeof(ms, mf, n, x))
-    return convert(T, Rmath.phyper(x, ms, mf, n, true, true))
+
+function hyperccdf(ms, mf, n, x)
+    result, invert = _hypercdf(ms, mf, n, x, true)
+    invert ? 1-result : result
 end
-function hyperlogccdf(ms::Real, mf::Real, n::Real, x::Real)
-    T = float(Base.promote_typeof(ms, mf, n, x))
-    return convert(T, Rmath.phyper(x, ms, mf, n, false, true))
+
+function hyperlogcdf(ms, mf, n, x)
+    result, invert = _hypercdf(ms, mf, n, x, false)
+    invert ? log1p(-result) : log(result)
+end
+function hyperlogccdf(ms, mf, n, x)
+    result, invert = _hypercdf(ms, mf, n, x, true)
+    invert ? log1p(-result) : log(result)
 end
 
+# Rmath implementations
 function hyperinvcdf(ms::Real, mf::Real, n::Real, q::Real)
     T = float(Base.promote_typeof(ms, mf, n, q))
     return convert(T, Rmath.qhyper(q, ms, mf, n, true, false))

test/rmath.jl

@@ -8,6 +8,16 @@ function check_rmath(statsfun, rmathfun, params, a, isprob, rtol)
     v = @inferred(statsfun(params..., a))
     rv = @inferred(rmathfun(a, params...))
     @test v isa float(Base.promote_typeof(params..., a))
+    @test rv isa float(Base.promote_typeof(params..., a))
+    # vbig == bigfloat version if available
+    vbig = try
+        statsfun(params..., big(a))
+    catch
+        rv
+    end
+    # loose accuracy test to confirm shape is right
+    @test v ≈ rv nans = true
+    # tight accuracy test to confirm implimentation is correct numerically
     return if isprob
         @test v ≈ oftype(v, rv) rtol = rtol nans = true
     else
@@ -288,6 +298,7 @@ end
             ((2, 3, 4), 0.0f0:4.0f0),
             ((2, 3, 4), Float16(0):Float16(4)),
             ((2, 3, 4), (0 // 1):(4 // 1)),
+            ((40, 60, 40), 0.0:50.0),
         ]
     )