Question

我正在使用以下算法求解三次多项式方程（x ^ 3 + a x ^ 2 + b x + c = 0）：

function find_roots(a, b, c, lower_bound, upper_bound)
    implicit none
    real*8, intent(in) :: a, b, c, lower_bound, upper_bound
    real*8 :: find_roots
    real*8 :: Q, R, theta, x, Au, Bu
    integer :: i, iter

    Q = (a**2 - 3.D0*b)/9.D0
    R = (2.D0*a**3 - 9.D0*a*b + 27.D0*c)/54.D0

    !If roots are all real, get root in range
    if (R**2.lt.Q**3) then
        iter = 0
        theta = acos(R/sqrt(Q**3))
        !print *, "theta = ", theta
        do i=-1,1
            iter = iter+1
            x = -2.D0*sqrt(Q)*cos((theta + dble(i)*PI*2.D0)/3.D0)-a/3.D0
            !print *, "iter = ", iter, "root = ", x
            if ((x.ge.lower_bound).and.(x.le.upper_bound)) then
                find_roots = x
                return
            end if
        end do
    !Otherwise, two imaginary roots and one real root, return real root
    else
        Au = -sign(1.D0, R)*(abs(R)+sqrt(R**2-Q**3))**(1.D0/3.D0)
        if (Au.eq.0.D0) then
            Bu = 0.D0
        else
            Bu = Q/Au
        end if
        find_roots = (Au+Bu)-a/3.D0
        return
    end if

end function find_roots

现在，可以解析地证明一个立方方程具有以下输入：

    Q0 = 1.D0
    alpha = 1.D-2
    dt = 0.00001D0
    Y = 1000000.D0

    find_roots(-(2.D0*Q0+Y), &
               -(alpha-Q0**2-2.D0*Y*Q0+dt/2.D0*alpha), &
               (dt/2.D0*alpha*Q0+Y*alpha-Y*Q0**2), &
               Q0-sqrt(alpha), &
               Q0+sqrt(alpha)))

必须在Q0 +sqrtα和Q0-sqrtα之间有一个根。这是数学上的确定性。但是，由于所需的结果非常接近Q0 + sqrt（alpha），因此由于浮点错误，上述函数将返回0，而不是正确的根。我已经通过创建一个使用四倍精度的新函数确认了这一点。不幸的是，我不能总是使用四倍精度，因为此函数将被调用数十亿次，并且是性能瓶颈。

所以我的问题是，有什么通用的方法可以重写此代码以减少这些精度错误，同时又可以保持性能？我尝试使用wikipedia建议的算法，但问题实际上变得更加严重。

Answer 1

https://www.cliffsnotes.com/study-guides/algebra/algebra-ii/factoring-polynomials/sum-or-difference-of-cubes 这样可以减少舍入误差。同样，您应该能够找到更好的术语组合，而不必让编译器猜测您想要的是什么， https://en.wikipedia.org/wiki/Horner%27s_method alpha-Q0 ** 2-2.D0 * Y * Q0 + dt / 2.D0 * alpha / =（alpha + alpha * .5 * dt）-Q0 *（Q0 + 2 * Y）您可能会争辩说，任何优秀的优化器都应该知道如何处理.5dt与dt / 2。 ifort认为-no-prec-div的一部分，即使它不能更改舍入。在检查以确保升级规则使它们精确提升一倍之后，是否选择单个精度常数来提高可读性取决于您。依靠f77 D0后缀选择与从不标准的real * 8相同的数据类型似乎是特别糟糕的样式。毫无疑问，如果您的编译器没有抱怨，它就会这样做。

Answer 2

计算的准确性存在问题，无论是a，b，c还是find_roots函数估计。

我使用计算出的a，b，c，发现您的lower_bound和upper_bound是对根的更好估计。

然后我将边界修改为+/-sqrtα* 1.1，以便范围测试适用于64位。我还简化了常数，使它们精确地加倍。

最后，我将根的估计值与fn（0.9d0）和fn（1.1d0）进行了比较，这表明find_roots函数不适用于所提供的a，b，c。

您应该检查引用是否存在错误，否则可能只是使用acos（+/- 1.0）时方法失败。

我用来测试大量印刷品的程序是：

 real*8 function find_roots (a, b, c, lower_bound, upper_bound)
    implicit none
    real*8, intent(in) :: a, b, c, lower_bound, upper_bound
    real*8 :: Q, R, theta, x, Au, Bu, thi
    integer :: i, iter
    real*8 :: two_pi       ! = 8 * atan (1.0d0)

    Q = (a**2 - 3.*b)/9.
    R = (2.*a**3 - 9.*a*b + 27.*c)/54.

    two_pi = 8 * atan (1.0d0)
    !If roots are all real, get root in range
    if (R**2 < Q**3) then
        iter = 0
        x = R/sqrt(Q**3)
        theta = acos(x)
        print *, "theta = ", theta, x
        do i=-1,1
            iter = iter+1
!!            x = -2.D0*sqrt(Q)* cos((theta + dble(i)*PI*2.D0)/3.D0) - a/3.D0
            thi = (theta + i*two_pi)/3.
            x   = -2.*sqrt(Q) * cos (thi) - a/3.
            !print *, "iter = ", iter, "root = ", x
            if ( (x >= lower_bound) .and. (x <= upper_bound) ) then
                find_roots = x
                print *, "find_roots = ", x
!                return
            end if
        end do
    !Otherwise, two imaginary roots and one real root, return real root
    else
        Au = -sign(1.D0, R)*(abs(R)+sqrt(R**2-Q**3))**(1.D0/3.D0)
        if (Au.eq.0.D0) then
            Bu = 0.D0
        else
            Bu = Q/Au
        end if
        find_roots = (Au+Bu)-a/3.D0
        return
    end if

 end function find_roots

 real*8 function get_cubic (x, a, b, c)
    implicit none
    real*8, intent(in) :: x, a, b, c
    get_cubic = ( ( x + a) * x + b ) * x + c
 end function get_cubic


! Now it turns out that it can be shown analytically that a cubic equation with the following inputs:
   real*8 Q0, alpha, dt, Y, a, b, c, lower_bound, upper_bound, val, fn
   real*8, external :: find_roots, get_cubic
!
    Q0    = 1.D0
    alpha = 1.0D-2
    dt    = 0.00001D0
    Y     = 1000000.0D0
!
    a = -(2.*Q0 + Y)
    b = -(alpha - Q0**2 - 2.*Y*Q0 + dt/2.*alpha)
    c = (dt/2.*alpha*Q0 + Y*alpha - Y*Q0**2)
    write (*,*) a,b,c
!
    lower_bound = Q0-sqrt(alpha)*1.1
    upper_bound = Q0+sqrt(alpha)*1.1
    write (*,*) lower_bound, upper_bound
!
    val = find_roots (a, b, c, lower_bound, upper_bound)
!
    fn = get_cubic ( val, a,b,c )
    write (*,*) val, fn
!
! Test the better root values
    val = 0.9d0
    fn = get_cubic ( val, a,b,c )
    write (*,*) val, fn
!
    val = 1.1d0
    fn = get_cubic ( val, a,b,c )
    write (*,*) val, fn
    end

如何减少三次方程式求解器中的浮点误差？

2 个答案: