TidyTuesday 可视化学习之 ggplot2 一笔一画绘制表格

更好阅读移步至:https://www.yuque.com/docs/share/01fe5958-5f6b-4364-aa39-cb7d3fd602ed?#

参考链接:

image.png
image.png

<br />

<a name="zcTxe"></a>

须知:

rle 函数:计算向量中连续相同字符的个数

> rle(c(1,1,1,2,3,3,3,1,1))
Run Length Encoding
  lengths: int [1:4] 3 1 3 2
  values : num [1:4] 1 2 3 1

> rle(c(1, 2, 3, 3, 1, 1, 2, 3, 2))
Run Length Encoding
  lengths: int [1:7] 1 1 2 2 1 1 1
  values : num [1:7] 1 2 3 1 2 3 2

<br />**glue 函数:用大括号 {} **括起来的表达式将被计算为 R 代码。长字符串由行分隔并连接在一起。从第一行和最后一行开始的空白行和空白行被自动裁剪。

> name <- "Fred"
> age <- 50
> anniversary <- as.Date("1991-10-12")

> glue('My name is {name},',
       'my age next year is {age + 1},',
       'my anniversary is {format(anniversary, "%A, %B %d, %Y")}.')
My name is Fred,my age next year is 51,my anniversary is 星期六, 十月 12, 1991.

> glue("My name is {name}, not {{name}}.")
My name is Fred, not {name}.

> year <- 1940
> glue("**year**")
**year**
> glue("**{year}**")
**1940**

<br />**countrycode **函数:对我不重要

> cowcodes <- c("ALG", "ALB", "UKG", "CAN", "USA")
> countrycode(cowcodes, origin = "cowc", destination = "iso3c")
[1] "DZA" "ALB" "GBR" "CAN" "USA"

<br />**ggtext **包 的 **geom_richtext **函数:加文本标签注释

<br />
<br />annotate:添加注释和以及几何图形特别方便,为所欲为

annotate("rect",
           xmin = -2000, ymin = c(13, 38), 
           xmax = 26000, ymax = c(16, 41), 
           fill = "#F3F2EE", colour = "black", size = 0.3)

<br />coord_cartesian:放大镜效果不改变图形形状

  • https://ggplot2.tidyverse.org/reference/coord_cartesian.html
  • 绘图应该裁剪到画板的范围吗 ? 设置为"on" (默认值)表示“是”,设置为"off" 表示“不是”。在大多数情况下,不应该更改默认的 "on",因为设置 clip ="off" 可能会导致意外的结果。它允许在绘图图的任何地方绘制数据点,包括在绘图页边距中。如果通过 xlim 和 ylim 设置了限制,并且一些数据点超出了这些限制,那么这些数据点可能出现在轴、图例、画板标题或画板边距等位置。
p <- ggplot(mtcars, aes(disp, wt)) +
  geom_point() +
  geom_smooth()

p + scale_x_continuous(limits = c(325, 500))

p + coord_cartesian(xlim = c(325, 500))

<br />
image.png
image.png

coord_cartesian(clip = 'off'):取消画板限制

<br />**scale_x_continuous **函数通过 **limits **和 **expand **函数控制贴 y 轴距离

scale_y_reverse 函数翻转 y 轴左边起始顺序,上下颠倒,并通过 expand = expansion(add = 0) 控制 y 轴顶端和低端间隙为 0<br /><br />theme_void:去除画板,包括轴以及背景**<br />

plot.margin:控制上下左右图片边距<br />**<br />
<br />

<a name="alM8p"></a>

前期数据获得:

library(tidyverse)
library(lubridate)
library(countrycode)
library(ggtext)
library(glue)
library(here)
#library(skimr)

tdf_winners <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-07/tdf_winners.csv')

tdf_table <- tdf_winners %>% 
  mutate(
    # rle: 计算相同值的数目
    wins_consecutive = with(rle(winner_name), rep(lengths, times = lengths)),
    year = year(start_date), # 提取年数据
    # glue() 函数大括号 {} 括起来表示 R 代码 year <- 1940; glue("**{year}**"); > **1940** <
    year_labels = ifelse(year %% 10 == 0, glue("**{year}**"), year),
    year_group = case_when(
      year < 1915 ~ 1,
      year > 1915 & year < 1940 ~ 2,
      TRUE ~ 3),
    avg_speed = distance / time_overall,
    country_code = countrycode(nationality, origin = "country.name", destination = "iso3c"),
    winner_annot = ifelse(wins_consecutive > 2, glue("**{winner_name} ({country_code})**"), glue("{winner_name} ({country_code})"))
  ) %>%
  # 分组很妙,添加行号
  group_by(year_group) %>% 
  mutate(
    n_annot = row_number(),
    annot = ifelse((n_annot - 2) %% 3 == 0, TRUE, FALSE)
  ) %>% 
  ungroup() %>% 
  add_row(year = c(1915, 1916, 1917, 1918, 1940, 1941, 1942, 1943)) %>%
  arrange(year) %>% 
  mutate(n = row_number())

