Вернуть только диагональные значения (ноль в других ячейках) в одной матрице в другую матрицу с такими же размерами - PullRequest
Новая
       21

Вернуть только диагональные значения (ноль в других ячейках) в одной матрице в другую матрицу с такими же размерами

2 голосов
/ 29 марта 2019

Мне нужно сжать значения в матрице дисперсии-ковариации в сторону дисперсии (диагональные значения в матрице) с помощью коэффициента сжатия (лямбда), поэтому: лямбда * усадочная матрица + (1-лямбда) * дисперсионно-ковариационная матрица, где:

Ковариационная матрица дисперсии: 

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

т.е. возвращает ТОЛЬКО диагональные значения (= дисперсии переменных) и ноль во всех остальных ячейках.

Таким образом, в некотором роде, возвращая матрицу, содержащую только значения для когда строка = номер столбца, т.е. (1,1), (2,2) и (3,3) значения.

Кто-нибудь может помочь с этим?

1 Ответ

0 голосов
/ 29 марта 2019

Для заполнения Matrix(1, 1), Matrix(2, 2) и Matrix(3, 3) с использованием Matrix(i, i)

необходим только один цикл, который отсчитывается от i = 1 to 3 
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
...