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

Extracting names from a VarCorr object in lme4 and pasting it as column names

下面我想知道是否有办法从 vc1vc2 中提取列 NameGroups 并将它们分别粘贴为列名对于对象 AABB.

例如,对于 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))

rePCAsummary 生成一个列表。您可以遍历该列表的名称,从 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

我们可以写一个函数:

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