<a name="LL9Yf"></a>

分步骤重现图:

<a name="hLyBf"></a>

step1: geom_segment() 标虚线

  • 使用 geom_segment() 函数添加虚线, 数据中的 NA 很妙用,如果是 NA 值就不需要加虚线,就是为了图中看到的 1915-1918 添加用。
  • 真的妙,利用有多少行非 NA 数值,来保证点添加多少
ggplot(tdf_table) +
  # dotted gridlines ---------------------------------------------------

# 使用 geom_segment() 函数添加虚线, 数据中的 NA 很妙用,如果是 NA 值就不需要加虚线,就是为了图中看到的 1915-1918 添加用。 
# 真的妙,利用有多少行非 NA 数值,来保证点添加多少
geom_segment(data = subset(tdf_table, !is.na(year_labels)),
             aes(x = 0, xend = 24000, y = n, yend = n), 
             linetype = "dotted", size = 0.2)
image.png
image.png

<br />

<a name="RQ23D"></a>

step2:加上左右两侧的年份

  • 这里的 x = -1000 y = n 以及 x = 25000 用的很妙啊。特别是 -1000,加在坐标轴左侧
geom_richtext(aes(x = -1000, y = n, label = year_labels), 
              fill = "red", label.color = NA, 
              label.padding = unit(0.1, "lines"), 
              family = "JetBrains Mono", size = 2.5) +

  geom_richtext(aes(x = 25000, y = n, label = year_labels),
                fill = "blue", label.color = NA, 
                label.padding = unit(0.1, "lines"),
                family = "JetBrains Mono", size = 2.5) 
image.png
image.png

<br />

<a name="kUiQk"></a>

step3:geom_area() 加上填充面积

geom_area(aes(x = distance * 0.625, y = n, group = year_group), 
          fill = "#7DDDB6", alpha = 0.6, 
          orientation = "y", position = "identity")
image.png
image.png

<br />

<a name="50aa2"></a>

step4:选择性加上每一个上面对应的点

geom_point(data = subset(tdf_table, annot), 
             aes(x = distance * 0.625, y = n), size = 0.5) 
image.png
image.png

<br />

<a name="K2rHJ"></a>

step5:给 step4 中的点加上数值

geom_label(data = subset(tdf_table, annot), 
             aes(x = distance * 0.625 + 100, y = n, label = distance), 
             fill = "#F3F2EE", label.size = 0, 
             label.padding = unit(0.1, "lines"), 
             hjust = 0, family = "JetBrains Mono", size = 2.5) 

<br />
image.png
image.png

<br />

<a name="dfy6e"></a>

step6:给每一行加上注释,对应 WINNER

geom_richtext(aes(x = 5300, y = n, label = winner_annot, .na = NULL), 
              fill = "#F3F2EE", label.size = 0, 
              label.padding = unit(0.1, "lines"), 
              hjust = 0, family = "JetBrains Mono", size = 2.5)

<br />
image.png
image.png

<br />
<br />step7:

geom_label(aes(x = 10300, y = n, label = glue("{winner_team}", .na = NULL)), 
           fill = "#F3F2EE", label.size = 0, label.padding = unit(0.1, "lines"),
           hjust = 0, family = "JetBrains Mono", size = 2.5)
image.png
image.png

<br />

<a name="Usq1r"></a>

step7:geom_segment 函数添加 AVERAGE SPEED 数据

geom_segment(aes(x = 16000, xend = 16000 + avg_speed * 66.67, y = n, yend = n), 
             size = 2, colour = "#7DDDB6", alpha = 0.6)
image.png
image.png

<br />

<a name="BJmwo"></a>

step8:选择性添加 AVERAGE SPEED 对应的数值

geom_label(data = subset(tdf_table, annot), 
             aes(x = 16000 + avg_speed * 66.67 + 100, y = n, 
                 label = round(avg_speed, 1)), fill = "#F3F2EE", 
             label.size = 0, label.padding = unit(0.1, "lines"), 
             hjust = 0, family = "JetBrains Mono", size = 2.5)
image.png
image.png

<br />

<a name="t2Caa"></a>

step9:添加 TOTAL TIME 时间填充(geom_ribbon)、点、标签

geom_ribbon(aes(xmin = 20000, xmax = 20000 + time_overall * 10, y = n, group = year_group),
            fill = "#FCDF33", alpha = 0.6, orientation = "y", position = "identity") +
geom_point(data = subset(tdf_table, annot), 
             aes(x = 20000 + time_overall * 10, y = n), size = 0.5) +
geom_label(data = subset(tdf_table, annot), 
             aes(x = 20000 + time_overall * 10 + 100, y = n, 
                 label = round(time_overall, 1)), 
             fill = "#F3F2EE", label.size = 0, 
             label.padding = unit(0.1, "lines"),
             hjust = 0, family = "JetBrains Mono", size = 2.5)
image.png
image.png

<br />

<a name="psBfU"></a>

step10:annotate 函数添加竖直线

