Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/68.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R Can';当特征值非常小时,不能得到正定方差矩阵_R_Matrix_Eigenvalue_Statistics - Fatal编程技术网

R Can';当特征值非常小时,不能得到正定方差矩阵

R Can';当特征值非常小时,不能得到正定方差矩阵,r,matrix,eigenvalue,statistics,R,Matrix,Eigenvalue,Statistics,要运行规范对应分析(cca包ade4),我需要一个正定方差矩阵。(理论上一直如此) 但是: 最后一个特征值为-1.377693e-09,即=0*** truncate_singular_values <- function(a, minimum = 0) { s <- svd(a) s$u %*% diag( ifelse( s$d > minimum, s$d, minimum ) ) %*% t(s$v) } svd(a)$d # [1] 1.916001e+04

要运行规范对应分析(cca包ade4),我需要一个正定方差矩阵。(理论上一直如此) 但是:

最后一个特征值为-1.377693e-09,即<0。但理论值大于0。
如果本征值之一小于0,则无法运行该函数

我真的不知道如何在不更改函数cca()的代码的情况下修复此问题


感谢您的帮助

您可以稍微更改输入,使矩阵正定

如果有方差矩阵,可以截断特征值:

correct_variance <- function(V, minimum_eigenvalue = 0) {
  V <- ( V + t(V) ) / 2
  e <- eigen(V)
  e$vectors %*% diag(pmax(minimum_eigenvalue,e$values)) %*% t(e$vectors)
}
v <- correct_variance( var(a) )
eigen(v)$values
# [1] 6.380066e+07 1.973658e+02 3.551492e+01 1.033096e+01 1.326768e-08
但是,这会将矩阵
a
最多更改
0.1
,这是一个很大的变化 (我怀疑它这么高是因为矩阵
a
是正方形的:因此,
var(a)
的特征值之一正好为0。)


b这里有两种方法:

V <- var(a)

# 1
library(Matrix)
nearPD(V)$mat

# 2 perturb diagonals
eps <- 0.01
V + eps * diag(ncol(V))

实际上,理论值总是>=0***
truncate_singular_values <- function(a, minimum = 0) { 
  s <- svd(a)
  s$u %*% diag( ifelse( s$d > minimum, s$d, minimum ) ) %*% t(s$v)
}
svd(a)$d
# [1] 1.916001e+04 4.435562e+01 1.196984e+01 8.822299e+00 1.035624e-01
eigen(var( truncate_singular_values(a,.2) ))$values
# [1] 6.380066e+07 1.973680e+02 3.551494e+01 1.033452e+01 6.079487e-09
b <- truncate_singular_values(a,.2)
max( abs(b-a) )
# [1] 0.09410187
b <- a + 1e-6*runif(length(a),-1,1)  # Repeat if needed
eigen(var(b))$values
# [1] 6.380066e+07 1.973658e+02 3.551492e+01 1.033096e+01 2.492604e-09
V <- var(a)

# 1
library(Matrix)
nearPD(V)$mat

# 2 perturb diagonals
eps <- 0.01
V + eps * diag(ncol(V))