方差 - 协方差矩阵:找到唯一变量*变量组合的协方差

时间:2018-05-31 14:48:47

标签: r matrix covariance variance

目标

使用此数据:

dat<-structure(list(study = c(1, 1, 2, 2, 3, 4, 4, 5, 5), nrate = c(1,                                                                1, 1, 2, 1, 1, 1, 1, 2), trt = c(1, 2, 1, 1, 1, 1, 2, 1, 2),                n2i = c(25, 25, 40, 40, 50, 30, 30, 20, 30), Ni = c(75, 75,                                                                    80, 80, 100, 90, 90, 40, 60), yi = structure(c(1.75557336268135,                                                                                                                   1.16269114535263, 2.25236533601502, 1.65098691534697, 1.93238812372334,                                                                                                                   2.80537854506277, 2.47373334918987, 1.36964712768673, 1.18135471573816                                                                   ), measure = "ROM", ni = c(50, 50, 80, 80, 100, 60, 60, 40,                                                                                               60)), vi = c(0.0972473617680551, 0.10417464101422, 0.0525739144226032,                                                                                                            0.0135660003587117, 0.036197209164285, 0.341666364303935,                                                                                                            0.342935708755073, 0.0303744729767536, 0.00416144452369287                                                                                              )), .Names = c("study", "nrate", "trt", "n2i", "Ni", "yi",                                                                                                              "vi"), row.names = c(NA, -9L), class = c("escalc", "data.frame"                                                                                                             ), yi.names = "yi", vi.names = "vi", digits = 4)
 dat<-data.frame(dat)

获得此方差 - 协方差矩阵:

      [,1]  [,2]  [,3]  [,4]  [,5]  [,6]  [,7] [,8]  [,9]
 [1,] 0.097 0.054 0.000 0.000 0.000 0.000 0.000 0.00 0.000
 [2,] 0.054 0.104 0.000 0.000 0.000 0.000 0.000 0.00 0.000
 [3,] 0.000 0.000 0.053 0.000 0.000 0.000 0.000 0.00 0.000
 [4,] 0.000 0.000 0.000 0.014 0.000 0.000 0.000 0.00 0.000
 [5,] 0.000 0.000 0.000 0.000 0.036 0.000 0.000 0.00 0.000
 [6,] 0.000 0.000 0.000 0.000 0.000 0.342 0.072 0.00 0.000
 [7,] 0.000 0.000 0.000 0.000 0.000 0.072 0.343 0.00 0.000
 [8,] 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.03 0.000
 [9,] 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.00 0.004

我想用function来计算&#34; yi&#34;&#34;之间的协方差。按照(&#34;学习&#34; *&#34; nrate&#34;)的等级离开&#34; vi&#34;差异我在对角线上独自一人:

 library(metafor) #bldiag comes from here
calc.v <- function(x) {
  v <- matrix(1/x$n2i[1] + outer(x$yi, x$yi, "*")/(2*x$Ni[1]), nrow=nrow(x), ncol=nrow(x))
  diag(v) <- x$vi
  v
}

将以下内容应用于数据会得到一个几乎存在*的var-cov矩阵,只要我只能将它应用于唯一的&#34;研究&#34; *&#34; nrate&#34;水平而非#34;研究&#34;等级并找回矩阵。

V <- bldiag(lapply(split(dat, dat[,c("study")]), calc.v))

问题

我试过了:

V <- bldiag(lapply(split(dat, dat[,c("study","nrate")]), calc.v))

V <- bldiag(lapply(unique(dat[,c("study","nrate")]), calc.v))

分别对Error in bldiag(lapply(split(dat, dat[, c("study", "nrate")]), calc.v)) : replacement has length zeroError in x$n2i : $ operator is invalid for atomic vectors函数提供错误bldiagcalc.v

脚注

*几乎有矩阵(与上面相比):

       [,1]  [,2]  [,3]  [,4]  [,5]  [,6]  [,7] [,8]  [,9]
 [1,] 0.097 0.054 0.000 0.000 0.000 0.000 0.000 0.00 0.000
 [2,] 0.054 0.104 0.000 0.000 0.000 0.000 0.000 0.00 0.000
 [3,] 0.000 0.000 0.053 0.048 0.000 0.000 0.000 0.00 0.000
 [4,] 0.000 0.000 0.048 0.014 0.000 0.000 0.000 0.00 0.000
 [5,] 0.000 0.000 0.000 0.000 0.036 0.000 0.000 0.00 0.000
 [6,] 0.000 0.000 0.000 0.000 0.000 0.342 0.072 0.00 0.000
 [7,] 0.000 0.000 0.000 0.000 0.000 0.072 0.343 0.00 0.000
 [8,] 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.03 0.070
 [9,] 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.07 0.004

显然,对于适合的模型,还有vcov功能,但我不知道这对我有什么帮助。

1 个答案:

答案 0 :(得分:1)

问题在于我们何时执行split,即使有0行的list元素,也会发生拆分的所有组合。要删除这些元素,我们需要使用drop = TRUE

library(metafor)
V <- bldiag(lapply(split(dat, dat[,c("study","nrate")], drop = TRUE), calc.v))
dim(V)
#[1] 9 9

round(V, 3)
#       [,1]  [,2]  [,3]  [,4]  [,5]  [,6] [,7]  [,8]  [,9]
# [1,] 0.097 0.054 0.000 0.000 0.000 0.000 0.00 0.000 0.000
# [2,] 0.054 0.104 0.000 0.000 0.000 0.000 0.00 0.000 0.000
# [3,] 0.000 0.000 0.053 0.000 0.000 0.000 0.00 0.000 0.000
# [4,] 0.000 0.000 0.000 0.036 0.000 0.000 0.00 0.000 0.000
# [5,] 0.000 0.000 0.000 0.000 0.342 0.072 0.00 0.000 0.000
# [6,] 0.000 0.000 0.000 0.000 0.072 0.343 0.00 0.000 0.000
# [7,] 0.000 0.000 0.000 0.000 0.000 0.000 0.03 0.000 0.000
# [8,] 0.000 0.000 0.000 0.000 0.000 0.000 0.00 0.014 0.000
# [9,] 0.000 0.000 0.000 0.000 0.000 0.000 0.00 0.000 0.004