LOOPING: Faster rate of convergence required

davidm · #1 03-24-2008, 10:45 PM

I am developing a UDF which requires some looping to arrive at the result. To keep it simple, part of the routine is akin to solving the following Amount equation for i.

Find i such that A=1.72846 given A=(1+i)^10

The following code resolves to the correct answer of i = 5.6248%

Code:

Sub nn()
Time1 = Timer
i = 0.01
k = 1
Do
A = (1 + i) ^ 10
i = i + 0.0000001
k = k + 1
'Debug.Print k & "........" & i
Loop Until Application.Round(A, 4) = 1.7285
MsgBox i & " ... " & Timer - Time1
End Sub

tekman · #2 03-25-2008, 12:05 AM

Timer does not register ---- 18 loops to solve. Set a Min and Max i for limits and let it go...
18 Loops was based on Starting i with a min value of 0% and a Max value of 100%

Code:

Sub nn()
Dim i As Double
Dim A As Double
Dim B As Double
Dim Min_i As Double
Dim Max_i As Double
Dim Step As Double
Dim Iterations As Long

Iterations = 0
Min_i = 0
Max_i = 1
Step = Max_i - Min_i
i = Min_i

Do
    A = (1 + i) ^ 10
    B = Application.Round(A, 4)
    
    If B < 1.7285 Then
        i = i + Step
        Step = Step / 2
    ElseIf B > 1.7285 Then
        i = i - Step
        Step = Step / 2
    Else
        MsgBox i & " ... " & Iterations
        Exit Sub
    End If
    
    Iterations = Iterations + 1
Loop Until B = 1.7285
MsgBox i & " ... " & Iterations
End Sub

**mikerickson** · #3 03-25-2008, 12:21 AM

If A = (i +1)^10

then LN(A)=10*LN(i+1)

i+1 = e ^ (LN(A)/10)

i = (e ^ (LN(A)/10)) -1

Code:

Dim a as Double
Dim i as Double

a = 1.72846

i = Exp(Log(a) / 10) - 1

tekman · #4 03-25-2008, 12:50 AM

I was not even thinking about logs....

-Lee

**mikerickson** · #5 03-25-2008, 01:04 AM

Your binary search is nice.
I adapted it to find roots of any function. It needs some more error checking (are the intial boundries appropriate?, etc.).

The Sub test solves both the problem in the OP and finds the cube root of 3.

Code:

Sub test()
    MsgBox binarySolver("Ftn", 1.72846, 0, 3, 10 ^ -4) & " is the solution to the OPs problem."
    MsgBox binarySolver("Cube", 3, 0, 5, 10 ^ -7) & " is the cube root of 3."
End Sub

Function binarySolver(thisFunction As String, Goal As Double, Low As Double, High As Double, Accuracy As Double) As Double
Rem to solve thisFunction(x) = Goal within accuracy
Rem Low and High are estimates that bracket the solution
Dim Mid As Double
Dim FtnLow As Double, FtnMid As Double, FtnHigh As Double
Dim loopCount As Long

FtnLow = Run(thisFunction, Low)
FtnHigh = Run(thisFunction, High)
loopCount = 0
Do
    loopCount = loopCount + 1
    
    Mid = (Low + High) / 2
    
    FtnMid = Run(thisFunction, Mid)
    
    If Sgn(FtnLow - Goal) = Sgn(FtnMid - Goal) Then
        Low = Mid: FtnLow = FtnMid
    Else
        High = Mid: FtnHigh = FtnMid
    End If

Loop Until Abs(Goal - FtnMid) < Accuracy

binarySolver = Mid
'MsgBox loopCount
End Function

Function Ftn(a As Double) As Double
    Ftn = (1 + a) ^ 10
    End Function

Function Cube(a As Double) As Double
    Cube = a ^ 3
    End Function

tekman · #6 03-25-2008, 09:21 AM

Thanks for the compliment

I think I will archive your adaptation for future use

- Lee

davidm · #7 03-26-2008, 12:37 AM

Thanks Tek and Mik.

The binary search technique does the trick. My example appeared to be too simplistic to allow for making the RequiredToFind the subject of the equation. In my original, transformation, log or otherwise, is not possible as in "Find x if y = .10 in

y = x - x*(2/(1+x)^15 ).

Once again, thanks.

Welcome to the Excel Forum

Forum Statistics