Best algorithm for root search

[Kelvin Stott]

I am looking for the best (fastest as well as most reliable) algorithm to solve equations (find their roots, f(x) = 0, where 0 < x < 1), but have only been able to find the following 2 algorithms:
<x<1), but="" have="" only="" been="" able="" to="" find="" the="" following="" 2="" algorithms:
<x<1), and="" have="" found="" 2="" different="" approaches,="" each="" with="" their="" own="" pros="" cons:

1. Binary search, which finds f(x') closest to zero for each cycle (i = 1 to 50), where x' = x +/- 0.5^i
2. Classic Newton Raphson

The problem is that a binary search is very inefficient and can take too long (too many cycles), while Newton Raphson is unreliable as it depends on an arbitrary initial estimate. So I'm wondering: Is there a better (faster and more reliable) algorithm (VBA code) available that combines these two approaches?

Thanks for any help.</x<1),></x<1),>

 

[Kelvin Stott]

So far I tried just simple polynomials like x^2, x^3, plus CDF normal distribution.

 

[Worf]

I tested it with a third order polynomial, requiring the same precision for the two methods:

1) Excel Solver (GRG): 3 to 8 seconds, depending on the initial estimate.
2) Your function: 0.003 seconds.

 

[Kelvin Stott]

Interesting, thank you.

Now slightly faster and even more reliable in finding the best solution (minimum or maximum when there is no root):

Function SOLVE(Fx As String, Optional Target As Double = 0, Optional xMin As Double = 0, Optional xMax As Double = 1, _
    Optional xTol As Double = 10 ^ -15, Optional yTol As Double = 10 ^ -15, Optional iMax As Integer = 50)

    Dim i As Integer
    Dim yMin As Double, yMax As Double
    Dim xMid As Double, yMid As Double
    Dim Sht As Worksheet, Fn As WorksheetFunction
    
    Set Sht = Application.ThisCell.Parent
    Set Fn = WorksheetFunction
    
    For i = 1 To iMax
        xMid = (xMin + xMax) / 2
        yMid = Sht.Evaluate(Replace(Fx, "x", xMid))
        yMin = Sht.Evaluate(Replace(Fx, "x", xMin))
        yMax = Sht.Evaluate(Replace(Fx, "x", xMax))
        If Abs(xMax - xMin) <= xTol Then
            Exit For
        ElseIf Abs(yMid - Target) <= yTol Then
            Exit For
        ElseIf Abs(yMin - Target) <= yTol Then
            xMid = xMin
            Exit For
        ElseIf Abs(yMax - Target) <= yTol Then
            xMid = xMax
            Exit For
        ElseIf Fn.Median(yMid, yMin, yMax) = yMin Then
            xMin = xMid
        ElseIf Fn.Median(yMid, yMin, yMax) = yMax Then
            xMax = xMid
        ElseIf Fn.Median(Target, yMin, yMid) = yMin Then
            xMax = 2 * xMin - xMid
        ElseIf Fn.Median(Target, yMax, yMid) = yMax Then
            xMin = 2 * xMax - xMid
        Else
            xMin = xMid + (xMin - xMid) * (Target - yMid) / (yMin - yMid)
            xMax = xMid + (xMax - xMid) * (Target - yMid) / (yMax - yMid)
        End If
    Next i
    
    SOLVE = xMid

End Function

Note that the interval xMin to xMax keeps halving and shifting until both yMid and Target are between yMin and yMax, before it applies Newton Raphson to recalculate the interval.

 

[Kelvin Stott]

OK, fully optimized version:

Function SOLVE(Fx As String, Optional Target As Double = 0, Optional xMin As Double = 0, Optional xMax As Double = 1, _
    Optional xTol As Double = 10 ^ -15, Optional yTol As Double = 10 ^ -15, Optional iMax As Integer = 50)

    Dim Fn As WorksheetFunction
    Dim i As Integer
    Dim xMid As Double, yMid As Double
    Dim yMin As Double, yMax As Double
    Dim x1 As Double, x2 As Double
    
    Set Fn = WorksheetFunction
    
    For i = 1 To iMax
        xMid = (xMin + xMax) / 2
        yMid = Evaluate(Replace(Fx, "x", xMid))
        yMin = Evaluate(Replace(Fx, "x", xMin))
        yMax = Evaluate(Replace(Fx, "x", xMax))
        If Abs(xMax - xMin) <= xTol Then
            Exit For
        ElseIf Abs(yMid - Target) <= yTol Then
            Exit For
        ElseIf Abs(yMin - Target) <= yTol Then
            xMid = xMin
            Exit For
        ElseIf Abs(yMax - Target) <= yTol Then
            xMid = xMax
            Exit For
        ElseIf Fn.Median(yMid, yMin, yMax) = yMin Then
            xMin = xMid
        ElseIf Fn.Median(yMid, yMin, yMax) = yMax Then
            xMax = xMid
        ElseIf Fn.Median(Target, yMin, yMid) = yMin Then
            xMax = 2 * xMin - xMid
        ElseIf Fn.Median(Target, yMax, yMid) = yMax Then
            xMin = 2 * xMax - xMid
        Else
            x1 = Fn.Median(xMin, xMax, xMid + (xMin - xMid) * (Target - yMid) / (yMin - yMid))
            x2 = Fn.Median(xMin, xMax, xMid + (xMax - xMid) * (Target - yMid) / (yMax - yMid))
            xMin = Fn.Min(x1, x2)
            xMax = Fn.Max(x1, x2)
        End If
    Next i
    
    SOLVE = xMid

End Function

Would anyone else care to test this?

Any suggestions for further improvement?