ggplot2 定制 — 数据科学中的 R 语言

你喜欢哪个图

R

p1 <- ggplot(mpg, aes(x = cty, y = hwy)) +
  geom_point() +
  geom_smooth() +
  labs(title = "1: geom_point() + geom_smooth()") +
  theme(plot.title = element_text(face = "bold"))

p2 <- ggplot(mpg, aes(x = cty, y = hwy)) +
  geom_hex() +
  labs(title = "2: geom_hex()") +
  guides(fill = FALSE) +
  theme(plot.title = element_text(face = "bold"))

p3 <- ggplot(mpg, aes(x = drv, fill = drv)) +
  geom_bar() +
  labs(title = "3: geom_bar()") +
  guides(fill = FALSE) +
  theme(plot.title = element_text(face = "bold"))

p4 <- ggplot(mpg, aes(x = cty)) +
  geom_histogram(binwidth = 2, color = "white") +
  labs(title = "4: geom_histogram()") +
  theme(plot.title = element_text(face = "bold"))

p5 <- ggplot(mpg, aes(x = cty, y = drv, fill = drv)) +
  geom_violin() +
  guides(fill = FALSE) +
  labs(title = "5: geom_violin()") +
  theme(plot.title = element_text(face = "bold"))

p6 <- ggplot(mpg, aes(x = cty, y = drv, fill = drv)) +
  geom_boxplot() +
  guides(fill = FALSE) +
  labs(title = "6: geom_boxplot()") +
  theme(plot.title = element_text(face = "bold"))

p7 <- ggplot(mpg, aes(x = cty, fill = drv)) +
  geom_density(alpha = 0.7) +
  guides(fill = FALSE) +
  labs(title = "7: geom_density()") +
  theme(plot.title = element_text(face = "bold"))

p8 <- ggplot(mpg, aes(x = cty, y = drv, fill = drv)) +
  geom_density_ridges() +
  guides(fill = FALSE) +
  labs(title = "8: ggridges::geom_density_ridges()") +
  theme(plot.title = element_text(face = "bold"))

p9 <- ggplot(mpg, aes(x = cty, y = hwy)) +
  geom_density_2d() +
  labs(title = "9: geom_density_2d()") +
  theme(plot.title = element_text(face = "bold"))

p1 + p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9 +
  plot_layout(nrow = 3)

定制

定制颜色

我喜欢用这两个函数定制喜欢的绘图色彩，scale_colour_manual() 和 scale_fill_manual(). 更多方法可以参考 Colours chapter in Cookbook for R/)

R

gapdata %>%
  ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
  geom_point() +
  scale_x_log10() +
  scale_color_manual(
    values = c("#195744", "#008148", "#C6C013", "#EF8A17", "#EF2917")
  )

组合图片

我们有时候想把多张图组合到一起

cowplot

可以使用 cowplot 宏包的plot_grid()函数完成多张图片的组合，使用方法很简单。

R

p1 <- gapdata %>%
  ggplot(aes(x = gdpPercap, y = lifeExp)) +
  geom_point(aes(color = lifeExp &gt; mean(lifeExp))) +
  scale_x_log10() +
  theme(legend.position = "none") +
  scale_color_manual(values = c("orange", "pink")) +
  labs(
    title = "My Plot Title",
    x = "The X Variable",
    y = "The Y Variable"
  )

R

p2 <- gapdata %>%
  ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
  geom_point() +
  scale_x_log10() +
  scale_color_manual(
    values = c("#195744", "#008148", "#C6C013", "#EF8A17", "#EF2917")
  ) +
  theme(legend.position = "none") +
  labs(
    title = "My Plot Title",
    x = "The X Variable",
    y = "The Y Variable"
  )

R

cowplot::plot_grid(
  p1,
  p2,
  labels = c("A", "B")
)

也可以使用patchwork宏包，更简单的方法

R

library(patchwork)
p1 + p2

R

p1 / p2

R

