求解器使用 VBA 运行逻辑回归

Question

我创建了一个函数，它可以在 VBA 中提供逼真函数的日志；该函数需要输入 3 个参数：独立范围（x）、相关范围（y）和 beta 值（B）

option base 1
Public Function LogVerosimilitud(RangoX As Range, RangoY As Range, B As Range) As Variant
Application.Volatile
 Dim n%, m%, i%, j%, k%, X() As Variant, p() As Variant, q() As Variant, g As Double, V() As Variant
  Dim acumula As Double, LogVero As Double
   If B.Rows.Count > B.Columns.Count Then
    Application.Transpose (B)
     End If
  g = 0
  n = RangoX.Rows.Count
  m = B.Columns.Count
  k = 0
 ReDim X(n, m)
 ReDim p(n)
 ReDim q(n)
 ReDim V(n)
   For i = 1 To n
    For j = 1 To m
     If j = 1 Then
      X(i, j) = 1
    Else
     k = k + 1
     X(i, j) = RangoX(i, k)
    End If
   Next j
   k = 0
 Next i
 For i = 1 To n
  For j = 1 To m
  g = g + X(i, j) * B(1, j)
   Next j
   p(i) = Exp(g) / (1 + Exp(g))
   q(i) = 1 - p(i)
   g = 0
 Next i
  For i = 1 To n
   V(i) = RangoY(i) * Application.Ln(p(i)) + (1 - RangoY(i)) * Application.Ln(q(i))
    Next i
LogVerosimilitud = Application.Sum(V)

End Function

因为我无法直接在 UDF 中使用求解器，所以我想在特定单元格中运行我的函数，然后在另一个单元格中运行一个辅助函数，该函数调用我试图在其中运行 Excel 求解器的子函数

Sub Solver(Target, Rango)
    SolverOk SetCell:=Target.Address, MaxMinVal:=1, ValueOf:=0, ByChange:=Rango.Address, _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverSolve
End Sub

这是我的辅助功能：

Public Function LOGIT(LogVero As Range, B As Range) As Boolean
 Debug.Print LogVero.Address
 Debug.Print B.Address
 Call Solver(LogVero.Address, B.Address)
End Function

但是当运行 LOGIT 函数时，我在运行 LOGIT 函数的单元格中出现 #Value 错误

我做错了什么？

这就是我的数据的样子：

Answer 1

Necroposting：如果您执意要使用 Excel 和 VBA 执行逻辑回归，您不妨使用一个直接为您提供回归系数估计值的函数。

这里有一个方法：找到对数似然函数的梯度和粗麻布矩阵，并使用牛顿法和方便的种子（在其他地方使用截距参数和 0 值系数的矩量法），拟合模型直到成功可以满足标准或触发故障保护。

我会这样做：

Option Compare Binary
Option Explicit
Option Base 1

Public Function logistic_regressor( _
   ByRef X As Range, ByRef y As Range, Optional ByRef fit_intercept As Boolean = True _
) As Variant
   '''
   ' An implementation of the classic logistic regression using VBA and Newton's method.
   '
   ' Parameters
   ' ----------
   ' `ByRef X As Range`
   '     The feature matrix.
   ' `ByRef y As Range`
   '     The response array.
   ' `Optional ByRef fit_intercept As Boolean = True`
   '     An optional flag controlling whether an additional intercept parameter should be fit.
   '     Defaults to `True`.
   '
   ' Returns
   ' -------
   ' An array of regression coefficients (including the intercept parameter, at the end) or xlErrNA, if the
   ' numerical solver did not converge.
   '''
   Dim proba As Variant, res() As Double, sigma() As Double, delta_b As Variant
   Dim X_ As Variant, X_T As Variant, y_ As Variant
   Dim g As Variant, h As Variant, b() As Double
   Dim size As Long, ndim As Long, i As Long
   Dim check As Boolean, niter As Long
   Dim intercept_ As Double
   
   Const EPS As Double = 0.00001
   Const MAXITER As Long = 100
   
   size = X.Rows.Count
   ndim = X.Columns.Count + IIf(fit_intercept, 1, 0)
   X_ = X.Value
   y_ = y.Value
   
   If fit_intercept Then
      ReDim Preserve X_(1 To size, 1 To ndim) As Variant
      
      For i = 1 To size
         X_(i, ndim) = 1#
      Next
   End If
   
   ReDim b(1 To ndim, 1 To 1) As Double
   ReDim res(1 To size, 1 To 1) As Double
   ReDim sigma(1 To size, 1 To size) As Double
   
   With WorksheetFunction
      If fit_intercept Then b(ndim, 1) = Log(.Average(y) / (1# - .Average(y)))
      X_T = .Transpose(X_)
      check = False
      niter = 0
      
      While Not (check Or niter > MAXITER)
         niter = niter + 1
         proba = .MMult(X_, b)
         
         For i = 1 To size
            proba(i, 1) = 1# / (1# + Exp(-proba(i, 1)))
            res(i, 1) = y_(i, 1) - proba(i, 1)
            sigma(i, i) = -proba(i, 1) * (1# - proba(i, 1))
         Next
         
         g = .MMult(X_T, res)
         h = .MMult(.MMult(X_T, sigma), X_)
         delta_b = .MMult(.MInverse(h), g)
         check = Sqr(.SumSq(delta_b)) <= EPS
         
         For i = 1 To ndim
            b(i, 1) = b(i, 1) - delta_b(i, 1)
         Next
      Wend
   End With

   If check Then
      If fit_intercept Then
         intercept_ = b(ndim, 1)
      
         For i = ndim To 2 Step -1
            b(i, 1) = b(i - 1, 1)
         Next
         
         b(1, 1) = intercept_
      End If

      logistic_regressor = b
   Else
      logistic_regressor = CVErr(xlErrNA)
   End If
End Function

打开 Excel，打开 VBA 编辑器 (ALT+F11)，创建一个新模块，复制并粘贴上述代码，编辑任意单元格并向下键入

= logistic_regressor(X, y)

，其中

X

和

y

是特征的范围地址分别是矩阵和响应向量，一切都应该非常顺利。