Question

我必须通过收缩因子（λ）将方差-协方差矩阵中的值向方差收缩（矩阵中的对角线值），因此： lambda * shrinkagematrix +（1-lambda）* variancecovariancematrix，其中：

方差协方差矩阵为：

Function VarCovar(rng As Range) As Variant
    Dim i As Integer
    Dim j As Integer
    Dim numcols As Integer

    numcols = rng.Columns.Count
    numrows = rng.Rows.Count

    Dim matrix() As Double
    ReDim matrix(numcols - 1, numcols - 1)

    For i = 1 To numcols
        For j = 1 To numcols
            matrix(i - 1, j - 1) = Application.WorksheetFunction.Covar(rng.Columns(i), rng.Columns(j)) * numrows / (numrows - 1)
        Next j
    Next i
    VarCovar = matrix

，这给了我一个矩阵，例如：

 0.40  -0.10  0.11                                                 
-0.10   0.17 -0.03                                              
 0.11  -0.03  0.19

然后我在创建看起来像如下的收缩矩阵时遇到了麻烦：

0.40  0.00  0.00                                      
0.00  0.17  0.00                                              
0.00  0.00  0.19

即在所有其他单元格中仅返回对角线值（=变量的方差）且为零。

所以以某种方式，使其返回仅包含row = column number的值的矩阵，即（1,1），（2,2）和（3,3）值。

有什么可以帮助您的吗？

Answer 1

您只需要一个从i = 1 to 3开始的循环来使用Matrix(1, 1)填充Matrix(2, 2)，Matrix(3, 3)和Matrix(i, i)

Function VarCovar(InputMatix As Range) As Variant
    Dim MatrixColumns  As Long
    MatrixColumns = InputMatix.Columns.Count

    Dim MatrixRows  As Long
    MatrixRows = InputMatix.Rows.Count

    Dim Matrix() As Double
    ReDim Matrix(1 To MatrixColumns, 1 To MatrixColumns)

    Dim i As Long
    For i = 1 To MatrixColumns
        Matrix(i, i) = Application.WorksheetFunction.Covar(InputMatix.Columns(i), InputMatix.Columns(i)) * MatrixRows / (MatrixRows - 1)
    Next i

    VarCovar = Matrix
End Function

请注意，我将Matrix尺寸Matrix(1 To MatrixDimension, 1 To MatrixDimension)更改为以1而不是0开头，因此您可以轻松地将其写入单元格：

Sub test()

    Range("A5:C7").Value = VarCovar(Range("A1:C3"))

End Sub

仅将一个矩阵中的对角线值（其他单元格中为零）返回到另一个具有相同尺寸的矩阵

1 个答案: