Skip to content
  • Categories
  • Recent
  • Tags
  • Popular
  • World
  • Users
  • Groups
Skins
  • Light
  • Cerulean
  • Cosmo
  • Flatly
  • Journal
  • Litera
  • Lumen
  • Lux
  • Materia
  • Minty
  • Morph
  • Pulse
  • Sandstone
  • Simplex
  • Sketchy
  • Spacelab
  • United
  • Yeti
  • Zephyr
  • Dark
  • Cyborg
  • Darkly
  • Quartz
  • Slate
  • Solar
  • Superhero
  • Vapor

  • Default (No Skin)
  • No Skin
Collapse
Code Project
  1. Home
  2. Database & SysAdmin
  3. Database
  4. Convert Access VBA module to SQL udf

Convert Access VBA module to SQL udf

Scheduled Pinned Locked Moved Database
helpcsharpdatabasebeta-testing
1 Posts 1 Posters 0 Views 1 Watching
  • Oldest to Newest
  • Newest to Oldest
  • Most Votes
Reply
  • Reply as topic
Log in to reply
This topic has been deleted. Only users with topic management privileges can see it.
  • G Offline
    G Offline
    Guytz
    wrote on last edited by
    #1

    Hi, I have a couple of VBA modules I need to convert to a SQL 2005 udf (or a C# class if that is abetter place for it!). The VBA code is below:

    Function RMSBetaDist(x, alpha, beta, rate)
    'Main function where the cumulative Beta distribution is assembled

    datasize = Range("Datsize")
    Dim bt() As Double
    Dim RMSBeta() As Double
    Dim i As Integer

    ReDim bt(datasize)
    ReDim RMSBeta(datasize)

    For i = 1 To datasize
    If x(i, 1) < 0 Or x(i, 1) > 1 Then
    'Error = MsgBox("There is a problem with the x value of the beta function", vbOKOnly)
    'GoTo Abend
    x(i, 1) = 1
    End If
    If x(i, 1) = 0 Then
    bt(i) = 0
    RMSBeta(i) = 0
    GoTo Nextarray
    ElseIf x(i, 1) = 1 Then
    bt(i) = 0
    RMSBeta(i) = 1
    GoTo Nextarray
    Else
    bt(i) = Exp(RMSGammaln(alpha(i, 1) + beta(i, 1)) - RMSGammaln(alpha(i, 1)) - RMSGammaln(beta(i, 1)) + alpha(i, 1) * Log(x(i, 1)) + beta(i, 1) * Log(1 - x(i, 1)))
    End If
    If x(i, 1) < (alpha(i, 1) + 1) / (alpha(i, 1) + beta(i, 1) + 2) Then
    RMSBeta(i) = bt(i) * RMSBetaCF(x(i, 1), alpha(i, 1), beta(i, 1)) / alpha(i, 1)
    Else 'symmetry relation I(a,b)=1-I(b,a) where I() is the incomplete beta function
    RMSBeta(i) = 1 - bt(i) * RMSBetaCF(1 - x(i, 1), beta(i, 1), alpha(i, 1)) / beta(i, 1)
    End If

    Nextarray:
    RMSBetaDist = RMSBetaDist + rate(i) * (1 - RMSBeta(i))
    Next i

    Abend:
    End Function

    Function RMSGammaln(xg) 'Lanczos gamma approximation
    'Used in the Beta distribution approximation

    Dim y, temp, serial, PI, small As Double
    Dim coeff(6) As Double
    Dim j As Integer

    PI = 3.14159265358979
    coeff(0) = 76.18009173
    coeff(1) = -86.50532033
    coeff(2) = 24.01409822
    coeff(3) = -1.231739516
    coeff(4) = 0.00120858003
    coeff(5) = -0.00000536382
    small = 0
    If xg < 1 Then
    small = xg
    y = xg - 1
    Else
    y = xg - 1
    End If
    temp = y + 5.5
    temp = temp - (y + 0.5) * Log(temp)
    serial = 1

    For j = 0 To 5
    y = y + 1
    serial = serial + coeff(j) / y
    Next j
    If small <> 0 Then 'formula for values of x < 1
    RMSGammaln = -temp + Log(Sqr(2 * PI) * serial)
    Else
    RMSGammaln = -temp + Log(Sqr(2 * PI) * serial)
    End If

    End Function

    Function RMSBetaCF(x2, alpha2, beta2)
    'Used to approximate the integral portion of the cumulative Beta distribution

    Dim errorf As Double
    Dim qap, qam, qab, em, temp, d As Double
    Dim bz, bm, bp, bpp As Double
    Dim az, am, ap, app, aold As Double
    Dim m, MaxIterations As Integer

    errorf = 0.0000001
    MaxIterations = 1000
    bm = 1

    1 Reply Last reply
    0
    Reply
    • Reply as topic
    Log in to reply
    • Oldest to Newest
    • Newest to Oldest
    • Most Votes


    • Login

    • Don't have an account? Register

    • Login or register to search.
    • First post
      Last post
    0
    • Categories
    • Recent
    • Tags
    • Popular
    • World
    • Users
    • Groups