ggplot2:每个方面有几个图

时间:2017-08-22 15:49:55

标签: r ggplot2 facet

我想使用ggplot2和facets制作图片中的情节。与往常一样,有分组数据,每个组都映射到facet。棘手的部分是我希望单面由三个独立的图(不是图层)组成:回归线,残差,QQ图。

link to picture

用downvote战来放松一下。这是代码

library(dplyr)
library(broom)
library(tibble)
library(tidyr)
library(purrr)
library(ggplot2)

iris %>% 
group_by(Species) %>% 
nest %>%
mutate(mod = map(data, ~lm(Sepal.Length ~ Sepal.Width, .))) %>%
mutate(
    tidy = map(mod, broom::tidy),
    glance = map(mod, broom::glance),
    augment = map(mod, broom::augment)
) -> models

df <- models %>% select(Species, augment) %>% unnest

df %>% print

ggplot() +
geom_count(data=df, aes(x=Sepal.Width, y=Sepal.Length, colour = Species), alpha=0.7) +
geom_point(data=df, aes(x=Sepal.Width, y=.fitted), alpha=0.7, color="black", shape='x', size=5) +
geom_point(data=df, aes(x=Sepal.Width, y=.resid, colour=Species), alpha=0.2) +
stat_qq(data=df, aes(sample=.resid, colour=Species), distribution=qnorm, alpha=0.2) +
facet_wrap(~Species, scales = "free") +
theme(legend.position = "bottom", 
      legend.direction = "vertical")

结果情节:enter image description here

正如您所看到的,每个方面的图都重叠。伤心!与此同时,我想要“复杂”的方面,每个方面包含三个独立的情节。

1 个答案:

答案 0 :(得分:1)

由于每个情节中的信息类型如此不同,您需要制作三个图并将它们绑定在一起。

library(ggplot2)
library(broom)
library(purrr)
library(gridExtra)

iris.lm <- lm(Sepal.Width ~ Sepal.Length*Species, iris)

p1 <- ggplot(augment(iris.lm), aes(Sepal.Length, Sepal.Width, color = Species)) + 
  theme_classic() + guides(color = F) + 
  labs(title = "Regression") +
  theme(strip.background = element_blank(), strip.text = element_blank(),
        panel.background = element_rect(color = "black")) +
  stat_smooth(method = "lm", colour = "black") + geom_point(shape = 1) +
  facet_grid(Species~.)

p2 <- ggplot(augment(iris.lm), aes(.fitted, .resid, color = Species)) + 
  theme_classic() + guides(color = F) +
  labs(x = "Fitted values", y = "Residuals") +
  theme(strip.background = element_blank(), strip.text = element_blank(),
        panel.background = element_rect(color = "black")) +
  stat_smooth(se = F, span = 1, colour = "black") + geom_point(shape = 1) +
  facet_grid(Species~.)

p3 <- ggplot(augment(iris.lm), aes(sample = .resid/.sigma, color = Species)) + 
  theme_classic() + theme(panel.background = element_rect(color = "black")) +
  labs(x = "Theoretical quantiles", y = "Standardized residuals", title = "Q-Q") +
  geom_abline(slope = 1, intercept = 0, color = "black") +
  stat_qq(distribution = qnorm, shape = 1) + 
  facet_grid(Species~.)

p <- list(p1, p2, p3) %>% purrr::map(~ggplot_gtable(ggplot_build(.)))

cbind.gtable(p[[1]], p[[2]], p[[3]]) %>% grid.arrange()

enter image description here

为了展示围绕数据进行争论的所有内容,只需一次ggplot调用就可以了,这里是另一个问题。这是一个较差的解决方案,因为您必须使用修改后的数据调用geom_blank以获得绘图类型中的统一比例,并且您无法正确标记其轴的绘图。

enter image description here

library(dplyr)
library(broom)
library(tidyr)
library(ggplot2)


iris.lm <- lm(Sepal.Width ~ Sepal.Length*Species, iris)

data_frame(type = factor(c("Regression", "F vs R", "Q-Q"), 
                         levels = c("Regression", "F vs R", "Q-Q"))) %>% 
  group_by(type) %>% 
  do(augment(iris.lm)) %>% 
  group_by(Species) %>% 
  mutate(yval = case_when(
    type == "Regression" ~ Sepal.Width,
    type == "F vs R" ~ .resid,
    type == "Q-Q" ~ .resid/.sigma
                         ),
         xval = case_when(
    type == "Regression" ~ Sepal.Length,
    type == "F vs R" ~ .fitted,
    type == "Q-Q" ~ qnorm(ppoints(length(.resid)))[order(order(.resid/.sigma))]
                         ),
    yval.sm = case_when(
      type == "Regression" ~ .fitted,
      type == "F vs R" ~ loess(.resid ~ .fitted, span = 1)$fitted,
      type == "Q-Q" ~ xval
    )) %>% {
  ggplot(data = ., aes(xval, yval, color = Species)) + geom_point() + 
  facet_wrap(~interaction(type, Species, sep = ": "), scales = "free") + 
  geom_line(aes(xval, yval.sm), colour = "black") + 
  geom_blank(data = . %>% ungroup() %>% select(-Species) %>% 
               mutate(Species = iris %>% select(Species) %>% distinct()) %>%
               unnest(), 
             aes(xval, yval)) +
  labs(x = "Sepal.Length: actual values, fitted values, theoretical quantiles",
       y = "Sepal.Width: actual values, residuals, standardized residuals")}