p1 + p2 +
  plot_annotation(
    tag_levels = "A",
    title = "The surprising truth about mtcars",
    subtitle = "These 3 plots will reveal yet-untold secrets about our beloved data-set",
    caption = "Disclaimer: None of these plots are insightful"
  )

再来一个

R

library(palmerpenguins)

g1 <- penguins %>% 
  ggplot(aes(bill_length_mm, body_mass_g, color = species)) +
  geom_point() + 
  theme_bw(base_size = 14) +
  labs(tag = "(A)", x = "Bill length (mm)", y = "Body mass (g)", color = "Species")
       
g2 <- penguins %>% 
  ggplot(aes(bill_length_mm, bill_depth_mm, color = species)) +
  geom_point() + 
  theme_bw(base_size = 14) +
  labs(tag = "(B)", x = "Bill length (mm)", y = "Bill depth (mm)",  color = "Species")
         
g1 + g2 + patchwork::plot_layout(guides = "collect")

patchwork 使用方法很简单，根本不需要记

高亮某一组

画图很容易，然而画一张好图，不容易。图片质量好不好，其原则就是不增加看图者的心智负担，有些图片的色彩很丰富，然而需要看图人配合文字和图注等信息才能看懂作者想表达的意思，这样就失去了图片“一图胜千言”的价值。

分析数据过程中，我们可以使用高亮我们某组数据，突出我们想表达的信息，是非常好的一种可视化探索手段。

ggplot2方法

这种方法是将背景部分和高亮部分分两步来画

R

drop_facet <- function(x) select(x, -continent)

gapdata %>%
  ggplot() +
  geom_line(
    data = drop_facet,
    aes(x = year, y = lifeExp, group = country), color = "grey",
  ) +
  geom_line(aes(x = year, y = lifeExp, color = country, group = country)) +
  facet_wrap(vars(continent)) +
  theme(legend.position = "none")

再来一个

R

gapdata %>%
  mutate(group = country) %>%
  filter(continent == "Asia") %>%
  ggplot() +
  geom_line(
    data = function(d) select(d, -country),
    aes(x = year, y = lifeExp, group = group), color = "grey",
  ) +
  geom_line(aes(x = year, y = lifeExp, group = country), color = "red") +
  facet_wrap(vars(country)) +
  theme(legend.position = "none")

gghighlight方法

这里推荐gghighlight宏包

dplyr has filter()
ggplot has Highlighting

R

gapdata %>% filter(country == "China")

R

gapdata %>%
  ggplot(
    aes(x = year, y = lifeExp, color = continent, group = country)
  ) +
  geom_line() +
  gghighlight(
    country == "China", # which is passed to dplyr::filter().
    label_key = country
  )

R

gapdata %>% filter(continent == "Asia")

R

gapdata %>%
  filter(continent == "Asia") %>%
  ggplot(aes(year, lifeExp, color = country, group = country)) +
  geom_line(size = 1.2, alpha = .9, color = "#E58C23") +
  theme_minimal(base_size = 14) +
  theme(
    legend.position = "none",
    panel.grid.major.x = element_blank(),
    panel.grid.minor = element_blank()
  ) +
  gghighlight(
    country %in% c("China", "India", "Japan", "Korea, Rep."),
    use_group_by = FALSE,
    use_direct_label = FALSE,
    unhighlighted_params = list(color = "grey90")
  ) +
  facet_wrap(vars(country))

3D效果

R

library(ggfx) 
# https://github.com/thomasp85/ggfx

mtcars %>% 
  ggplot(aes(mpg, disp)) +
  with_shadow(
    geom_smooth(alpha = 1), sigma = 4 
  ) +
  with_shadow(
    geom_point(), sigma = 4
  )

弯曲文本

弯曲文本，使其匹配多种图形的轨迹。

R

library(geomtextpath) # remotes::install_github("AllanCameron/geomtextpath")

R

iris %>% 
  ggplot(aes(x = Sepal.Length, colour = Species, label = Species)) +
  geom_textdensity(size = 6, fontface = 2, hjust = 0.2, vjust = 0.3) +
  theme(legend.position = "none")

R

library(palmerpenguins)
penguins %>% 
  ggplot(aes(x = bill_length_mm, y = bill_depth_mm, color = species)) +
  geom_point(alpha = 0.3) +
  geom_labelsmooth(aes(label = species), method = "loess", size = 5, linewidth = 1) +
  scale_colour_manual(values = c("forestgreen", "deepskyblue4", "tomato4")) +
  theme(legend.position = "none")

更多风格可参见https://github.com/AllanCameron/geomtextpath

函数图

有时候我们想画一个函数图，比如正态分布的函数，可能会想到先产生数据，然后画图，比如下面的代码

R

tibble(x = seq(from = -3, to = 3, by = .01)) %>%
  mutate(y = dnorm(x, mean = 0, sd = 1)) %>%
  ggplot(aes(x = x, y = y)) +
  geom_line(color = "grey33")

事实上，stat_function()可以简化这个过程

R

ggplot(data = data.frame(x = c(-3, 3)), aes(x = x)) +
  stat_function(fun = dnorm)

当然我们也可以绘制自定义函数

R

myfun <- function(x) {
  (x - 1)**2
}

ggplot(data = data.frame(x = c(-1, 3)), aes(x = x)) +
  stat_function(fun = myfun, geom = "line", colour = "red")

下面这是一个很不错的例子，细细体会下

R

d <- tibble(x = rnorm(2000, mean = 2, sd = 4))

ggplot(data = d, aes(x = x)) +
  geom_histogram(aes(y = after_stat(density))) +
  geom_density() +
  stat_function(fun = dnorm, args = list(mean = 2, sd = 4), colour = "red")

地图

💡

小时候画地图很容易，长大了画地图却不容易了。

这是一个公园[[R表达式]]{style="font-size: 3em;"}地图和公园里松鼠[[R表达式]]{style="font-size: 4em;"}数量的数据集

R

nyc_squirrels <- read_csv("./demo_data/nyc_squirrels.csv")
central_park <- sf::read_sf("./demo_data/central_park")

先来一个地图，

R

ggplot() +
  geom_sf(data = central_park)

一个geom_sf就搞定了[R表达式]，貌似没那么难呢？好吧，换个姿势，在地图上标注松鼠出现的位置

R

nyc_squirrels %>%
  drop_na(primary_fur_color) %>%
  ggplot() +
  geom_sf(data = central_park, color = "grey85") +
  geom_point(
    aes(x = long, y = lat, color = primary_fur_color),
    size = .8
  )

分开画呢

R

nyc_squirrels %>%
  drop_na(primary_fur_color) %>%
  ggplot() +
  geom_sf(data = central_park, color = "grey85") +
  geom_point(
    aes(x = long, y = lat, color = primary_fur_color),
    size = .8
  ) +
  facet_wrap(vars(primary_fur_color)) +
  theme(legend.position = "none")

R

label_colors <-
  c("all squirrels" = "grey75", "highlighted group" = "#0072B2")

nyc_squirrels %>%
  drop_na(primary_fur_color) %>%
  ggplot() +
  geom_sf(data = central_park, color = "grey85") +
  geom_point(
    data = function(x) select(x, -primary_fur_color),
    aes(x = long, y = lat, color = "all squirrels"),
    size = .8
  ) +
  geom_point(
    aes(x = long, y = lat, color = "highlighted group"),
    size = .8
  ) +
  cowplot::theme_map(16) +
  theme(
    legend.position = "bottom",
    legend.justification = "center"
  ) +
  facet_wrap(vars(primary_fur_color)) +
  scale_color_manual(name = NULL, values = label_colors) +
  guides(color = guide_legend(override.aes = list(size = 2)))

R

# ggsave("Squirrels.pdf", width = 9, height = 6)

当然，也可以用gghighlight的方法

R

nyc_squirrels %>%
  drop_na(primary_fur_color) %>%
  ggplot() +
  geom_sf(data = central_park, color = "grey85") +
  geom_point(
    aes(x = long, y = lat, color = primary_fur_color),
    size = .8
  ) +
  gghighlight(
    label_key = primary_fur_color,
    use_direct_label = FALSE
  ) +
  facet_wrap(vars(primary_fur_color)) +
  cowplot::theme_map(16) +
  theme(legend.position = "none")

