Option Explicit
Dim radicand As Double
Dim index As Double
Dim nthroot As Double
'---------------------------------------
Private Function f(ByVal radicand As Double, ByVal index As Long, ByVal nthroot As Double) As Double
'x^(1/n) = z
'x = radicand
'n = index
'z = nthroot
'z^n - x = 0
f = nthroot ^ index - radicand
End Function
'---------------------------------------
Private Function Bisection(ByVal LowerBound As Double, _
ByVal UpperBound As Double, _
Optional ByVal AllowableError As Double = 0.0000000001, _
Optional ByVal MaxIterations As Long = 10000) As Double
'Bisection is a root finding algorithm, given a function and a range
'that the root lies in (root must be between upper and lower bounds),
'bisection will keep cutting the range in half until it finds the root
'(or more accurately an approximation that lies within your error
'tolerance)
'Pros: 1) if a root exists in the range given, bisection will find it!
'Cons: 1) if multiple roots exist in the range given, bisection may
' only find one of them (if there are an even number of roots
' in the range, bisection may fail completely)
' 2) convergence may take more iterations than in other algorithms
' (though in other algorithms convergence may not be guaranteed)
'This particular variation has been written to find the nth root of
'a given number. Bisection will return 0 if it cannot find a root
'(this happens when the result would be complex, i.e. trying to find
'an even root of a negative number).
Dim iteration As Long
Dim error As Double
Dim xroot As Double
Dim test As Double
'error = 2 * AllowableError
iteration = 0
Do
xroot = (LowerBound + UpperBound) / 2
iteration = iteration + 1
'if the function = 0 we have found the root (exactly)
error = f(radicand, index, xroot)
'look for a sign change between UpperBound and xroot
'if there is a sign change then the root is between
'xroot and upperbound, otherwise the root is between
'lowerbound and xroot
test = f(radicand, index, UpperBound) * f(radicand, index, xroot)
If test = 0 Then
'we found the root exactly!
'not likely to ever get here due to computer representation of
'numbers and rounding errors, but it is a possibility
error = 0
Exit Do
Else
If test < 0 Then
LowerBound = xroot
Else
UpperBound = xroot
End If
End If
Loop Until (Abs(error) < AllowableError) Or (iteration > MaxIterations)
If error > AllowableError Then
'we must have run out of iterations
'probably no root on given range
Bisection = 0
Else
Bisection = xroot
End If
End Function
'---------------------------------------
Private Sub cmdCalculate_Click()
radicand = Val(txtRadicand.Text)
index = Val(txtIndex.Text)
If Abs(radicand) > 1 Then
nthroot = Bisection(-radicand, radicand)
Else
nthroot = Bisection(-1, 1)
End If
lblNthRoot = nthroot
lblCheckResult = nthroot ^ index
End Sub