Question

在一些迭代优化期间，用于计算双变量正常CDF的以下VBA代码有时会在上部函数的z = hx * hy * c循环内的while行上抛出溢出错误。

我调试了代码，并且当乘以的数字导致的数字大于double可以容纳的数字时，就会发生溢出。

你能告诉我如何通过忽略具有如此高值的循环迭代来处理问题 - 我猜这是唯一可行的解决方案（？）。我在乘法之前尝试使用On Error Goto nextiteration线并在Wend之前放置nextiteration跳转点，但错误仍然存在。

Function tetrachoric(x As Double, y As Double, rho As Double) As Double
    Const FACCURACY As Double = 0.0000000000001
    Const MinStopK As Integer = 20
    Dim k As Integer
    Dim c As Double
    Dim z As Double
    Dim s As Double
    Dim hx As Double
    Dim hx1 As Double
    Dim hx2 As Double
    Dim hy As Double
    Dim hy1 As Double
    Dim hy2 As Double
    Dim CheckPass As Integer

    hx = 1
    hy = 1
    hx1 = 0
    hy1 = 0
    k = 0

    c = rho
    z = c
    s = z
    CheckPass = 0

    While CheckPass < MinStopK
        k = k + 1
        hx2 = hx1
        hy2 = hy1
        hx1 = hx
        hy1 = hy
        hx = x * hx1 - (k - 1) * hx2
        hy = y * hy1 - (k - 1) * hy2
        c = c * rho / (k + 1)
        z = hx * hy * c
        s = s + z
        If Abs(z / s) < FACCURACY Then
            CheckPass = CheckPass + 1
        Else
            CheckPass = 0
        End If
    Wend
    tetrachoric = s
End Function


Public Function bivnor(x As Double, y As Double, rho As Double) As Double
'
' bivnor function
' Calculates bivariat normal CDF F(x,y,rho) for a pair of standard normal
' random variables with correlation RHO
'
If rho = 0 Then
    bivnor = Application.WorksheetFunction.NormSDist(x) * _
         Application.WorksheetFunction.NormSDist(y)
Else
    bivnor = Application.WorksheetFunction.NormSDist(x) * _
         Application.WorksheetFunction.NormSDist(y) + _
         Application.WorksheetFunction.NormDist(x, 0, 1, False) * _
         Application.WorksheetFunction.NormDist(y, 0, 1, False) * _
         tetrachoric(x, y, rho)
End If
End Function

来源：可在http://michael.marginalq.com/

下载

Answer 1

你正在达到计算机体系结构的极限。由于性能原因和/或溢出时的错误行为，许多复杂算法无法以1：1的方式实现其数学表示。关于这些问题的博客非常好 - John D. Cook。

请查看here以便更好地实施。

您还可以尝试绑定外部库，它为您提供任意精确数字处理，当然使用非常昂贵的（就CPU时间而言）软件算法来实现。可以找到更多here。

Answer 2

使用On Error Resume Next代替On Error Goto更新代码：

While CheckPass < MinStopK
    k = k + 1
    hx2 = hx1
    hy2 = hy1
    hx1 = hx
    hy1 = hy
    hx = x * hx1 - (k - 1) * hx2
    hy = y * hy1 - (k - 1) * hy2
    c = c * rho / (k + 1)
    On Error Resume Next
    z = hx * hy * c
    If Err.Number = 0 Then
        s = s + z
        If Abs(z / s) < FACCURACY Then
            CheckPass = CheckPass + 1
        Else
            CheckPass = 0
        End If
    Else
        Err.Clear
    End If
Wend

Answer 3

http://www.codeproject.com/KB/recipes/float_point.aspx讨论如何“使用对数来避免溢出和下溢”，这是解决溢出问题的一种简单但非常有效的方法。事实上，它是如此简单而又合乎逻辑，为什么我们自己没有考虑过这个解决方案呢？ ;）

当乘法结果大于double可以容纳的值时，忽略溢出错误

3 个答案: