tidyverse_ggplot2_customize.Rmd

# ggplot2之扩展内容 {#tidyverse-ggplot2-customize}


ggplot2的强大，还在于它的扩展包。本章在介绍ggplot2新的内容的同时还会引入一些新的宏包，需要提前安装
```{r ggplot2-customize-1, eval=FALSE}
install.packages(c("sf", "cowplot", "patchwork", "gghighlight", "ggforce", "ggfx"))
```

如果安装不成功，请先update宏包，再执行上面安装命令

```{r ggplot2-customize-2, out.width = '70%', echo = FALSE}
knitr::include_graphics("images/update_packages.png")
```



```{r ggplot2-customize-3,warning = FALSE, message = FALSE}
library(tidyverse)
library(gghighlight)
library(cowplot)
library(patchwork)
library(ggforce)
library(ggridges)
```


## 你喜欢哪个图

```{r ggplot2-customize-4, out.width="100%"}
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)
```


## 定制

### 标签 

```{r ggplot2-customize-5}
gapdata <- read_csv("./demo_data/gapminder.csv")
gapdata
```


```{r ggplot2-customize-6}
gapdata %>%
  ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
  geom_point() +
  scale_x_log10() +
  ggtitle("My Plot Title") +
  xlab("The X Variable") +
  ylab("The Y Variable")
```



```{r ggplot2-customize-7}
gapdata %>%
  ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
  geom_point() +
  scale_x_log10() +
  labs(
    title = "My Plot Title",
    subtitle = "My Plot subtitle",
    x = "The X Variable",
    y = "The Y Variable"
  )
```





### 定制颜色

 我喜欢用这两个函数定制喜欢的绘图色彩，`scale_colour_manual()` 和 `scale_fill_manual()`. 更多方法可以参考 [Colours chapter in Cookbook for R](http://www.cookbook-r.com/Graphs/Colors_(ggplot2)/) 

```{r ggplot2-customize-8}
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`](https://cran.r-project.org/web/packages/cowplot/vignettes/introduction.html) 宏包的`plot_grid()`函数完成多张图片的组合，使用方法很简单。

```{r ggplot2-customize-9}
p1 <- gapdata %>%
  ggplot(aes(x = gdpPercap, y = lifeExp)) +
  geom_point(aes(color = lifeExp > 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 ggplot2-customize-10}
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 ggplot2-customize-11}
cowplot::plot_grid(
  p1,
  p2,
  labels = c("A", "B")
)
```


也可以使用patchwork宏包，更简单的方法
```{r ggplot2-customize-12}
library(patchwork)
p1 + p2
```


```{r ggplot2-customize-13}
p1 / p2
```


```{r ggplot2-customize-14}
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 ggplot2-customize-15, out.width = '100%'}
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 使用方法很简单，根本不需要记

```{r ggplot2-customize-16, out.width = '70%', echo = FALSE}
knitr::include_graphics("images/patchwork.png")
```





<!-- ### 保存图片 -->

<!-- 使用`ggsave()`函数，将图片保存为所需要的格式，如".pdf", ".png"等， 还可以指定图片的高度和宽度，默认`units`是英寸，也可以使用"cm", or "mm". -->

<!-- ```{r ggsave-example} -->
<!-- pp <- 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" -->
<!--   ) -->

<!-- # ggsave("demo_plot.pdf", plot = pp, width = 8, height = 6) -->
<!-- ``` -->





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


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


### ggplot2方法

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

```{r ggplot2-customize-18}
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 ggplot2-customize-19, fig.width= 8, fig.height= 8}
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宏包](<https://yutannihilation.github.io/gghighlight/articles/gghighlight.html>)

- dplyr has filter()
- ggplot has Highlighting

```{r ggplot2-customize-20}
gapdata %>% filter(country == "China")
```

```{r ggplot2-customize-21}
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 ggplot2-customize-22}
gapdata %>% filter(continent == "Asia")
```



```{r ggplot2-customize-23}
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 ggplot2-customize-231}
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 ggplot2-customize-24}
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 ggplot2-customize-25}
ggplot(data = data.frame(x = c(-3, 3)), aes(x = x)) +
  stat_function(fun = dnorm)
```


当然我们也可以绘制自定义函数
```{r ggplot2-customize-26}
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 ggplot2-customize-27}
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 emo::ji("park")`]{style="font-size: 3em;"}地图和公园里松鼠[`r emo::ji("squirrel")`]{style="font-size: 4em;"}数量的数据集

```{r ggplot2-customize-28}
nyc_squirrels <- read_csv("./demo_data/nyc_squirrels.csv")
central_park <- sf::read_sf("./demo_data/central_park")
```


先来一个地图，

```{r ggplot2-customize-29}
ggplot() +
  geom_sf(data = central_park)
```

一个`geom_sf`就搞定了`r emo::ji("celebrate")`，貌似没那么难呢？ 好吧，换个姿势，在地图上标注松鼠出现的位置



```{r ggplot2-customize-30}
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 ggplot2-customize-31, out.width = '100%'}
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 ggplot2-customize-32, out.width = '100%'}
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 ggplot2-customize-33}
# ggsave("Squirrels.pdf", width = 9, height = 6)
```


当然，也可以用`gghighlight`的方法
```{r ggplot2-customize-34, out.width = '100%'}
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`](https://github.com/wch/extrafont) 导入`C:\Windows\Fonts\`的字体，然后选取

```{r eval=FALSE, echo=TRUE}
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)`宏包

<!-- ```{r, eval=funs} -->
<!-- library(ggplot2) -->
<!-- ggplot(data = mpg) +  -->
<!-- 	geom_point(mapping = aes(x = displ, y = hwy)) + -->
<!-- 	ggtitle("这是默认的龙泉驿字体") -->

<!-- ## maybe, 保存为pdf图，才能看到有效字体 -->
<!-- ggsave("showtext-example-0.pdf", width = 7, height = 4, dpi = 200)   -->
<!-- ``` -->





```{r ggplot2-customize-35, message=FALSE, warning=FALSE, include=FALSE}
library(ggplot2)
library(showtext)
showtext_auto()

font_families()
font_paths()
# font_files()

## Add fonts that are available on Windows(默认路径"C:\\Windows\\Fonts")
font_add("heiti", "simhei.ttf")
font_add("constan", "constan.ttf", italic = "constani.ttf")
font_add("kaishu", "simkai.ttf")
# font_add("Noto", "NotoSansCJKsc-Regular.otf")
font_add("Yahei", "Yahei.ttf")

# 也可放在指定的目录(尽量英文)
# https://github.com/yixuan/showtext/issues/18
font_add("fzfsj", here::here("myfont", "fzfsj.ttf"))
font_add("fzxbsj", here::here("myfont", "FZXBSJW.ttf"))
font_add("maoti", here::here("myfont", "maoti.ttf"))
font_add("fzshuliu", here::here("myfont", "fzshuliu.ttf"))
font_families()

## maybe, 保存为pdf图，才能看到有效字体
ggplot(data = mpg) +
  geom_point(mapping = aes(x = displ, y = hwy)) +
  ggtitle("这是我的小标宋简体") +
  theme(
    plot.title = element_text(family = "fzxbsj")
  ) +
  geom_text(aes(x = 5, y = 40),
    label = "方正仿宋简体",
    family = "fzfsj"
  ) +
  geom_text(aes(x = 5, y = 38),
    label = "这是我的雅黑",
    family = "Yahei"
  ) +
  geom_text(aes(x = 5, y = 35),
    label = "方正楷书简体",
    family = "kaishu"
  ) +
  geom_text(aes(x = 5, y = 30),
    label = "草檀斋毛泽东字体",
    family = "maoti"
  ) +
  geom_text(aes(x = 5, y = 28),
    label = "方正苏新诗柳楷简体",
    family = "fzshuliu"
  )


# ggsave("showtext-example-9.pdf", width = 7, height = 4, dpi = 200)

showtext_auto(FALSE)
```


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

````markdown
`r ''````{r, fig.showtext=TRUE}
````

详细资料可参考[这里](https://bookdown.org/yihui/rmarkdown/r-code.html)




## latex公式

```{r ggplot2-customize-36, message=FALSE, warning=FALSE}
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$")
  )
```




## 练习

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

```{r ggplot2-customize-37, out.width = '80%', echo = FALSE}
knitr::include_graphics("images/flatten_curve_CDC.jpg")
```



```{r ggplot2-customize-38, eval=FALSE, include=FALSE}
# way one, simulate data

library(tidyverse)

high <- rnorm(1e5, mean = 12, sd = 4)
flat <- rnorm(1e5, mean = 35, sd = 12)

df <- tibble(
  dist = c(rep("high", 1e5), rep("flat", 1e5)),
     x = c(high, flat)
)


df %>% 
	ggplot(aes(x = x, color = dist)) +
	geom_density() +
	scale_y_continuous(expand = expansion(mult = c(0, NA))) +
	scale_color_manual(
		name = "distribution",
		values = c("high" = "tomato", "flat" = "dodgerblue"),
		labels = c("high" = "distribution1", "flat" = "distribution2")
		) +
	theme_minimal() +
	labs(x = "Days since the first case",
		 title = "Slow Down the Spread of COVID-19",
		 subtitle = "Practicing Social distancing can slow the spread of disease, which can prevent the overcrowding of hospitals")




# way two, using ggplot2::stat_function()
ggplot() +
  stat_function(fun = dnorm, 
                args = list(mean = 12, sd = 4), 
                color = "red"
                ) +
  
  stat_function(fun = dnorm, 
                args = list(mean = 35, sd = 12),
                color = "dodgerblue"
                ) +
  xlim(-5, 90)

```




```{r ggplot2-customize-39, echo = F}
# 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 ggplot2-customize-40, echo = F, message = F, warning = F, results = "hide"}
pacman::p_unload(pacman::p_loaded(), character.only = TRUE)
```