从 lme4 中的 VarCorr 对象中提取名称并将其粘贴为列名

Question

下面我想知道是否有办法从vc1 和vc2 中提取列Name 和Groups，并将它们分别粘贴为对象AA、BB 的列名。

例如，对于MODEL 1（如下），我预期的AA 输出将是：

                    plate_(Intercept) #: Name & Groups column from `vc1`
Standard deviation     1.54
Proportion of Variance 1.00
Cumulative Proportion  1.00

                   sample_(Intercept) #: Name & Groups column from `vc1`
Standard deviation     3.513
Proportion of Variance 1.000
Cumulative Proportion  1.000

这在 R 中可以实现吗（可能作为一个函数）？

library(lme4)

## MODEL 1:
fm1 <- lmer(diameter ~ 1 + (1|plate) + (1|sample), Penicillin)

(vc1 <- VarCorr(fm1))

AA <- summary(rePCA(fm1))

## MODEL 2:
fm2 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)

(vc2 <- VarCorr(fm2))

BB <- summary(rePCA(fm2))

Answer 1

rePCA 的 summary 生成一个列表。您可以遍历该列表的名称，从vc1/vc2 绘制（唯一）相关标签，并将这些标签分配为colnames。

请注意，rePCA 的每个元素内的数据框是通过$importance 属性访问的。

这可以包装成一个函数：

set_importance_colnames <- function(vc, pca_data) {
  for (name in names(pca_data)) {
    vc_df <- as.data.frame(vc)
    target <- vc_df[vc_df$grp == name, ]
    new_label <- unique(paste(target$grp, target$var1, sep = "_"))
    colnames(pca_data[[name]]$importance) <- new_label
  }
  return(pca_data)
}

AA 的输出：

set_importance_colnames(vc1, AA)

$plate
Importance of components:
                       plate_(Intercept)
Standard deviation                  1.54
Proportion of Variance              1.00
Cumulative Proportion               1.00

$sample
Importance of components:
                       sample_(Intercept)
Standard deviation                  3.513
Proportion of Variance              1.000
Cumulative Proportion               1.000

BB 的输出：

set_importance_colnames(vc2, BB)
$Subject
Importance of components:
                       Subject_(Intercept) Subject_Days
Standard deviation                  0.9669      0.23088
Proportion of Variance              0.9460      0.05395
Cumulative Proportion               0.9460      1.00000

Answer 2

我们可以写一个函数：

return_names <- function(obj, model) {

  Map(function(x, z) {
    colnames(x$importance) <- paste(z,unique(sapply(model, colnames)), sep = '_')
    x
  }, obj, names(obj))

}

return_names(AA, vc1)
#$plate
#Importance of components:
#                       plate_(Intercept)
#Standard deviation                  1.54
#Proportion of Variance              1.00
#Cumulative Proportion               1.00

#$sample
#Importance of components:
#                       sample_(Intercept)
#Standard deviation                  3.513
#Proportion of Variance              1.000
#Cumulative Proportion               1.000

return_names(BB, vc2)
#$Subject
#Importance of components:
#                       Subject_(Intercept) Subject_Days
#Standard deviation                  0.9669      0.23088
#Proportion of Variance              0.9460      0.05395
#Cumulative Proportion               0.9460      1.00000