PDA

View Full Version : Logit VBA Debugging



Anthon
12-05-2016, 11:06 PM
Hi guys,

I am trying to figure out a logit VBA code but the result is #VALUE! when testing it out. I have attached an excel for your reference, you can see the cells where it is tested. The code is below:




Function LOGIT(y As Range, xraw As Range, _
Optional constant As Byte, Optional stats As Byte)
If IsMissing(constant) Then constant = 1
If IsMissing(stats) Then stats = 0
'Count variables
Dim i As Long, j As Long, jj As Long, jjj As Long
Dim V() As Variant
'Read data dimensions
Dim K As Long, N As Long
K = xraw.Columns.Count + constant
ReDim V(1 To 7, 1 To K)
N = y.Rows.Count
'Adding a vector of 1's to the matrix if constant = 1
'name xraw = x from now on
Dim x() As Double
ReDim x(1 To N, 1 To K)
For i = 1 To N
x(i, 1) = 1
For j = 1 + constant To K
x(i, j) = xraw(i, j - constant)
Next j
Next i
'Initializing the coefficient vector (b) and the score (bx)
Dim b() As Double, bx() As Double, ybar As Double, iter As Long, change As Double
Dim lambda() As Double, dlnL() As Double, hesse() As Double, lnL() As Double
ReDim b(1 To K): ReDim bx(1 To N)
ReDim lambda(1 To N)
ReDim dlnL(1 To K)
ReDim hesse(1 To K, 1 To K)
ybar = Application.WorksheetFunction.Average(y)
If constant = 1 Then b(1) = Log(ybar / (1 - ybar))
For i = 1 To N
bx(i) = b(1)
Next i
iter = 1
sens = 10^ - 11
change = 1
lnL(1) = 0
Do While Abs(change) > sens
'Compute prediction Lambda, gradient dlnL,
'Hessian hesse, and log likelihood lnl
For i = 1 To N
lambda(i) = 1 / (1 + Exp(-bx(i)))
For j = 1 To K
dlnL(j) = dlnL(j) + (y(i) - lambda(i)) * x(i, j)
For jj = 1 To K
hesse(jj, j) = hesse(jj, j) - lambda(i) * (1 - lambda(i)) _
* x(i, jj) * x(i, j)
Next jj
Next j
lnL(iter) = lnL(iter) + y(i) * Application.WorksheetFunction.Log(1 / (1 + Exp(-bx(i)))) + (1 - y(i)) _
* Application.WorksheetFunction.Log(1 - 1 / (1 + Exp(-bx(i))))
Next i
Dim SE() As Double, t() As Double, hinv() As Double, hinvg() As Double
Dim Pval() As Double
ReDim t(1 To K)
ReDim hinv(1 To K, 1 To K)
ReDim hinvg(1 To K)
ReDim SE(b(1) To b(K))

iter = iter + 1
change = Application.WorksheetFunction.Ln(iter) - Application.WorksheetFunction.Ln(iter - 1)
'Compute inverse Hessian (=hinv) and multiply hinv with gradient dlnl
hinv = Application.WorksheetFunction.MInverse(hesse)
hinvg = Application.WorksheetFunction.MMult(dlnL, hinv)
If Abs(change) <= sens Then Exit Do

'Apply Newton’s scheme for updating coefficients b
For j = 1 To K
b(j) = b(j) - hinvg(j)
SE(j) = Sqr(-hinv(j, j))
t(j) = b(j) / SE(j)
Pval(j) = 2 * (1 - Application.WorksheetFunction.NormSDist(Abs(t(j))))
V(1, j) = b(j)
Next j
Loop
iter = iter - 1
'ln Likelihood of model with just a constant (lnL0)
Dim lnL0 As Double, PR As Double, LR As Double
lnL0 = N * (ybar * Log(ybar) + (1 - ybar) * Log(1 - ybar))
PR = 1 - (lnL(iter) / lnL0)
LR = 2 * (lnL(iter) - lnL0)
If stats = 1 Then
For j = 1 To K
V(2, j) = SE(j)
V(3, j) = t(j)
V(4, j) = Pval(j)
Next j
V(5, 1) = PR
V(5, 2) = iter
V(6, 1) = LR
V(6, 2) = Pval(1)
V(7, 1) = lnL
V(7, 2) = lnL0
End If
LOGIT = V
End Function

Dave
12-06-2016, 07:02 AM
Maybe trial....

Function LOGIT(y As Range, xraw As Range, _
Optional constant As Byte, Optional stats As Byte) as Long()
Or....

Function LOGIT(y As Range, xraw As Range, _
Optional constant As Byte, Optional stats As Byte) as Variant
HTH. Dave

Anthon
12-06-2016, 05:20 PM
Hi Dave, thanks for the insights. I tried your suggestion but it still doesn't produce any output values except #VALUE!

Dave
12-06-2016, 06:16 PM
How are U using it?