annotate("segment", 
         x = c(-2000, 0, 5000, 10000, 16000, 20000, 24000, 26000),
         xend = c(-2000, 0, 5000, 10000, 16000, 20000, 24000, 26000),
         y = -4, yend = 115, size = 0.3)
image.png
image.png

<br />

<a name="IEOLm"></a>

step11:annotate 函数添加三条横线

annotate("segment",
           x = -2000, xend = 26000, 
           y = c(-4, -1, 115), yend = c(-4, -1, 115), size = 0.3) 
image.png
image.png

<br />

<a name="tIULc"></a>

step12:annotate 添加表头

annotate("text", 
           x = c(-1000, 2500, 7500, 13000, 18000, 22000, 25000), 
           y = -2.5, 
           label = toupper(c("year", "distance", "winner", "team", "average speed", "total time", "year")), 
           hjust = 0.5, family = "IBM Plex Sans Bold", size = 3.5)
image.png
image.png

<br />

<a name="qoRiI"></a>

step13:annotate 函数加上空白

annotate("rect",
           xmin = -2000, ymin = c(13, 38), 
           xmax = 26000, ymax = c(16, 41), 
           fill = "#F3F2EE", colour = "black", size = 0.3)
image.png
image.png

<br />

<a name="Gfu1v"></a>

step14:annotate 函数参数 richtext 添加中间小表头

annotate("richtext", x = 13000, y = c(14.5, 39.5), 
           label = c("**1915-1918** Tour suspended because of Word War I",
                     "**1940-1946** Tour suspended because of Word War II"), 
           label.color = NA, fill = "#F3F2EE", hjust = 0.5, 
           family = "IBM Plex Sans", size = 3.5)
image.png
image.png

<br />

<a name="E0c7U"></a>

step15:annotate 函数参数 text 给 DISTANCE 栏加上单位刻度

annotate("text", x = c(100, 4900), y = 0, 
           label = c("0", "8000 km"), hjust = c(0, 1), 
           family = "IBM Plex Mono Light", size = 3)
image.png
image.png

<br />

<a name="TyUrp"></a>

step16:annotate 函数参数 text 给其他的添加刻度尺和注释

annotate("text", x = c(16100, 19900), y = 0, 
           label = c("0", "60 km/h"), hjust = c(0, 1), 
           family = "IBM Plex Mono Light", size = 3) +
annotate("text", x = c(20100, 23900), y = 0, 
           label = c("0", "300 h"), hjust = c(0, 1), 
           family = "IBM Plex Mono Light", size = 3) +
annotate("text", x = 26000, y = -6, 
           label = "Source: alastairrushworth/tdf & kaggle.com/jaminliu | Graphic: Georgios Karamanis", 
           hjust = 1, family = "IBM Plex Mono Light", size = 3)
image.png
image.png

<br />

<a name="9CuG9"></a>

step17:coord_cartesian 函数取消画板限制范围

  • 图形相对于 step16 没啥变化
coord_cartesian(clip = 'off') 
image.png
image.png

<a name="HBo0W"></a>

step18:scale_x_continuous 函数通过 limits 和 expand 函数控制贴 y 轴距离

scale_x_continuous(limits = c(-2300, 26300), expand = expansion(add = 1))
image.png
image.png

<br />

<a name="A31Sj"></a>

step19:scale_y_reverse 函数翻转 y 轴左边起始顺序,上下颠倒,并通过 expand = expansion(add = 0) 控制 y 轴顶端和低端间隙为 0

scale_y_reverse(expand = expansion(add = 0))
image.png
image.png

<br />

<a name="nszRU"></a>

step20:labs 加标题以及 theme_void 去除主题线条背景以及坐标轴

labs(
    title = "Tour de France Winners"
  ) +
  
theme_void(base_family = "JetBrains Mono") 
image.png
image.png

<br />

<a name="SAvaF"></a>

step21:设置灰色背景,画板大小,以及标题大小

theme(
    plot.background = element_rect(fill = "#F3F2EE", colour = NA),
    plot.margin = margin(20, 20, 20, 20),
    plot.title = element_text(hjust = 0.01, size = 28, 
                              family = "IBM Plex Sans Bold", margin = margin(0, 0, -8, 0))
  )
image.png
image.png

<br />

<a name="ofV8b"></a>

step22:here 函数加时间函数命名文件名

ggsave(here::here("2020-week15", "plots", "temp", 
                    paste0("tour-de-france", format(Sys.time(), "%Y%m%d_%H%M%S"), ".png")), 
         dpi = 320, width = 11, height = 15)

<br />step23:附加 AI 操作视频<br />

©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 204,053评论 6 478
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 85,527评论 2 381
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 150,779评论 0 337
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 54,685评论 1 276
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 63,699评论 5 366
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,609评论 1 281
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 37,989评论 3 396
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,654评论 0 258
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 40,890评论 1 298
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,634评论 2 321
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,716评论 1 330
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,394评论 4 319
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 38,976评论 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,950评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,191评论 1 260
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 44,849评论 2 349
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 42,458评论 2 342

推荐阅读更多精彩内容