复制混合模型的晶格图

时间:2019-01-31 14:02:02

标签: r ggplot2 lattice mixed-models

我正在尝试使用ggplot2为混合模型复制晶格图。我的ggplot图表看起来非常相似,但是我不确定关于黄土线模型的拟合。

我的目标是使用ggplot2从混合模型中添加一条黄土线。以下是我的命令示例:

library(nlme)
library(ggplot2)
library(lattice)
library(lme4)

data(MathAchieve)
attach(MathAchieve)
mses <- tapply(SES, School, mean) 
mses[as.character(MathAchSchool$School[1:10])] 

Bryk <- as.data.frame(MathAchieve[, c("School", "SES", "MathAch")])

names(Bryk) <- c("school", "ses", "mathach")
sample20 <- sort(sample(7185, 20)) # 20 randomly sampled students

Bryk$meanses <- mses[as.character(Bryk$school)]

Bryk$cses <- Bryk$ses - Bryk$meanses
sector <- MathAchSchool$Sector
names(sector) <- row.names(MathAchSchool)
Bryk$sector <- sector[as.character(Bryk$school)]

attach(Bryk)

cat <- sample(unique(school[sector=="Catholic"]), 20)
Cat.20 <- groupedData(mathach ~ ses | school,  data=Bryk[is.element(school, cat),])

带有格子的图形:

Graph with Lattice

trellis.device(color=T)
xyplot(mathach ~ ses | school, data=Cat.20, main="Catholic", 
       panel=function(x, y) {
         panel.loess(x, y, span=1) 
         panel.xyplot(x, y)
         panel.lmline(x, y, lty=2)
       })

具有ggplot的图形:

Graph with ggplot

ggplot(Cat.20, aes(x = ses, y =mathach )) + 
  geom_point(size=1, shape=1) + 
  stat_smooth(method="lm",se=F)+
  stat_smooth(, colour="Red",se=F)+
  facet_wrap(school~., scale = "free_y")  

请提供任何建议。

1 个答案:

答案 0 :(得分:1)

序言

在进行解释之前,请允许我向您介绍这个问题:Why is it not advisable to use attach() in R, and what should I use instead?

虽然建议您使问题可重复,但您使用的代码可以进行一些清理。例如:

  1. 不包括代码中未使用的程序包(我认为不需要lme4程序包);
  2. 无需使用data(...)来加载MathAchieve。有关更多详细信息,请参见?data中的“良好做法”部分。
  3. 如上所述,请勿使用attach()
  4. 要获得完全的可重复性,请在进行随机抽样之前使用set.seed()
  5. 举一个最小的例子,当数量较小时,不要绘制20所学校。

由于您使用的是tidyverse软件包中的一个进行绘图,因此我建议从其集合中选择另一个进行数据处理:

library(nlme)
library(ggplot2)
library(lattice)
library(dplyr)

Bryk <- MathAchieve %>%
  select(School, SES, MathAch) %>%
  group_by(School) %>%
  mutate(meanses = mean(SES),
         cses = SES - meanses) %>%
  ungroup() %>%
  left_join(MathAchSchool %>% select(School, Sector),
            by = "School")
colnames(Bryk) <- tolower(colnames(Bryk))

set.seed(123)
cat <- sample(unique(Bryk$school[Bryk$sector == "Catholic"]), 2)
Cat.2 <- groupedData(mathach ~ ses | school,
                     data = Bryk %>% filter(school %in% cat))

说明

现在这已经不合时宜了,让我们来看一下loess的相关功能:

来自?panel.loess

panel.loess(x, y, span = 2/3, degree = 1,
            family = c("symmetric", "gaussian"),
            ... # omitted for space
            )

来自?stat_smooth

stat_smooth(mapping = NULL, data = NULL, geom = "smooth",
  method = "auto", formula = y ~ x, span = 0.75, method.args = list(), 
  ... # omitted for space
  )

对于{1000个观察值,method = "auto"包中的loess默认为stats

来自?loess

loess(formula, data, span = 0.75, degree = 2,
      family = c("gaussian", "symmetric"),
      ... #omitted for space
      )

简而言之,黄土地积的默认参数对于span = 2/3, degree = 1, family = "symmetric"软件包是lattice,对于span = 0.75, degree = 2, family = "gaussian"软件包是ggplot2如果要使结果图匹配,则必须指定匹配参数

xyplot(mathach ~ ses | school, data = Cat.2, main = "Catholic", 
       panel=function(x, y) {
         panel.loess(x, y, span=1, col = "red")  # match ggplot's colours
         panel.xyplot(x, y, col = "black")       # to facilitate comparison
         panel.lmline(x, y, lty=2, col = "blue")
       })

ggplot(Cat.2, aes(x = ses, y = mathach)) + 
  geom_point(size = 2, shape = 1) +
  stat_smooth(method = "lm", se = F)+
  stat_smooth(span = 1,
              method.args = list(degree = 1, family = "symmetric"),
              colour = "red", se = F)+
  facet_wrap(school ~ .) +
  theme_classic() # less cluttered background to facilitate comparison

lattice result

ggplot2 result