【问题标题】：combine two plots into one plot in a mixed-model plot在混合模型图中将两个图合并为一个图
【发布时间】：2021-04-27 23:00:07
【问题描述】：

在我下面的图中，d_math 和 d_hyp 都是 {0,1} 变量。鉴于这一事实，在我下面的情节中，我想知道我们是否可以将这两个情节合二为一，就像在下面的 desired plot 中一样？

ps。我对任何 R 包都持开放态度。

multivariate <- read.csv('https://raw.githubusercontent.com/hkil/m/master/bv.csv')

library(nlme)
library(effects) # for plot

m2 <- lme(var ~ 0 + d_math + d_hyp + d_math:I(grade-2) + d_hyp:I(grade-2),
          random = ~ 0 + d_math + d_hyp + d_math:I(grade-2) + d_hyp:I(grade-2) | id, data = multivariate,
          na.action = na.omit, weights = varIdent(c(hyp=.3), form = ~1|grp),
          control = lmeControl(maxIter = 200, msMaxIter = 200, niterEM = 50,
                               msMaxEval = 400))

plot(allEffects(m2), multiline = TRUE, x.var="grade")

期望：

【问题讨论】：

标签： r regression lme4 mixed-models nlme

【解决方案1】：

我们可以使用tidyverse 创建一个单独的图。使用imap 循环allEffects 的list 输出，转换为tibble，select 所需的列，行将列表元素绑定到单个数据集（_dfr），unite 两列到一个单个，并使用ggplot 进行绘图

library(dplyr)
library(tidyr)
library(purrr)
library(ggplot2)
imap_dfr(allEffects(m2), ~ as_tibble(.x) %>% 
     mutate(dname = grep("d_", names(.), value = TRUE)) %>%
     select(dname, dvalue = starts_with('d_'), grade, fit) %>%
     mutate(grp = .y)) %>%
   unite(dname, dname, dvalue, sep=" = ") %>% 
   ggplot(aes(x = grade, y = fit, color = dname)) +
        geom_line() +
        theme_bw() #+
        # facet_wrap(~ grp)

-输出

如果我们想要行尾的标签，请使用directlabels

library(directlabels)
imap_dfr(allEffects(m2), ~ as_tibble(.x) %>% 
     mutate(dname = grep("d_", names(.), value = TRUE)) %>%
     select(dname, dvalue = starts_with('d_'), grade, fit) %>%
     mutate(grp = .y)) %>%
   unite(dname, dname, dvalue, sep=" = ") %>% 
   ggplot(aes(x = grade, y = fit, group = dname, color = dname)) +
        geom_line() +
        theme_bw() +
        scale_colour_discrete(guide = 'none') +
        geom_dl(aes(label = dname), method="last.qp", cex = 0.8)

此外，可以将每个“dvalue”作为facet 完成

imap_dfr(allEffects(m2), ~ as_tibble(.x) %>% 
     mutate(dname = grep("d_", names(.), value = TRUE)) %>%
     select(dname, dvalue = starts_with('d_'), grade, fit) %>%
     mutate(grp = .y)) %>%
   unite(dname, dname, dvalue, sep=" = ", remove = FALSE) %>% 
   ggplot(aes(x = grade, y = fit, group = dname, color = dname)) +
        geom_line() +
        theme_bw() +
        scale_colour_discrete(guide = 'none') +
        geom_dl(aes(label = dname), method="last.qp", cex = 0.8) + 
        facet_wrap(~ dvalue)

或者如果我们只需要一个特定的级别，那么filter

imap_dfr(allEffects(m2), ~ as_tibble(.x) %>% 
     mutate(dname = grep("d_", names(.), value = TRUE)) %>%
     select(dname, dvalue = starts_with('d_'), grade, fit) %>%
     mutate(grp = .y)) %>%
   unite(dname, dname, dvalue, sep=" = ") %>%
   filter(dname  %in% c("d_hyp = 1", "d_math = 1")) %>% 
   ggplot(., aes(x = grade, y = fit, colour = dname, group = dname)) + 
     geom_line() + 
     scale_colour_discrete(guide = 'none') +  
     geom_dl(aes(label = dname), method="last.qp", cex = 0.6) + 
     theme_bw()

【讨论】：

【解决方案2】：

您可以使用lattice 这样做，并且比@akrun 的方法更暴力：

e <- allEffects(m2)

f1 <- matrix(e[[1]]$fit, ncol=5) # math
f2 <- matrix(e[[2]]$fit, ncol=5) # hyp

dat = data.frame(
  fit = c(f1[5,], f2[5,]), 
  grade = rep(c(2,4,5,6,8), 2), 
  variable = factor(rep(1:2, each=5), 
                    labels=c("Math=1", "Hyp=1"))
  )


xyplot(fit ~ grade, data=dat, group=variable, type="l", 
       auto.key=list(space="top", lines=TRUE,points=FALSE))

【讨论】：