Assistance Incorporating the Poisson Function into Access I\'l looking for assis
ID: 3560634 • Letter: A
Question
Assistance Incorporating the Poisson Function into Access
I'l looking for assistance taking VBA code that invokes the Poisson function that resides in a module and providing a result in a Query field. The Excel versions of the Poisson function are listed below:
Where:
X = Number of Channels
Y = Total Erlangs
A = Target Queue Delay
B = Average Hold Time
=+POISSON(X, Y,FALSE)/(POISSON(X, Y,FALSE)+(1-( Y / X))*POISSON(X -1, Y,TRUE))
=+POISSON(X, Y,FALSE)/(POISSON(X, Y,FALSE)+(1-( Y / X))*POISSON(X -1, Y ,TRUE))*EXP(-(X - Y)* A / B)
The arguments X, Y, A, and B have been calculated in Access and reside in a Query. Again, the objective is to take VBA code that invokes the Poisson function that resides in a module and provide a result in a Query field.
Thank you in advance for your assistance.
Kevin
A possible version of VBA code for adaptation that utilizes the Excel library is as follows:
Sub Test()
Dim myCONN
Dim myRST
Dim stSQL As String
Dim objExcel As Excel.Application
Set objExcel = CreateObject("Excel.Application")
Set myCONN = Application.CurrentProject.Connection
Set myRST = CreateObject("ADODB.Recordset")
stSQL = "SELECT APM , RHO " & _
"FROM tblErlang;"
U = 6
myRST.Open stSQL, myCONN, 1
If Not myRST.EOF And Not myRST.BOF Then myRST.MoveFirst
While Not myRST.BOF And Not myRST.EOF
RHO = U / myRST![APM]
myPois = objExcel.Application.Poisson(myRST![APM], U, False)
myPois2 = objExcel.Application.Poisson(myRST![APM] - 1, U, True)
Debug.Print myPois / ((myPois) + (1 - RHO) * myPois2)
myRST.MoveNext
Wend
objExcel.Quit
Set objExcel = Nothing
End Sub
A possible version of VBA code for adaptation that does not utilize the Excel library is as follows:
CODE
Imports Microsoft.VisualBasic
Imports System.Math
Public Class GlobalPoisson
Public Function IncompleteGammaC(ByVal a As Double, _
ByVal x As Double) As Double
Dim result As Double
Dim IGammaEpsilon As Double
Dim IGammaBigNumber As Double
Dim IGammaBigNumberInv As Double
Dim ans As Double
Dim ax As Double
Dim c As Double
Dim yc As Double
Dim r As Double
Dim t As Double
Dim y As Double
Dim z As Double
Dim pk As Double
Dim pkm1 As Double
Dim pkm2 As Double
Dim qk As Double
Dim qkm1 As Double
Dim qkm2 As Double
Dim Tmp As Double
IGammaEpsilon = 0.000000000000001
IGammaBigNumber = 4.5035996273705E+15
IGammaBigNumberInv = 2.22044604925031 * 0.0000000000000001
If x <= 0.0# Or a <= 0.0# Then
result = 1.0#
IncompleteGammaC = result
Exit Function
End If
If x < 1.0# Or x < a Then
result = 1.0# - IncompleteGamma(a, x)
IncompleteGammaC = result
Exit Function
End If
ax = a * Log(x) - x - LnGamma(a, Tmp)
If ax < -709.782712893384 Then
result = 0.0#
IncompleteGammaC = result
Exit Function
End If
ax = Exp(ax)
y = 1.0# - a
z = x + y + 1.0#
c = 0.0#
pkm2 = 1.0#
qkm2 = x
pkm1 = x + 1.0#
qkm1 = z * x
ans = pkm1 / qkm1
Do
c = c + 1.0#
y = y + 1.0#
z = z + 2.0#
yc = y * c
pk = pkm1 * z - pkm2 * yc
qk = qkm1 * z - qkm2 * yc
If qk <> 0.0# Then
r = pk / qk
t = Abs((ans - r) / r)
ans = r
Else
t = 1.0#
End If
pkm2 = pkm1
pkm1 = pk
qkm2 = qkm1
qkm1 = qk
If Abs(pk) > IGammaBigNumber Then
pkm2 = pkm2 * IGammaBigNumberInv
pkm1 = pkm1 * IGammaBigNumberInv
qkm2 = qkm2 * IGammaBigNumberInv
qkm1 = qkm1 * IGammaBigNumberInv
End If
Loop Until t <= IGammaEpsilon
result = ans * ax
IncompleteGammaC = result
End Function
Public Function IncompleteGamma(ByVal a As Double, ByVal x As Double) As Double
Dim result As Double
Dim IGammaEpsilon As Double
Dim ans As Double
Dim ax As Double
Dim c As Double
Dim r As Double
Dim Tmp As Double
IGammaEpsilon = 0.000000000000001
If x <= 0.0# Or a <= 0.0# Then
result = 0.0#
IncompleteGamma = result
Exit Function
End If
If x > 1.0# And x > a Then
result = 1.0# - IncompleteGammaC(a, x)
IncompleteGamma = result
Exit Function
End If
ax = a * Log(x) - x - LnGamma(a, Tmp)
If ax < -709.782712893384 Then
result = 0.0#
IncompleteGamma = result
Exit Function
End If
ax = Exp(ax)
r = a
c = 1.0#
ans = 1.0#
Do
r = r + 1.0#
c = c * x / r
ans = ans + c
Loop Until c / ans <= IGammaEpsilon
result = ans * ax / a
IncompleteGamma = result
End Function
Public Function LnGamma(ByVal x As Double, ByRef SgnGam As Double) As Double
Dim result As Double
Dim a As Double
Dim B As Double
Dim c As Double
Dim P As Double
Dim Q As Double
Dim u As Double
Dim w As Double
Dim z As Double
Dim i As Long
Dim LogPi As Double
Dim LS2PI As Double
Dim Tmp As Double
SgnGam = 1.0#
LogPi = 1.1447298858494
LS2PI = 0.918938533204673
If x < -34.0# Then
Q = -x
w = LnGamma(Q, Tmp)
P = Int(Q)
i = Round(P)
If i Mod 2.0# = 0.0# Then
SgnGam = -1.0#
Else
SgnGam = 1.0#
End If
z = Q - P
If z > 0.5 Then
P = P + 1.0#
z = P - Q
End If
z = Q * Sin(PI * z)
result = LogPi - Log(z) - w
LnGamma = result
Exit Function
End If
If x < 13.0# Then
z = 1.0#
P = 0.0#
u = x
Do While u >= 3.0#
P = P - 1.0#
u = x + P
z = z * u
Loop
Do While u < 2.0#
z = z / u
P = P + 1.0#
u = x + P
Loop
If z < 0.0# Then
SgnGam = -1.0#
z = -z
Else
SgnGam = 1.0#
End If
If u = 2.0# Then
result = Log(z)
LnGamma = result
Exit Function
End If
P = P - 2.0#
x = x + P
B = -1378.25152569121
B = -38801.6315134638 + x * B
B = -331612.992738871 + x * B
B = -1162370.97492762 + x * B
B = -1721737.0082084 + x * B
B = -853555.664245765 + x * B
c = 1.0#
c = -351.815701436523 + x * c
c = -17064.2106651881 + x * c
c = -220528.590553854 + x * c
c = -1139334.44367983 + x * c
c = -2532523.07177583 + x * c
c = -2018891.41433533 + x * c
P = x * B / c
result = Log(z) + P
LnGamma = result
Exit Function
End If
Q = (x - 0.5) * Log(x) - x + LS2PI
If x > 100000000.0# Then
result = Q
LnGamma = result
Exit Function
End If
P = 1.0# / (x * x)
If x >= 1000.0# Then
Q = Q + ((7.93650793650794 * 0.0001 * P - 2.77777777777778 * 0.001) * P + 0.0833333333333333) / x
Else
a = 8.11614167470508 * 0.0001
a = -(5.95061904284301 * 0.0001) + P * a
a = 7.93650340457717 * 0.0001 + P * a
a = -(2.777777777301 * 0.001) + P * a
a = 8.33333333333332 * 0.01 + P * a
Q = Q + a / x
End If
result = Q
LnGamma = result
End Function
End Class
Explanation / Answer
I will answer your question in a general way, not specific to your situation.
If we want to use the results of a VBA function in a query, we can call that function from the query. Something like:
select ID, Sin(ID) from myTable
This gets the Sine value of the ID primary key value. Probably not very useful, but you get the point.
Similarly you can call your custom functions:
select ID, myFunction(myField1, myField2) from myTable
In this case myFunction *must* be a public function (not a sub) in a standard module (not a class module or a form module).
Looking at your code, the final block which is not using Excel (and which SHOULD perform much better), you have only implemented some helper function, not yet the main Poisson function.
Also note that the code you are quoting is from VB.NET (hence the Imports statements) but at first sight appears to be compatible with VBA. Lucky you. If for example you had used Math.xxx functions, too bad, so sad.
Btw, in Excel you should use POISSON.DIST as the more compatible version.
I think of Poisson more as a distribution (a set of x/y values) but reading up on it a bit there is indeed the cumulative probability which the Poisson.Dist function returns.
Related Questions
drjack9650@gmail.com
Navigate
Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.