字体

如果想使用不同的字体，可以用theme() 的 element_text() 函数

family: font family
face : bold, italic, bold.italic, plain
color, size, angle, etc.

其中，family = 字体名，可以用 extrafont 导入C:\Windows\Fonts\的字体，然后选取

R

library(extrafont)
font_import() # will take 2-3 minutes. Only need to run once
loadfonts()
fonts()
fonttable()

R

mpg %>% 
  ggplot() +
  geom_jitter(aes(x = cty, y = hwy, color = class)) +
  theme(text = element_text(family = "Peralta"))

中文字体

有时我们需要保存图片，图片有中文字符，就需要加载library(showtext)宏包

根据往年大家提交的作业，有同学用rmarkdown生成pdf，图片标题使用了中文字体，但中文字体无法显示。解决方案是R code chunks加上fig.showtext=TRUE

`MARKDOWN

`[R表达式]````{r, fig.showtext=TRUE}

详细资料可参考这里

latex公式

R

library(ggplot2)
library(latex2exp)

ggplot(mpg, aes(x = displ, y = hwy)) +
  geom_point() +
  annotate("text",
    x = 4, y = 40,
    label = TeX("$\\alpha^2 + \\theta^2 = \\omega^2 $"),
    size = 9
  ) +
  labs(
    title = TeX("The ratio of 1 and 2 is $\\,\\, \\frac{1}{2}$"),
    x = TeX("$\\alpha$"),
    y = TeX("$\\alpha^2$")
  )

"coord_cartesian() 与 scale_x_continuous()"

乍一看，这两个操作没有区别

R

p1 <- mtcars %>% 
  ggplot(aes(disp, wt)) +
  geom_point() +
  scale_x_continuous(limits = c(325, 500)) +
  ggtitle("scale_x_continuous(limits = c(325, 500))")

p2 <- mtcars %>% 
  ggplot(aes(disp, wt)) +
  geom_point() +
  coord_cartesian(xlim = c(325, 500)) +
  ggtitle("coord_cartesian(xlim = c(325, 500))")


p1 + p2

实际上这两个操作，区别蛮大的

R

p3 <- mtcars %>% 
  ggplot(aes(disp, wt)) +
  geom_point() +
  geom_smooth() +
  ggtitle("no limits setting") 

p4 <- mtcars %>% 
  ggplot(aes(disp, wt)) +
  geom_point() +
  geom_smooth() +
  scale_x_continuous(limits = c(325, 500)) +
  ggtitle("scale_x_continuous(limits = c(325, 500))")


p5 <- mtcars %>% 
  ggplot(aes(disp, wt)) +
  geom_point() +
  geom_smooth() +
  coord_cartesian(xlim = c(325, 500)) +
  ggtitle("coord_cartesian(xlim = c(325, 500))")



p3 + p4 + p5

解释：

scale_x_continuous(limits = c(325,500))

的骚操作，会把limits指定范围之外的点全部弄成NA, 也就说改变了原始数据，那么 geom_smooth() 会基于调整之后的数据做平滑曲线。

coord_cartesian(xlim = c(325,500))

操作，不会改变数据，只是拿了一个放大镜，重点显示xlim = c(325, 500)这个范围。

练习

重复这张压平曲线（flatten curve）图

R

# remove the objects
# rm(list=ls())
rm(central_park, d, drop_facet, gapdata, label_colors, myfun, nyc_squirrels, p1, p2, p3, p4, p5, p6, p7, p8, p9, pp, g1, g2, df)

R

pacman::p_unload(pacman::p_loaded(), character.only = TRUE)

你喜欢哪个图

定制

标签

定制颜色

组合图片

cowplot

高亮某一组

ggplot2方法

gghighlight方法

3D效果

弯曲文本

函数图

地图

字体

中文字体

latex公式

"coord_cartesian() 与 scale_x_continuous()"

练习