Dim Arr() as Variant, N as integer
Arr = LOGIT(y, xraw, constant, stats)' *enter correct values
For N = Lbound(Arr) to Ubound(Arr)
Msgbox Arr(N)
Next N
The function outputs an array. If this doesn't help, maybe the function isn't producing any values. Good luck. Dave

SamT
12-06-2016, 06:56 PM
Option Explicit '<---- Forces you to declare all variables

Function LOGIT(Y As Range, XRAW As Range, _
Optional CONSTANT As Byte, Optional STATS As Byte) As Variant '<---------

Const sens As Double = 10 ^ -11 'As small a change as is possible in Excel

''''Declarations
Dim i As Long, j As Long, jj As Long ' jjj As Long <-- Not used
Dim V() As Variant
Dim K As Long, N As Long
Dim Ybar As Double, iter As Long, change As Double
Dim lnL0 As Double, PR As Double, LR As Double

Dim Xgrid() As Double 'Holds or same as XRAW
Dim b() As Double, bx() As Double
Dim lambda() As Double, dlnL() As Double, hesse() As Double, lnL() As Double
Dim SE() As Double, t() As Double, hinv() As Double, hinvg() As Double
Dim Pval() As Double


''''Arrays
ReDim V(1 To 7, 1 To K)
ReDim Xgrid(1 To N, 1 To K)
ReDim b(1 To K): ReDim bx(1 To N)
ReDim lambda(1 To N)
ReDim dlnL(1 To K)
ReDim hesse(1 To K, 1 To K)
ReDim t(1 To K)
ReDim hinv(1 To K, 1 To K)
ReDim hinvg(1 To K)
ReDim SE(b(1) To b(K))

''''Initializations
K = XRAW.Columns.Count + CONSTANT
Ybar = Application.WorksheetFunction.Average(Y)
N = Y.Rows.Count
iter = 1
change = 1
lnL(1) = 0
lnL0 = N * (Ybar * Log(Ybar) + (1 - Ybar) * Log(1 - Ybar))

If IsMissing(CONSTANT) Then CONSTANT = 1
If IsMissing(STATS) Then STATS = 0




'Adding a vector of 1's to the matrix if CONSTANT = 1
'name XRAW = Xgrid from now on
For i = 1 To N
Xgrid(i, 1) = 1
For j = 1 + CONSTANT To K
Xgrid(i, j) = XRAW(i, j - CONSTANT)
Next j
Next i

'Initializing the coefficient vector (b) and the score (bx)
If CONSTANT = 1 Then b(1) = Log(Ybar / (1 - Ybar))
For i = 1 To N
bx(i) = b(1)
Next i


Do While Abs(change) > sens
'Compute prediction Lambda, gradient dlnL,
'Hessian hesse, and log likelihood lnl
For i = 1 To N
lambda(i) = 1 / (1 + Exp(-bx(i)))
For j = 1 To K
dlnL(j) = dlnL(j) + (Y(i) - lambda(i)) * Xgrid(i, j)
For jj = 1 To K
hesse(jj, j) = hesse(jj, j) - lambda(i) * (1 - lambda(i)) _
* Xgrid(i, jj) * Xgrid(i, j)
Next jj
Next j

''''''''''''''''''' iter start in First loop = 1
lnL(iter) = lnL(iter) + Y(i) * Application.WorksheetFunction.Log(1 / (1 + Exp(-bx(i)))) + (1 - Y(i)) _
* Application.WorksheetFunction.Log(1 - 1 / (1 + Exp(-bx(i))))
Next i

iter = iter + 1

change = Application.WorksheetFunction.Ln(iter) - Application.WorksheetFunction.Ln(iter - 1)
'Compute inverse Hessian (=hinv) and multiplY hinv with gradient dlnl
hinv = Application.WorksheetFunction.MInverse(hesse)
hinvg = Application.WorksheetFunction.MMult(dlnL, hinv)

If Abs(change) <= sens Then Exit Do

'ApplY Newton’s scheme for updating coefficients b
For j = 1 To K
b(j) = b(j) - hinvg(j)
SE(j) = Sqr(-hinv(j, j))
t(j) = b(j) / SE(j)
Pval(j) = 2 * (1 - Application.WorksheetFunction.NormSDist(Abs(t(j))))
V(1, j) = b(j)
Next j
Loop

iter = iter - 1

'ln Likelihood of model with just a CONSTANT (lnL0)
PR = 1 - (lnL(iter) / lnL0)
LR = 2 * (lnL(iter) - lnL0)

If STATS = 1 Then
For j = 1 To K
V(2, j) = SE(j)
V(3, j) = t(j)
V(4, j) = Pval(j)
Next j

V(5, 1) = PR
V(5, 2) = iter
V(6, 1) = LR
V(6, 2) = Pval(1)
V(7, 1) = lnL
V(7, 2) = lnL0
End If

LOGIT = V
End Function