1
votes

I was practicing Excel vba and tried to find root through Bisection method. I created userform where:

textbox1 - takes equation formula textbox2 - lower point textbox3 - higher point textbox4 - accuracy

and optionButton to choose which method use to find root.

I guess the algorithm implemented is correct but results are not true. I guess there are some issues with working on textbox values

Private Sub CommandButton1_Click()

last = ThisWorkbook.Worksheets("EQ").Cells(Rows.Count,1).End(xlUp).Row

ThisWorkbook.Worksheets("EQ").Cells(last + 1, 1).Value = TextBox1.Text
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 2).Value = TextBox2.Value
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 3).Value = TextBox3.Value
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 4).Value = TextBox4.Value

If OptionButton1.Value = True Then
ThisWorkbook.Worksheets("EQ").Cells(last + 1, 5).Value = "Bisection"


Dim xp As Double
Dim xk As Double
xp = (CDbl(TextBox2.Value))
xk = (CDbl(TextBox3.Value))

ThisWorkbook.Worksheets("EQ").Cells(last + 1, 6).Value = CSng(xm(xp, xk))

End If

(...)

Function xm(xp As Double, xk As Double) As Double

Dim eq as String
Dim fxp As Variant
Dim fxk As Variant
Dim fxm As Variant

xp = (CDbl(TextBox2.Value))
xk = (CDbl(TextBox3.Value))
eq = TextBox1.Text

fxp = (CDbl(Evaluate(Replace(eq, "x", xp))))
fxk = (CDbl(Evaluate(Replace(eq, "x", xk))))
fxm = (CDbl(Evaluate(Replace(eq, "x", xm))))


    Do
        xm = (xp + xk) / 2

        If fxp * fxm < 0 Then
            xk = xm
        Else
            xp = xm
        End If
    Loop Until Abs(xp - xk) < TextBox4.Value

End Function
1
What is eq? Please give a minimal reproducible example. From a coding point of view, it would make sense to have the bisection function be a stand-alone function which doesn't depend on external text boxes and global variables. Pass it what it needs to do its job. That way, the code can be used in other places where you need a root-finder. The code that calls this function can be the code which interacts with input/output. - John Coleman
Note that fxm = (CDbl(Evaluate(Replace(eq, "x", xm)))) is before xm is given a non-zero value. Furthermore, you are not updating the f values in the loop itself. - John Coleman
But when i try to move fxm after giving to xm non-zero value i get "Runtime error 438 Object doesn't support this property or method". - Hannibal Lecteur

1 Answers

0
votes

Note that fxm = (CDbl(Evaluate(Replace(eq, "x", xm)))) is before xm is given a non-zero value. Furthermore, you are not updating the f values in the loop itself.

Here is an approach (which uses much of your code):

Function bisect(f As String, x As String, xp As Double, xk As Double, eps As Double) As Double
    Dim xm As Double
    Dim fxp As Double, fxk As Double, fxm As Double

    Do
        xm = (xp + xk) / 2
        fxp = (CDbl(Evaluate(Replace(f, x, xp))))
        fxk = (CDbl(Evaluate(Replace(f, x, xk))))
        fxm = (CDbl(Evaluate(Replace(f, x, xm))))

        If fxp * fxm < 0 Then
            xk = xm
        Else
            xp = xm
        End If
    Loop Until Abs(xp - xk) < eps
    bisect = xm
End Function

For example, bisect("1-x-x^3","x",0,1,.0001) evaluates to 0.68231201171875

The motivation for making the independent variable a parameter of the function is that e.g. if you want to use a function which uses exp() you will be forced to do do something like use t for the independent variable.

You would use it something like this:

Private Sub CommandButton1_Click()
    Dim eq As String
    Dim xp As Double, xk As Double, eps As Double, root As Double

    eq = TextBox1.Value
    xp = CDbl(TextBox2.Value)
    xk = CDbl(TextBox3.Value)
    eps = CDbl(TextBox4.Value)

    root = bisect(eq, "x", xp, xk, eps)
    MsgBox root
End Sub

The code itself is not very robust. It simply assumes that fxp and fxk are of opposite signs. If this assumption is false, the results are garbage, so some input validation (which raises an error if needed) might be appropriate.