Problem with Bisection method on Visual Basic [closed] - vb.net

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 3 years ago.
Improve this question
Here is my code for a bisection method. If I input 4 and 5 the program loops infinitely. There is a problem with it running.
Sub TheBisectionMethod1()
Dim a, b As Double 'Taking two variables, A and B
Console.Write(vbLf & "Input A: ")
a = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for A
Console.Write(vbLf & "Input B: ")
b = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for B
line1:
Dim c As Double
c = (a + b) / 2 'declearing variable c for the sum of half of the user entered values
If ((Math.Abs(func(c))) < 0.0001) Then 'in flow chart the value of C remians unchange so the program will not run, so it will run if i is >0.0001
Console.Write(vbLf & "C : {0}", c)
ElseIf (Math.Sign(func(c)) = Math.Sign(func(a))) Then
Console.WriteLine("Hello")
a = c
GoTo line1
ElseIf (Math.Sign(func(c)) <> Math.Sign(func(a))) Then
b = c
GoTo line1
End If
End Sub
Function func(x As Double) As Double
Dim y As Double
y = x ^ 2 - 2
Return y
End Function

Don't use a GoTo. There's no need. Also, remove the user interaction from the method that does the actual work. Read the data in one place, pass it to a method (usually a Function rather than a Sub) that does the work and returns a result, and then show the result to the user after the function ends.
That makes this question tricky, because the only result we see in the original code is writing "Hello" to the Console, and that's clearly just a debugging statement. What do you want this code to do? (I'm gonna assume you mean this)
Function Bisect(a as Double, b As Double) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = func(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(func(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = func(c)
End While
Return c
End Function
Function func(x As Double) As Double
Return x ^ 2 - 2
End Function
And really, it should look like this:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = f(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = f(c)
End While
Return c
End Function
and be called like this:
Bisect(a, b, Function(x) x ^ 2 - 2)
Also, the algorithm here is slightly off based the wikipedia article. This is more precise:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim TOL As Double = 0.0001
Dim MaxSteps As Integer = 1000
Dim c As Double = (a + b) / 2
While Math.Abs(f(c)) >= TOL AndAlso (b-a)/2 >= TOL AndAlso MaxSteps > 0
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
MaxSteps -= 1
c = (a + b) / 2
End While
If MaxSteps = 0 Then
Throw New ArgumentException("The bisection fails to converge within the allowed time for the supplied arguments.")
End If
Return c
End Function
I bring it up, because the complaint in the original question is this:
the program loops infinently[sic]
and one of the tenants of the algorithm is it's not guaranteed to converge, hence the step counter.
Finally, this looks to me like it might do well as a recursive function. Recursion can improve things here because we can rely on the call stack overflowing rather than needing to implement a step counter:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
If Math.Abs(f(c)) < TOL OrElse (b-a)/2 < TOL Then Return c
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
Return Bisect(c, b, f)
Else
Return Bisect(a, c, f)
End If
End Function
Of course, catching that StackOverflowException is a trick in itself, so you may still want that step counter. But I need to leave something for you to do yourself.
This also helps demonstrate part of why I recommend removing all user I/O from the Bisect() method. If this method were also responsible for talking to the end user, it would not be possible to even consider the recursive option, where the code is clearly far shorter and simpler than any of the others.

Related

How to enable/disable button with a function

I have a problem with my university project
It's a little game, 6 buttons for each players and 2 players so 12 buttons
There is number in each buttons, if a player has his 6 buttons at 0, he can't play
I have try some Public Function and i'm actually working with a very simple one but i think this is not the problem
My function is here
And in my form, the problem is here, i've tried many things but i don't know how do to that ... I read my lesson and I'm searching on the internet, i have no idea ..
If possible is True you don't re-enable the button.
You can simplify things.
Public Function PeutJouer(ByVal joueur As Integer) As Boolean
Dim sum As Integer
Dim start As Integer = (joueur - 1) * 7
For i As Integer = start To start + 5
sum += tableau(i)
Next
Return sum <> 0
End Function
Then
Btn1P1.Enabled = PeutJouer(1)
Did you show all the relevant code? You are declaring Dim tableau(12) As Integer but the array is never filled with values. Probably tableau should be declared at the form level and not locally in this function. If you already have both, remove the local declaration, because it hides the one at form level. You also need to return the result from the function. I don't see this in your function.
Note that this
If x <> 0 Then
booleanVariable = True
Else
booleanVariable = True
End If
can be simplified to
booleanVariable = x <> 0
i.e., the condition is an expression yielding the Boolean result True or False already and you can use this value directly. When working with numeric values you don't write If x + y = 1 Then r = 1 Else If x + y = 2 Then r = 2 .... You simply write r = x + y.

Is it possible to implement Newton's method *once* in VBA?

I need to use Newton's method on closures.
Function f (x as Double, y as Double) as Double
f = x^3-y
End Function
I get the value of y from a cell and then I would like to find out when f is zero. In the toy example above, if the cell contains y=8, then I would expect Newton's method to find a solution close to x=2.
My solution was to make a newton_solve_f function:
Function newton_solve_f (y as Double as Double) as Double
Dim x as Double
x = 0 'initial guess for x
'do Newton's method to find x
...
newton_solve_f = x
End Function
so in effect, I copy paste my code for Newton's method (taken from here) into newton_solve_f.
The problem is that I have several such fs (some with more than two arguments), and it would be really neat if I didn't have to make a separate almost identical newton_solve_f for every one of them.
How would you solve this in VBA?
In Python, for example, it's possible to solve this problem as follows:
def f(y):
def g(x):
return x^3-y
return g
def newton_solve(f):
#do newton's method on f(x)
newton_solve(f(3))
Here f(3) is a function, a closure of one variable. (The closure example on wikipedia is almost identical to this one.)
ps. I know Newton's method also needs the (partial) derivative of f, I'm actually doing something that's more like the secant method, but that's irrelevant for what I'm asking about
Closures are not part of VBA. But you can use static variables within a method scope. They cannot be used outside the method. If you want a variable to visible outside, then you have to use global variable. Preferable declare it public in a module.
We cannot define function inside function in VB. Tried to convert the code given in the link you have mentioned. I hope it helps you. Not well versed with php, but you can see the approach below and make changes accordingly.
Sub Test()
Dim x As Double
Dim y As Double
Dim z As Double
x = Cells(1, 1).Value
y = Cells(1, 2).Value
z = NewtRap("Fun1", "dFun1", x, y)
Cells(1, 3).Value = z
End Sub
Private Function NewtRap(fname As String, dfname As String, x_guess As Double, y_value As Double) As Double
Dim cur_x As Double
Dim Maxiter As Double
Dim Eps As Double
Maxiter = 500
Eps = 0.00001
cur_x = x_guess
For i = 1 To Maxiter
If (fname = "Fun1") Then
fx = Fun1(cur_x)
ElseIf (fname = "dFun1") Then
fx = dFun1(cur_x)
ElseIf (fname = "f") Then
fx = f(cur_x, y_value)
End If
If (dfname = "Fun1") Then
fx = Fun1(cur_x)
ElseIf (dfname = "dFun1") Then
fx = dFun1(cur_x)
ElseIf (dfname = "f") Then
fx = f(cur_x, y_value)
End If
If (Abs(dx) < Eps) Then Exit For
cur_x = cur_x - (fx / dx)
Next i
NewtRap = cur_x
End Function
Function f(x As Double, y As Double) As Double
f = x ^ 3 - y
End Function
Function Fun1(x As Double) As Double
Fun1 = x ^ 2 - 7 * x + 10
End Function
Function dFun1(x As Double) As Double
dFun1 = 2 * x - 7
End Function
So to first summarise: You want to create a function that will find (using Newton-Raphson method) the roots of a function. You already have this written and working for certain functions but would like help expanding your code so it will work with a variety of functions with varying numbers of parameters?
I think you first need to think about what input functions you want it to cover. If you are only dealing with polynomials (as your example suggests), this should be fairly straightforward.
You could have general functions of:
Function fnGeneralCase (x, y, z, w, a1, a2, a3, b1, b2, b3, c1, c2, c3 as Double) as Double
fnGeneralCase = a1*x^3 + a2*x^2 + a3*x + b1*y^3 + b2*y^2 + b3*y + c1*z^3 + c2*z^2 + c3*z + w
End Function
Function fnDerivGeneralCase (x, y, z, w, a1, a2, a3, b1, b2, b3, c1, c2, c3 as Double) as Double
fnDerivGeneralCase = a1*3*x^2 + a2*2*x + a3 + b1*3*y^2 + b2*2*y + b3 + c1*3*z^2 + c2*2*z + c3
End Function
And just set the inputs to zero when you don't need them (which will be for the majority of the time).
So for your example calling:
answer = fnGeneralCase(guess, 0, 0, -8, 1, 0, 0, 0, 0, 0, 0, 0, 0)
basically gives:
function = x^3-8
If you want to include more than polynomials, this will get more complicated but you could still use the above approach...
This seems to be asking 2 related questions:
how to pass a function as an argument in vba.
how to create a closure out of an existing function.
Unfortunately neither of these are really supported, however,
for 1 you can generally work around this by passing a string function name and using 'Application.Run' to invoke the function.
2 is trickier if you have lots of functions with different numbers of parameters, but for a set number of parameters you could add extra parameters to the newton_solve function or maybe use global variables.
e.g.
Public Function f(x as Double, y as Double) as Double
f = x^3-y
End Function
Function newton_solve_f (function_name as String, y as Double) as Double
Dim x as Double
x = 0 'initial guess for x
'do Newton's method to find x
...
' invoke function_name
x = Application.Run(function_name, x, y)
...
newton_solve_f = x
End Function
Assuming f is in a module called 'Module1' you can call this with:
x = newton_solve('Module1.f', 3)
Note that the function you want to call must be public.

Static 'function' in vba/excel?

I just have a very simple question regarding vba.
I understand that a static variable in vba keeps its previous value rather then reseting it each time the function is called. However, I was wondering how could I have a "static function" rather than a variable. Let me clarify this with a simple code:
Function Alt(Soc1 As Double)
Static D As Integer
If Soc1 >= 40 Then
Alt = 0
ElseIf Soc1 <= 30 Then
Alt = 1
End If
End Function
Here I would like the variable-function Alt to keep its previous value so that I get a sort of "hysteresis" behaviour. However if I add:
Static Alt As Integer
I get an error when calling the function Alt().
Also if I add a line such as:Alt = D while D is decalred as static I get an alternating value of Alt (1,0,1,0,1,0 ..) instead of (1,1,1,1) if active or (0,0,0,0) if not.
How should I tackle this simple issue? Any help would be appreciated.
Thank you in advance!
If I've got you, not sure it does what you need. :)
Option Explicit
Public intReturnToHold As Double
Sub call_function()
Debug.Print Alt(2, intReturnToHold)
End Sub
Function Alt(Soc1 As Double, Optional ByRef intHoldAlt)
Static D As Integer
Alt = intReturnToHold
If Soc1 >= 40 Then
Alt = 0
ElseIf Soc1 <= 30 Then
Alt = 1
End If
intHoldAlt = Alt
End Function
Thank you Nathan for your answer. Altough I don't really understand your code I believe I get the idea of it but it did not work.
I have tried my previous idea again and for some reason it worked this time, here is the code;
Function Alt(Soc1 As Double)
Static D As Integer
If Soc1 >= 40 Then
D = 0
ElseIf Soc1 <= 30 Then
D = 1
End If
Alt = D
End Function
I have previously tired the EXACT same code and the results were as I said in my question "alternating" between 1 and 0 (when active) but now are constant 1 (when active).
I'm not 100% sure what you are asking, but if you want a function to compute just once and then retain its value, you could do something like this:
Function Alt(Soc1 As Double) As Long
Static D As Long
Static Called As Boolean
If Called Then
Alt = D
Exit Function
End If
If Soc1 >= 40 Then
D = 0
ElseIf Soc1 <= 30 Then
D = 1
End If
Called = True
Alt = D
End Function
On the other hand, if your goal is to have a function which, once it takes on the value 1 never resets to 0, something like this would work:
Function Alt(Soc1 As Double) As Long
Static D As Long
If D = 1 Then
Alt = D
Exit Function
End If
If Soc1 >= 40 Then
D = 0
ElseIf Soc1 <= 30 Then
D = 1
End If
Alt = D
End Function

Integer subtraction and looping based on integer values

I'm having two problems here. First off all I want to x to change values to x - y and if the new X is higher then 0 i want the process to repeat itself. I've worked out the code below but i'm not certiant on two things.
Am I even allowed to make the equation x = x - y or does this mess up everything? I mean in mathematical terms it would not be possible but if we take X as Hp and Y as damage I want the damage to add up. I don't want it to create an "damage HP" integer for every subtraction as I even don't know how many "Z = x - y" style equations I would have to create if I set Y to be random.
My guess is that I could create a Z integral that would copy X a moment before the subtraction would go off and then have the subtraction be X = Z - Y but I'm not sure how I would go about coding this.
I want it to go ahead and loop itself if X is higher then 0 and I'm not sure if I coded that correctly.
Here is my code:
Module Module1
Dim A As Integer
Dim B As Integer
Dim x As Integer
Dim y As Integer
Sub Main()
End Sub
Sub Maths()
A = 5
B = 4
x = 3
y = 1
Subtraction()
Console.WriteLine("You deal {0} damage to your enemy reducing it to {1} hp.", y, x)
Do Until x <= 0
Loop
End Sub
Private Sub Subtraction()
If A > B Then x = x -y
Return
End Sub
End Module
I liked this question. Here's my thoughts:
Yes, x = x - y is perfectly valid code. It's no different than if I had a string variable named myRunOnSentence and I wanted to concatenate the string that was already in the variable and another string and then store the results back in the string variable. Like this: myRunOnSentence = myRunOnSentence + "another string" Same concept, just change the datatype to an Integer. x = x + y. That programatically says: "take the value in x and the value in y, add them together, and store the result of that expression in x."
You did indeed make a mistake with the loop. You don't have any code inside the body of the loop itself.
You have nothing happening in the Main() sub of your module so this module when run will do nothing. You should just take the code from the Maths() method and put it in the Main() sub.
In your Subtraction() method, A > B will always evaluate to True because A and B are initialized with values and then never changed.
Your code should look something like this:
Module Module1
Dim A As Integer = 5
Dim B As Integer = 4
Dim x As Integer = 3
Dim y As Integer = 1
Sub Main()
Do Until x <= 0
Subtraction()
Console.WriteLine("You deal {0} damage to your enemy reducing it to {1} hp.", y, x)
Loop
End Sub
Private Sub Subtraction()
If A > B Then x = x - y 'Return statement wasn't needed.
End Sub
End Module
If this answered your question, please don't forget to mark it as the answer.

Checking if a number has an integer cubic root

I am trying to check whether a given number is cuberoot or not in VBA.
The following code works only for 2 and 3 as answers, it does not work after that.
I am trying to figure out what is wrong in the code.
Sub cuberoot()
Dim n As Long, p As Long, x As Long, y As Long
x = InputBox("x= ")
If Iscube(x) Then
MsgBox ("Is cube")
Else
MsgBox ("No cube")
End If
End Sub
Private Function Iscube(a As Long) As Boolean
b = a ^ (1 / 3)
If b = Int(b) Then
Iscube = True
Else
Iscube = False
End If
End Function
Since you are passing in a Long I'll assume that you won't have a number bigger than roughly 2*10^9 so this should always work. It's a slight variation where you truncate the double and then compare to the two nearest integers to make sure you catch any rounding errors.
Edit: In VBA the truncating would always round so it's only neccessary to check the 3rd root value:
Public Function Iscube(a As Long) As Boolean
Dim b As Integer
b = CInt(a ^ (1# / 3#))
If (b ^ 3 = a) Then
Iscube = True
Else
Iscube = False
End If
End Function
If you need a number larger than a Long you'll need to change your input type and you might want to consider an iterative method like a binary search or a Newton-Raphson solver instead.
Existing Code
Your code will work if you add a
dim b as long
If you debug your code you will see that feeding in 125 gives you
b = 5
Int(b) = 4
Updated Code
You can shorten your boolean test to this
Function Iscube(lngIn As Long) As Boolean
Iscube = (Val(lngIn ^ (1 / 3)) = Int(Val(lngIn ^ (1 / 3))))
End Function
Note that if you call it with a double, it will opearte on the long portion only (so it would see IsCube(64.01)as IsCube(64))