论一张ggplot图是怎样炼成的 - 从小白都会画到逼格十足是如何一步步产生的？
首先声明一下，本文的代码和图片来自于：
https://cedricscherer.netlify.com/2019/05/17/the-evolution-of-a-ggplot-ep.-1/
而文中的数据可以从以下网址下载到：
https://gist.githubusercontent.com/maartenzam/787498bbc07ae06b637447dbd430ea0a/raw/9a9dafafb44d8990f85243a9c7ca349acd3a0d07/worldtilegrid.csv
这份数据呢，是各个国家学生-教师比例的数据，有x,y轴的信息，我们把它用tile画出来，就是下面这样子：
这个没有任何神秘可言，因为x,y轴信息都有了。直接画热图的形式画出来就是了，x在这里就是你的column, y就是你的row的信息，于是热图就出来了，x和y缺失的地方，画出来就是空白处。所以不要因为它长得异型（细心的你已经发现是个地图的形状），就不认得这和你经常画的表达谱的热图是一毛一样的。有x,y轴信息，干啥都容易，比如我用emoji拼出来一个苹果的logo，《你所没见过的苹果》。
这个数据没有大洲的信息，于是再找来一个大洲信息的数据框，稍做整合，成了这样子：
此处不是全数据，而是每个大洲打出两个数据
# # A tibble: 12 x 5
# indicator country region student_ratio student_ratio_re~
# <chr> <chr> <chr> <dbl> <dbl>
# 1 Primary Edu~ Djibouti Africa 29.4 37.3
# 2 Primary Edu~ Senegal Africa 32.8 37.3
# 3 Primary Edu~ Kazakhstan Asia 19.6 20.7
# 4 Primary Edu~ Timor-Leste Asia NA 20.7
# 5 Primary Edu~ The former Yugosl~ Europe 14.4 13.6
# 6 Primary Edu~ Austria Europe 10.0 13.6
# 7 Primary Edu~ Grenada North A~ 16.2 17.7
# 8 Primary Edu~ Saint Kitts and N~ North A~ 13.9 17.7
# 9 Primary Edu~ Papua New Guinea Oceania 35.5 24.7
# 10 Primary Edu~ New Zealand Oceania 14.9 24.7
# 11 Primary Edu~ Venezuela (Boliva~ South A~ NA 19.4
# 12 Primary Edu~ Colombia South A~ 23.6 19.4
这样子我们就可以通过不同国家的学生-教师比来比较一下不同大洲之间的教育水平了。
箱式图
显然这种数据，第一想到的就是箱式图，它可以总结出每个大洲的基本统计量。
library(tidyverse)
ggplot(df_ratios, aes(region, student_ratio)) +
geom_boxplot()
显然此处应该排个序，这样看着舒服一些，也容易解读和传达信息。我们看到过很多人用dotplot画富集分析，有些人喜欢自己用ggplot2去画，而不是使用clusterProfiler的dotplot函数，然而我见过太多别人自己画的，连排个序都不会，那些点散乱而信息不易捕捉。
df_sorted <- df_ratios %>%
mutate(region = fct_reorder(region, -student_ratio_region))
ggplot(df_sorted, aes(region, student_ratio)) +
geom_boxplot()
但为了更好地读boxplot的统计量，我们需要翻转一下坐标轴，再一点，数据起点从0开始是比较好的，这个可以通过设置y轴来实现。
ggplot(df_sorted, aes(region, student_ratio)) +
geom_boxplot() +
coord_flip() +
scale_y_continuous(limits = c(0, 90))
让我们的图美观一点吧！
这个无非是通过主题来设置，你可以基于一个自己比较喜欢的主题，然后再改点细节，比如此处使用的是theme_light，然后再改一点细节，包括改一下字体和大小，去掉网格线。另一点是改字体，你可以使用extrafont和showtext来加载字体。另外可参考《使用外部字体画meme》。
extrafont::loadfonts(device = "win")
theme_set(theme_light(base_size = 15, base_family = "Poppins"))
g <- ggplot(df_sorted, aes(region, student_ratio, color = region)) +
coord_flip() +
scale_y_continuous(limits = c(0, 90), expand = c(0.005, 0.005)) +
scale_color_uchicago() +
labs(x = NULL, y = "Student to teacher ratio") +
theme(legend.position = "none",
axis.title = element_text(size = 12),
axis.text.x = element_text(family = "Roboto Mono", size = 10),
panel.grid = element_blank())
试试不同的图层
上面改细节修图之后，就是一张发表级别的图了。如果你是用生物狗喜欢的那些作图软件，那么这可能就是终点了。但我们写代码的话，编程给我们探索的自由，我们可以把geom_boxplot给换成别的图层，出来依然是一张我们在上一步已经调好的美图（如果导师反复让你用不同的形式来出图，此处可省下无数脏活）。
点图因为很多点重叠了，我们可以设置透明度。
g + geom_point(size = 3, alpha = 0.15)
还可以来个组合拳。
g + geom_boxplot(color = "gray60", outlier.alpha = 0) +
geom_point(size = 3, alpha = 0.15)
这里boxplot的outlier就不用画了，因为那些点都已经被点图画出来了，再画会互相覆盖，这可以通过outlier.shape = NA或者outlier.alpha = 0，第二种，其实点是有画的，只不过你看不见啊，看不见。《什么！你的图上有一双看不见的手》这是一个非常好的策略。
然后我们可以让点抖动，抖动的大小可以通过width设置，而抖动是随机的，也就是说你每次跑出的图是不太一样的，为了让出图具有可重复性，我们可以通过set.seed来解决。
set.seed(123)
g + geom_jitter(size = 2, alpha = 0.25, width = 0.2)
更多信息，更有趣
首先我们可以自己给点图加统计量，比如均值、中位数等。
g +
geom_jitter(size = 2, alpha = 0.25, width = 0.2) +
stat_summary(fun.y = mean, geom = "point", size = 5)
我们还可以统计一下，世界的平均水平，在图上用直线标注出来，这样谁引领世界，谁又在拖后腿，也就比较清楚了。
world_avg <- df_ratios %>%
summarize(avg = mean(student_ratio, na.rm = T)) %>%
pull(avg)
g +
geom_hline(aes(yintercept = world_avg), color = "gray70", size = 0.6) +
stat_summary(fun.y = mean, geom = "point", size = 5) +
geom_jitter(size = 2, alpha = 0.25, width = 0.2)
然后我们可以把每个大洲的平均值和世界的平均值用线条连接起来，这样差距更容易看。
g +
geom_segment(aes(x = region, xend = region,
y = world_avg, yend = student_ratio_region),
size = 0.8) +
geom_hline(aes(yintercept = world_avg), color = "gray70", size = 0.6) +
geom_jitter(size = 2, alpha = 0.25, width = 0.2) +
stat_summary(fun.y = mean, geom = "point", size = 5)
加入文本注释
加一些注释的信息：
(g_text <- g +
geom_segment(aes(x = region, xend = region,
y = world_avg, yend = student_ratio_region),
size = 0.8) +
geom_hline(aes(yintercept = world_avg), color = "gray70", size = 0.6) +
stat_summary(fun.y = mean, geom = "point", size = 5) +
geom_jitter(size = 2, alpha = 0.25, width = 0.2) +
annotate("text", x = 6.3, y = 35, family = "Poppins", size = 2.7, color = "gray20",
label = glue::glue("Worldwide average:\n{round(world_avg, 1)} students per teacher")) +
annotate("text", x = 3.5, y = 10, family = "Poppins", size = 2.7, color = "gray20",
label = "Continental average") +
annotate("text", x = 1.7, y = 11, family = "Poppins", size = 2.7, color = "gray20",
label = "Countries per continent") +
annotate("text", x = 1.9, y = 64, family = "Poppins", size = 2.7, color = "gray20",
label = "The Central African Republic has by far\nthe most students per teacher"))
此处用了
glue::glue()去把变量插入到字符串中，你也可以用你的老朋友paste来做这个事情。
然后我们可以用geom_curve把一些弯的箭头来把文本指向图中的一些元素，让文本解说有针对性。
arrows <- tibble(
x1 = c(6.2, 3.5, 1.7, 1.7, 1.9),
x2 = c(5.6, 4, 1.9, 2.9, 1.1),
y1 = c(35, 10, 11, 11, 73),
y2 = c(world_avg, 19.4, 14.1, 12, 83.4)
)
g_text + geom_curve(data = arrows, aes(x = x1, y = y1, xend = x2, yend = y2),
arrow = arrow(length = unit(0.07, "inch")), size = 0.4,
color = "gray20", curvature = -0.3)
线条并不理想，这个时候，你需要不断调整，调整，调整，最后才能出一个好一点的图。
arrows <- tibble(
x1 = c(6, 3.65, 1.8, 1.8, 1.8),
x2 = c(5.6, 4, 2.07, 2.78, 1.08),
y1 = c(world_avg + 6, 10.5, 9, 9, 76),
y2 = c(world_avg + 0.1, 18.4, 14.48, 12, 83.41195)
)
(g_arrows <- g_text +
geom_curve(data = arrows, aes(x = x1, y = y1, xend = x2, yend = y2),
arrow = arrow(length = unit(0.08, "inch")), size = 0.5,
color = "gray20", curvature = -0.3))
这一块的代码就是我说的王八拳，请参考《王八拳编程及其它》，其实调整这一块，你完全可以交给PPT，这样搞得还快一点，请移步《我不会用illustrator，只会用ppt！》，其实不止是调整箭头这一块，打文本和加箭头，这个小节里所有东西，你都可以交给PPT。
最后，你可以加个Caption，说一下数据来源之类的信息：
(g_final <- g_arrows +
scale_y_continuous(limits = c(0, 90), expand = c(0.005, 0.005),
breaks = c(1, seq(20, 80, by = 20))) +
labs(caption = "Data: UNESCO Institute for Statistics") +
theme(plot.caption = element_text(size = 9, color = "gray50")))
最后的福利
那就是重新画最初那个热图（tile map），这次的颜色跟点图一样
(map_regions <- df_sorted %>%
ggplot(aes(x = x, y = y, fill = region, color = region)) +
geom_tile(color = "white") +
scale_y_reverse() +
scale_fill_uchicago(guide = F) +
coord_equal() +
theme(line = element_blank(),
panel.background = element_rect(fill = "transparent"),
plot.background = element_rect(fill = "transparent",
color = "transparent"),
panel.border = element_rect(color = "transparent"),
strip.background = element_rect(color = "gray20"),
axis.text = element_blank(),
plot.margin = margin(0, 0, 0, 0)) +
labs(x = NULL, y = NULL))
然后把这个tile map嵌在点图上面，正好可以当点图的legend.
g_final +
annotation_custom(ggplotGrob(map_regions), xmin = 2.5, xmax = 7.5, ymin = 55, ymax = 85)
进化历史
从一张所有初学者都会画的箱式图，到一张逼格十足的点图。全部用代码生成。
稍微再调整一下，再把最初那张热图合并起来，你可以实现下面这个效果：
Y叔后记
其实关于点图，作者还漏了一点，抖动可以说是瞎抖，现在有更好的抖动方法，是渣浪法sinaplot，这是由一个叫Sina的人提出，所以叫这名字。
The sinaplot is a data visualization chart suitable for plotting any single variable in a multiclass data set. It is an enhanced jitter strip chart, where the width of the jitter is controlled by the density distribution of the data within each class.
点的抖动不再是瞎抖，而是按照密度分布来抖，这样给出更多的信息，散点组成的形状，直接就像小提琴图。
另外一点是，可以用《（翻）云（覆）雨图》来画这些分布，效果也是杠杠的。
往期精彩