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

如何解决后续：从lme4中的VarCorr对象提取名称并将其粘贴为列名称

我正在跟踪this great answer。下面的函数foo接受Name输出的VarCorr(fit)列，并使其成为summary(rePCA(fit))调用的列名。

当我们输入fm1，fm2时，它工作正常，但我想知道为什么fm3失败了吗？有解决办法吗？

library(lme4) 
dat <- read.csv('https://raw.githubusercontent.com/rnorouzian/e/master/sng.csv')
fm1 <- lmer(diameter ~ 1 + (1|plate) + (1|sample),Penicillin) 
fm2 <- lmer(Reaction ~ Days + (Days | Subject),sleepstudy)
fm3 <- lmer(y ~ A * B * C + (A + B | group) + (C|group),data = dat)


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

#EXAMPLE OF USE:
foo(fm1) ###     OK !
foo(fm2) ###     OK !
foo(fm3) ###     :-( Error in dimnames(x) <- dn

解决方法

当obj和model的长度不同时，该函数将失败。这是一种使其适用于fm3的技巧。

foo <- function(fit) {
  
  obj <- summary(rePCA(fit))
  model <- VarCorr(fit)
  if(length(obj) == length(model)) {
   obj <- Map(function(x,z) {
    colnames(x$importance) <- paste(z,unique(sapply(model,colnames)),sep = '_')
    x
  },obj,names(obj))
  }
  else if(length(obj) == 1) {
    colnames(obj[[1]]$importance) <- unlist(mapply(paste,names(model),sapply(model,colnames),MoreArgs = list(sep = '_')))
  }
  return(obj)
}

这将返回以下输出：

foo(fm1) 

#$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.51
#Proportion of Variance               1.00
#Cumulative Proportion                1.00

foo(fm2) 
#$Subject
#Importance of components:
#                       Subject_(Intercept) Subject_Days
#Standard deviation                   0.967       0.2309
#Proportion of Variance               0.946       0.0539
#Cumulative Proportion                0.946       1.0000

foo(fm3) 
#$group
#Importance of components:
#                       group_(Intercept) group_A group_B group.1_(Intercept) group.1_C
#Standard deviation                 1.418   1.291  0.5129              0.4542 0.0000497
#Proportion of Variance             0.485   0.402  0.0634              0.0498 0.0000000
#Cumulative Proportion              0.485   0.887  0.9502              1.0000 1.0000000

,

您可以从“ fit @ cnms”获取列名，从而免除了使用“ VarCorr”的麻烦。 fm1似乎是魔鬼，它给出了列表输出，我们可能想强制as.data.frame。然后我们可以只使用`colnames<-`，而无需进行Map战斗。

foo2 <- function(fit) {
  obj <- summary(rePCA(fit))
  obj <- as.data.frame(lapply(obj,`[`,"importance"))
  `colnames<-`(obj,paste(names(fit@cnms),unlist(fit@cnms),sep="_"))
}

foo2(fm1)
#                        plate_(Intercept) sample_(Intercept)
# Standard deviation              1.539676           3.512519
# Proportion of Variance          1.000000           1.000000
# Cumulative Proportion           1.000000           1.000000

foo2(fm2)
#                        Subject_(Intercept) Subject_Days
# Standard deviation                0.966868    0.2308798
# Proportion of Variance            0.946050    0.0539500
# Cumulative Proportion             0.946050    1.0000000

foo2(fm3)
#                        group_(Intercept)  group_A   group_B group_(Intercept)    group_C
# Standard deviation              1.385987 1.322335 0.5128262         0.4547251 0.08892506
# Proportion of Variance          0.463190 0.421630 0.0634100         0.0498600 0.00191000
# Cumulative Proportion           0.463190 0.884820 0.9482300         0.9980900 1.00000000

我发现的另一个优势是数字没有四舍五入。您可以在函数中嵌入round或之后执行此操作：

round(foo2(fm1),2)
#                        plate_(Intercept) sample_(Intercept)
# Standard deviation                  1.54               3.51
# Proportion of Variance              1.00               1.00
# Cumulative Proportion               1.00               1.00