ExcelStat特殊函数计算(3)不完全贝塔函数

B（Beta）函数定义为：

与函数的关系为：

因此，其计算就直接调用函数。

不完全B（Beta）函数为：

其中

当 时，可采用连分式计算：

其中：

当 时，则利用对称关系计算：

连分式计算过程：

Public Function betacf(ByVal a As Double, ByVal b As Double, ByVal x As Double) As Double

    Dim ITMAX, m, m2 As Long
    
    ITMAX = 1000
    
    Dim EPS, FPMIN, aa, C, d, del, h, qab, qam, qap As Double
    EPS = getGDelta()
    FPMIN = 0.000000000001
    qab = a + b
    qap = a + 1#
    qam = a - 1#
    C = 1#
    d = 1# - qab * x / qap
    If (Abs(d) < FPMIN) Then d = FPMIN
    d = 1# / d
    h = d
    For m = 1 To ITMAX
        m2 = 2 * m
        aa = m * (b - m) * x / ((qam + m2) * (a + m2))
        d = 1# + aa * d
        If (Abs(d) < FPMIN) Then d = FPMIN
        C = 1# + aa / C
        If (Abs(C) < FPMIN) Then C = FPMIN
        d = 1# / d
        h = h * d * C
        aa = -(a + m) * (qab + m) * x / ((a + m2) * (qap + m2))
        d = 1# + aa * d
        If (Abs(d) < FPMIN) Then d = FPMIN
        C = 1# + aa / C
        If (Abs(C) < FPMIN) Then C = FPMIN
        d = 1# / d
        del = d * C
        h = h * del
        If (Abs(del - 1#) <= EPS) Then Exit For
    Next
    If (m > ITMAX) Then
        betacf = -1
    Else
        betacf = h
    End If

End Function

不完全B函数计算：

Public Function bata(ByVal a As Double, ByVal b As Double, ByVal x As Double) As Double
    Dim bt As Double
    
    If (x < 0#) Or (x > 1#) Then
        Err.Raise vbObjectError + 513, , "参数错误！ "
    End If
    If (x = 0#) Or (x = 1#) Then
        bt = 0#
    Else
        bt = Exp(lnGamma(a + b) - lnGamma(a) - lnGamma(b) + a * Log(x) + b * Log(1# - x))
    End If
    If (x < (a + 1#) / (a + b + 2#)) Then
        bata = bt * betacf(a, b, x) / a
    Else
        bata = 1# - bt * betacf(b, a, 1# - x) / b
    End If
    
End Function

ExcelStat下载：Excel Stat下载链接 Excel加载宏ExcelStat.xla

关注、转载、点赞、收藏！！！