I have encountered this error even though all my data types seems fine.
Run-time error 6 Overflow
Here is the function:
Function equation(x As Long) As Long
Dim a As Long, b As Double
a = Int(((x - 2) Mod 8) / 6) + 2 * Int((x - 2) / 8)
b = (x + a - 1) / 2
equation = Abs(4 * b + 5 + 2 * Int(b))
End Function
Error is encountered when x = 572662307 it says overflow.
x = 572662307. is one-quarter of the max value of a 32-bit signed integer (~2 billion) so your arithmetic operations will likely hit that indeed.
In VBA Long is a 32-bit signed integer and is not a 64-bit signed integer as in C#. I recommend changing both a and x to Double.
You could also spread-out your function so you can inspect all intermediate steps in your debugger:
Function equation(x As Double) As Double
Dim a As Double, b As Double, c As Double, d As Double, e As Double, f As Double, g As Double
a = (x - 2) Mod 8
b = a / 6
b = Int( b )
c = (x - 2) / 8
d = 2 * Int( c )
e = b + d
f = (x + a - 1)
f = f / 2
g = 4 * b + 5 + 2 * Int( f )
equation = Abs( g )
End Function
Related
So I have a "main" function (SolveSixODES) that calls a secondary function (AllODEs). And when it does this, the x value in the main function gets modified. I don't understand how this can be possible, seeing as it is not a global variable.
Here is the code, my inputs I used are as follows:
x=0, xmax=3, y=0-6, h=0.1, error=0.1
Public Function SolveSixODE(x As Double, xmax As Double, Y As Range, h As Double, error As Double) 'Weird bug: You must leave the first y4 value blank
Dim i As Integer, k(7, 7) As Double, j As Integer, m As Integer 'k(Order #, equation #)
Dim Y5(7) As Double, Y4(7) As Double, Y4Old(7) As Double
Dim delta0(7) As Double, delta1(7) As Double, delRatio(7) As Double, Rmin As Double
For i = 1 To 6 'Moving the input data so it can acutally be used
Y4(i) = Y(i)
Next i
While x < xmax
If x + h < xmax Then
x = x + h
Else
h = xmax - x
x = xmax
End If
For j = 1 To 6 'j is the order i is equation number
For i = 1 To 6 'Calculating all of the k(1) values for eq 1 to 6
k(j, i) = AllODES(x, Y4, i, j, k, h) '!!!!!SOME HOW THIS LOOP MAKES X negative...!!!!!!!
Next i
Next j
For i = 1 To 6
Y4Old(i) = Y4(i) 'Saving old y4 value to calc delta0
Y4(i) = Y4(i) + h * (k(1, i) * (37 / 378) + k(3, i) * (250 / 621) + k(4, i) * (125 / 594) + k(6, i) * (512 / 1771))
Y5(i) = Y4(i) + h * (k(1, i) * (2825 / 27648) + k(3, i) * (18575 / 48384) + k(4, i) * (13525 / 55296) + k(5, i) * (277 / 14336) + k(6, i) * (0.25))
delta0(i) = error * (Abs(Y4Old(i)) + Abs(h * AllODES(x, Y4Old, i, 1, k, h))) 'First order because we don't want to use the k vals
delta1(i) = Abs(Y5(i) - Y4(i))
delRatio(i) = Abs(delta0(i) / delta1(i)) 'Ratio of errors
Next i
Rmin = delRatio(1)
For i = 2 To 6
If delRatio(i) < Rmin Then
Rmin = delRatio(i) 'Determine the smallest error ratio
End If
Next i
If Rmin < 1 Then 'If this is true then the step size was too big must repeat step
x = x - h 'Set x and y's back to previous values
For i = 1 To 6
Y4(i) = Y4Old(i)
Next i
h = 0.9 * h * Rmin ^ 0.25 'adjust h value; 0.9 is a safety factor
Else
h = 0.9 * h * Rmin ^ 0.2 'Otherwise, we march on
End If
m = m + 1
Wend
SolveSixODE = Y4
End Function
Public Function AllODES(x As Double, Y() As Double, EqNumber As Integer, order As Integer, k() As Double, h As Double) As Double
Dim conc(7) As Double, i As Integer, j As Integer
If order = 1 Then
x = x - h
For i = 1 To 6 'Movin the data so I can use it
conc(i) = Y(i) 'also adjusting the x and y values for RK4 (Cash Karp values)
Next i
ElseIf order = 2 Then
x = x - h + h * 0.2
For i = 1 To 6
conc(i) = Y(i) + h * k(1, i) * 0.2
Next i
ElseIf order = 3 Then
x = x - h + 0.3 * h
For i = 1 To 6
conc(i) = Y(i) + h * (0.075 * k(1, i) + 0.225 * k(2, i))
Next i
ElseIf order = 4 Then
x = x - h + 0.6 * h
For i = 1 To 6
conc(i) = Y(i) + h * (0.3 * k(1, i) - 0.9 * k(2, i) + 1.2 * k(3, i))
Next i
ElseIf order = 5 Then
x = x - h + h
For i = 1 To 6
conc(i) = Y(i) + h * ((-11 / 54) * k(1, i) + 2.5 * k(2, i) - (70 / 27) * k(3, i) + (35 / 27) * k(4, i))
Next i
ElseIf order = 6 Then
x = x - h + 0.875 * h
For i = 1 To 6
conc(i) = Y(i) + h * ((1631 / 55296) * k(1, i) + (175 / 512) * k(2, i) + (575 / 13824) * k(3, i) + (44275 / (110592) * k(4, i) + (253 / 4096) * k(5, i)))
Next i
Else
MsgBox ("error")
End If
If EqNumber = 1 Then 'These are the actual equations
AllODES = x + Y(1)
ElseIf EqNumber = 2 Then
AllODES = x
ElseIf EqNumber = 3 Then
AllODES = Y(3)
ElseIf EqNumber = 4 Then
AllODES = 2 * x
ElseIf EqNumber = 5 Then
AllODES = 2 * Y(2)
ElseIf EqNumber = 6 Then
AllODES = 3 * x
Else
MsgBox ("You entered an Eq Number that was dumb")
End If
End Function
It's possible that it is something really trivial that I missed but this seems to contradict my knowledge of how variables work. So if you understand how the function is able to manipulate a variable from another function in this case, I would appreciate any advice and/or explanation!
Thanks in advance!
the x value in the main function gets modified. I don't understand how this can be possible, seeing as it is not a global variable
This is normal because you are passing x by reference to the function AllODES and you do change it there. When the keyword ByVal is not explicitly specified in the function/sub prototype, the default passing mechanism is ByRef, that is, by reference.
Public Function AllODES(x As Double, ...
means
Public Function AllODES(ByRef x As Double, ....
We observe that x is manipulated in this function, so the change will appear in the caller. If you want that the change of x does not report back in the caller's scope, pass x by value:
Public Function AllODES(ByVal x As Double, ....
' ^^^^^
Only in this case the x of the caller and the x of the callee will be two different variables.
I need to calculate Gamma cumulative distribution, and it seems this is fairly equivalent to calculating the incomplete beta function.
Excel does have an inculded calculator, but I found no trace of the used algorithm.
Do any of you know an accurate way to calculate this function?
I tried the following, translated into VB.NET from a website, but it gives stupid results:
Function IncompleteBetaFunc(x As Double, a As Double, b As Double) As Double
If x <= 0 Or x >= 1 Then Return 0
Dim bt As Double
bt = Math.Exp(GammaLn(a + b) - GammaLn(a) - GammaLn(b) + a * Math.Log(x) + b * Math.Log(1.0 - x))
If x < (a + 1.0) / (a + b + 2.0) Then
Return bt * betacf(a, b, x) / a
Else
Return 1.0 - bt * betacf(b, a, 1.0 - x) / b
End If
End Function
Function betacf(x As Double, a As Double, b As Double) As Double
Const MAXIT As Integer = 100
Const EPS As Double = 0.0000003
Const FPMIN As Double = 1.0E-30
Dim aa, c, d, del, h, qab, qam, qap As Double
Dim m, m2 As Integer
qab = a + b
qap = a + 1.0
qam = a - 1.0
c = 1.0
d = 1.0 - qab * x / qap
If (Math.Abs(d) < FPMIN) Then d = FPMIN
d = 1.0 / d
h = d
For m = 1 To MAXIT
m2 = 2 * m
aa = m * (b - m) * x / ((qam + m2) * (a + m2))
d = 1.0 + aa * d
If (Math.Abs(d) < FPMIN) Then d = FPMIN
c = 1.0 + aa / c
If (Math.Abs(c) < FPMIN) Then c = FPMIN
d = 1.0 / d
h *= d * c
aa = -(a + m) * (qab + m) * x / ((a + m2) * (qap + m2))
d = 1.0 + aa * d
If (Math.Abs(d) < FPMIN) Then d = FPMIN
c = 1.0 + aa / c
If (Math.Abs(c) < FPMIN) Then c = FPMIN
d = 1.0 / d
del = d * c
h *= del
If (Math.Abs(del - 1.0) < EPS) Then Exit For
Next
Return h
End Function
Thanks!
Meta.Numerics includes well-tested and performant code for this any many other special functions. Its incomplete Beta function is documented here. The underlying code can be studied here. It also has a full-on Gamma distribution object, which will give moments, generate random variates, and do other distribution-related stuff in addition to computing the CDF. The package available via NuGet; just search for Meta.Numerics in the VS NuGet interface.
I've been trying to do Modular exponentiation in VBA for use in MS excel, but there seems to be a logical error which crashes Excel everytime i try to use the formula.
Function expmod(ax As Integer, bx As Integer, cx As Integer)
' Declare a, b, and c
Dim a As Integer
Dim b As Integer
Dim c As Integer
' Declare new values
Dim a1 As Integer
Dim p As Integer
' Set variables
a = ax
b = bx
c = cx
a1 = a Mod c
p = 1
' Loop to use Modular exponentiation
While b > 0
a = ax
If (b Mod 2 <> 0) Then
p = p * a1
b = b / 2
End If
a1 = (a1 * a1) Mod c
Wend
expmod = a1
End Function
I used the pseudocode which was provided here.
Here is an implementation I wrote a while back. Using Long rather than Integer enables it to handle higher exponents:
Function mod_exp(alpha As Long, exponent As Long, modulus As Long) As Long
Dim y As Long, z As Long, n As Long
y = 1
z = alpha Mod modulus
n = exponent
'Main Loop:
Do While n > 0
If n Mod 2 = 1 Then y = (y * z) Mod modulus
n = Int(n / 2)
If n > 0 Then z = (z * z) Mod modulus
Loop
mod_exp = y
End Function
I am trying to find the x intercept of a 4th degree function by incrementing the x value. I feel like this way doesnt work always and isnt the most efficient way to do this, is there another way I am missing?
My code is:
Sub Findintercept()
Dim equation As Double, x As Double, A As Double, B As Double, C As Double, D As Double, E As Double
A = 0.000200878
B = -0.002203704
C = 0.0086
D = -0.02333
E = 0.02033
x = 0
equation = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
While (equation > 0.00001 Or equation < -0.00001)
If (x > 5) Then
MsgBox "Could not find intercept"
equation = 0
Else
x = x + 0.0001
equation = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
End If
Wend
MsgBox x
End Sub
Sometimes it fails to find the intercept hence the IF condition in the while loop. (Im always expecting the intercept to be less than 5!
Your method suffers from two problems:
You assume a step size to change x. The step could be too large, causing you to "walk past" the value your are looking for. To deal with this, you make a small step size, which can mean an excessively large number of iterations are needed to find the solution.
You always assume the same direction to change x. Even with seemingly small values for your step size, you could "walk past" the solution, and have no means to change direction. Or, your initial guess may be on the wrong side of the solution, and you never find an answer.
The Newton-Raphson method handles both of these issues neatly. You do still need to choose your initial guess somewhat close to the root you are looking for.
This method does have potential problems, but for polynomials such as the one you are dealing with, it is quite good.
Below is a simple VBA sub that implements this method. It solves your problem in 4 iterations. I recommend adjusting the initial guess (xii) a lot to see how it impacts the solution you get.
Sub SimpleNewtonRaphson()
Const Tol As Double = 1E-06
Const MaxIter As Long = 50
Dim xi As Double, xii As Double, deriv As Double
Dim IterCount As Long
' Initialize
xi = 0#
xii = 1#
IterCount = 0
' Method
Do While IterCount < MaxIter And Abs(xii - xi) > Tol
xi = xii
deriv = myDeriv(xi)
If deriv = 0# Then Exit Do
xii = xi - myFunc(xi) / deriv
IterCount = IterCount + 1
Loop
' Results
If deriv = 0 Then MsgBox "Ran into a 0 derivative, modify initial guess"
If IterCount >= MaxIter Then MsgBox "MaxIterations reached"
If Abs(xii - xi) <= Tol Then MsgBox "Solution found #" & vbCrLf & "F(" & xii & ") = " & myFunc(xii)
End Sub
... and two VBA functions for your equation and it's derivative ...
Function myFunc(x As Double) As Double
Const A As Double = 0.000200878
Const B As Double = -0.002203704
Const C As Double = 0.0086
Const D As Double = -0.02333
Const E = 0.02033
myFunc = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
End Function
Function myDeriv(x As Double) As Double
Const A As Double = 0.000200878
Const B As Double = -0.002203704
Const C As Double = 0.0086
Const D As Double = -0.02333
myDeriv = 4 * A * x ^ 3 + 3 * B * x ^ 2 + 2 * C * x + D
End Function
I'm trying to create a code that uses the false position method to find the roots of an equation. The equation is as follows:
y = x^(1.5sin(x)) * e^(-x/7) + e^(x/10) - 4
I used a calculator to find the roots, and they are 6.9025, 8.8719, and 12.8079.
My VBA code is as follows:
Option Explicit
Function Func(x)
Func = (x ^ (1.5 * Sin(x))) * Exp(-x / 7) + Exp(x / 10) - 4
End Function
Function FalsePos(Guess1, Guess2)
Dim a, b, c As Single
Dim i As Integer
a = Guess1
b = Guess2
For i = 0 To 1000
c = a - Func(a) * (b - a) / (Func(b) - Func(a))
If (Func(c) < 0.00001) Then
i = 1001
Else
If Func(a) * Func(c) < 0 Then
b = c
Else
a = c
End If
End If
Next
FalsePos = c
End Function
My problem is that when I call the function and use for example 4 and 8 as my two guesses, the number it returns is 5.29 instead of the root between 4 and 8 which is 6.9025.
Is there something wrong with my code or am I just not understanding the false position method correctly?
You should use Double for precision with Maths problems. Three other notes about coding that you may not be aware of:
dim a, b, c as Single
will dim a and b as Variants, and c as a Single, and you can use Exit For to escape from a for loop, rather than setting the control variable out of the bounds. Finally, you should define the outputs of a Function by specifying As ... after the closing parenthesis.
You should use breakpoints (press F9 with the carrot in a line of code to breakpoint that line), then step through the code by pressing F8 to advance line-by-line to see what is happening, and keep your eye on the Locals window (Go to View > Locals)
This is the code with the above changes:
Function Func(x As Double) As Double
Func = (x ^ (1.5 * Sin(x))) * Exp(-x / 7) + Exp(x / 10) - 4
End Function
Function FalsePos(Guess1 As Double, Guess2 As Double) As Double
Dim a As Double, b As Double, c As Double
Dim i As Integer
a = Guess1
b = Guess2
For i = 0 To 1000
c = a - Func(a) * (b - a) / (Func(b) - Func(a))
If (Func(c) < 0.00001) Then
Exit For
Else
If Func(a) * Func(c) < 0 Then
b = c
Else
a = c
End If
End If
Next
FalsePos = c
End Function