Реплицирующий решеточный граф для смешанной модели

Question

Я пытаюсь скопировать решеточный граф, используя 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),])

График с решеткой:

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:

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")  

Пожалуйста, любые советы будут оценены.

Answer 1

Преамбула

Прежде чем углубляться в объяснение, позвольте мне отослать вас к этому вопросу: Почему не рекомендуется использовать метод attach () в R, и что следует делатьЯ использую вместо этого?

Хотя рекомендуется сделать ваш вопрос воспроизводимым, код, который вы использовали, можно сделать с некоторой очисткой.Например:

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
  )

, где method = "auto" по умолчанию loess от *Пакет 1051 * для <1000 наблюдений. </p>

из ?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