Gamma distribution, incomplete beta function - vb.net

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.

Related

Block If without End If during the barrier option calculation

I am not able to compute the Barrier Option, because it shows me an error in the first line (where I wrote function). The code is as following. Thank you in advance.
Function UOBarrierOption(S As Double, q As Double, T As Double, X As Double, r As Double, _
sigma As Double, CallPutFlag As String, H As Double, K As Double, phi As Double, eta As Double)
Dim x1 As Double, x2 As Double
Dim y1 As Double, y2 As Double
Dim z As Double, mu As Double, lambda As Double
Dim AA As Double, BB As Double, CC As Double, DD As Double, EE As Double, FF As Double
mu = (r - q - sigma ^ 2 / 2) / (sigma ^ 2)
lambda = Sqr(mu ^ 2 + 2 * r / sigma ^ 2)
x1 = Log(S / X) / (sigma * Sqr(T)) + (1 + mu) * sigma * Sqr(T)
x2 = Log(S / H) / (sigma * Sqr(T)) + (1 + mu) * sigma * Sqr(T)
y1 = (Log(H ^ 2) / S / S) / (sigma * Sqr(T)) + (1 + mu) * sigma * Sqr(T)
y2 = (Log(H / S)) / (sigma * Sqr(T)) + (1 + mu) * sigma * Sqr(T)
z = Log(H / S) / (sigma * Sqr(T)) + lambda * sigma * Sqr(T)
AA = phi * S * Exp(-q * T) * Application.NormSDist(phi * x1) - phi * X * Exp(-r * T) * Application.NormSDist(phi * x1 - phi * sigma * Sqr(T))
BB = phi * S * Exp(-q * T) * Application.NormSDist(phi * x2) - phi * X * Exp(-r * T) * Application.NormSDist(phi * x2 - phi * sigma * Sqr(T))
CC = phi * S * Exp(-q * T) * (H / S) ^ (2 * (mu + 1)) * Application.NormSDist(eta * y1) - phi * X * Exp(-r * T) * (H / S) ^ (2 * mu) * Application.NormSDist(eta * y1 - eta * sigma * Sqr(T))
DD = phi * S * Exp(-q * T) * (H / S) ^ (2 * (mu + 1)) * Application.NormSDist(eta * y2) - phi * X * Exp(-r * T) * (H / S) ^ (2 * mu) * Application.NormSDist(eta * y2 - eta * sigma * Sqr(T))
EE = K * Exp(-r * T) * (Application.NormSDist(eta * x2 - eta * sigma * Sqr(T)) - (H / S) ^ (2 * mu) * Application.NormSDist(eta * y2 - eta * sigma * Sqr(T)))
FF = K * Exp(-r * T) * (Application.NormSDist(-eta * x2 + eta * sigma * Sqr(T)) + (H / S) ^ (2 * mu) * Application.NormSDist(eta * y2 - eta * sigma * Sqr(T)))
If CallPutFlag = "Cdi" Then
If X > H Then
UOBarrierOption = CC + EE
ElseIf X < H Then
UOBarrierOption = AA - BB + DD + EE
End Function
ElseIf CallPutFlag = "Cui" Then
If X > H Then
UOBarrierOption = AA + EE
ElseIf X < H Then
UOBarrierOption = BB - CC + DD + EE
End Function
ElseIf CallPutFlag = "Pdi" Then
If X > H Then
UOBarrierOption = BB - CC + DD + EE
ElseIf X < H Then
UOBarrierOption = AA + EE
End Function
ElseIf CallPutFlag = "Pui" Then
If X > H Then
UOBarrierOption = AA - BB + DD + EE
ElseIf X < H Then
UOBarrierOption = CC + EE
End Function
ElseIf CallPutFlag = "Cdo" Then
If X > H Then
UOBarrierOption = AA - CC + FF
ElseIf X < H Then
UOBarrierOption = BB - DD + FF
End Function
ElseIf CallPutFlag = "Cuo" Then
If X > H Then
UOBarrierOption = F
ElseIf X < H Then
UOBarrierOption = AA - BB + CC - DD + FF
End Function
ElseIf CallPutFlag = "Pdo" Then
If X > H Then
UOBarrierOption = AA - BB + CC - DD + FF
ElseIf X < H Then
UOBarrierOption = F
End Function
ElseIf CallPutFlag = "Puo" Then
If X > H Then
UOBarrierOption = BB - DD + FF
ElseIf X < H Then
UOBarrierOption = AA - CC + FF
End Function
End If
End Function
P.S. I have different "phi"s and "eta"s for different types of option barriers (cdi, pdi and etc.). Right now I am trying different combinations, but it also gives "end if function missing" type of error
If your function returns something you must declare the type returned in the function, and assign the returned value to the function, for exmaple:
Function CalculateSquareRoot(NumberArg As Double) As Double
If NumberArg < 0 Then ' Evaluate argument.
Exit Function ' Exit to calling procedure.
Else
CalculateSquareRoot = Sqr(NumberArg) ' Return square root.
End If
End Function
See the As Double and the CalculateSquareRoot = Sqr(NumberArg). That is what the function returns.
If it does not return anything, and its just a method, you should declare it with Sub().
Sub()
'your method
End Sub

Run-time error 6 Overflow

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

How is a local variable in another function affecting a variable in my main function?

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.

This is homework. Can someone help me figure out what I have declared wrong? I keep getting an error when I give Double

Function quadratic (a As double, b As double, c As double) As Double
Dim x,y As Double
if (a = 0) then
Console.Writeline("no solution for a = 0")
else if
((b * b - 4 * a * c) <0)
Console.Writeline("no real solutions")
else
x = ((- b + Math.Sqrt(b * b - 4 * a * c)) / ( 2 * a))
y = ((- b - Math.Sqrt(b * b - 4 * a * c)) / ( 2 * a))
if (x > y) then
Console.Writeline(x)
else
Console.Writeline(y)
End if
End if
End Function
I am not going to check your math for you :-) but if you change this:
else if
((b * b - 4 * a * c) <0)
Console.Writeline("no real solutions")
To this:
ElseIf ((b * b - 4 * a * c) < 0) Then
Console.Writeline("no real solutions")
It compiles and runs...

I Keep getting a #value error in Excel VBA

So I wrote a quick function in VBA for Excel, but every time I call it, it gives me a #value error. I don't know what I am doing wrong. Can anyone help?
Function h(UA, k, A, Af_At, Delta, l)
h1 = 0
m = (2 * h1 / k / Delta) ^ 0.5
ml = m * l
Nf = WorksheetFunction.Tanh(ml)
No = 1 - Af_At * (1 - Nf / ml)
UA1 = h1 * A * No / 2
While UA > UA1
UA_old = UA1
h_old = h1
h1 = h1 + 0.5
m = (2 * h1 / k / Delta) ^ 0.5
ml = m * l
Nf = WorksheetFunction.Tanh(ml)
No = 1 - Af_At * (1 - Nf / ml)
UA1 = h1 * A * No / 2
Wend
h = h_old + (UA - UA_old) * (h1 - h_old) / (UA1 - UA_old)
End Function
I call it using: =h(10,1,1,1,1,1) in the insert function bar.
Division by zero at
No = 1 - Af_At * (1 - Nf / ml)
m1 is zero because h1 is zero.
You should change:
h1 = 0