在混合模型图中将两个图合并为一个图
combine two plots into one plot in a mixed-model plot
在我下面的图中,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")
期望:
我们可以使用 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()
你可以用 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))
在我下面的图中,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")
期望:
我们可以使用 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()
你可以用 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))