從一個(gè)圖的實(shí)戰(zhàn)來(lái)升華 R 語(yǔ)言 ggplot2 可視化技能

首先我是這是我日常逛 twitter 看到的,然后我又是一個(gè)搬運(yùn)工,

涉及的函數(shù)

  • readr::read_csv
  • dplyr::glimpse:適合用來(lái)查看函數(shù)的類信息,沒(méi)接觸過(guò)
  • mutate() + filter() + select():簡(jiǎn)潔方便創(chuàng)建新的數(shù)據(jù)
  • geom_bar():柱狀圖
  • geom_segment:自由化畫(huà)直線條,想畫(huà)哪里畫(huà)哪里,這里用來(lái)填充圖中的藍(lán)色柱子
  • geom_errorbar():添加誤差線,指定 y 值頭到尾即可,這里用來(lái)繪制柱子上面的那一條橫線
  • geom_point():點(diǎn)圖,這里用來(lái)添加柱子上面的點(diǎn)
  • coord_flip():將 xy 軸互換
  • scale_y_continuous(breaks = seq(0, 80, 10), limits = c(0, 80)):定義 y 軸刻度尺內(nèi)容( 即圖中展示的 x 軸數(shù)字)
  • expand_limits():?jiǎn)蜗驍U(kuò)展閾值,也可以用來(lái)指定 xy 軸的范圍,這里給后面要添加箭頭留白(最上面的那部分空白就是這個(gè)函數(shù)引起的)
  • theme():畫(huà)板控制,各種參數(shù),具體見(jiàn)正文或者谷歌搜索關(guān)鍵字 ggplot2 theme
  • labs():可以用來(lái)修改坐標(biāo)軸以及標(biāo)題、副標(biāo)題等文本信息,這里通過(guò) " " 將內(nèi)容設(shè)置為空
  • geom_curve:作用與 geom_segment() 相似,只是前者用來(lái)畫(huà)直線,而這里用來(lái)繪制曲線,參數(shù) arrow 為箭頭
  • annotate():可以自由在畫(huà)板上面添加文本注釋信息,想在哪里添加就在哪里添加

成品圖

好了接下來(lái)就是我復(fù)制粘貼的時(shí)間了。

讀取數(shù)據(jù)

  • 作者這里為了方便我們大家重現(xiàn)或者說(shuō)學(xué)習(xí)此代碼(我猜的哈),就把數(shù)據(jù)放在 github 上面。
  • 使用 readr 包的 read_csv() 函數(shù)讀取文件
emperors <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-08-13/emperors.csv")

# 運(yùn)行后會(huì)出現(xiàn)的結(jié)果,我們可以很清楚的看到每一列的信息
Parsed with column specification:
cols(
  index = col_double(),
  name = col_character(),
  name_full = col_character(),
  birth = col_date(format = ""),
  death = col_date(format = ""),
  birth_cty = col_character(),
  birth_prv = col_character(),
  rise = col_character(),
  reign_start = col_date(format = ""),
  reign_end = col_date(format = ""),
  cause = col_character(),
  killer = col_character(),
  dynasty = col_character(),
  era = col_character(),
  notes = col_character(),
  verif_who = col_character()
)

dplyr::glimpse(emperors, width = 100)
# 說(shuō)實(shí)話,剛開(kāi)始看到這個(gè)我是不知道在做啥的,然后谷歌,發(fā)現(xiàn)這是讓我們更直觀的去了解我們自己的數(shù)據(jù)
# width 參數(shù)控制輸出總字符的寬度
# 可以很清楚的看到有 16 列(變量) 和 68 行
Observations: 68
Variables: 16
$ index       <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, ...
$ name        <chr> "Augustus", "Tiberius", "Caligula", "Claudius", "Nero", "Galba", "Otho", "V...
$ name_full   <chr> "IMPERATOR CAESAR DIVI FILIVS AVGVSTVS", "TIBERIVS CAESAR DIVI AVGVSTI FILI...
$ birth       <date> 0062-09-23, 0041-11-16, 0012-08-31, 0009-08-01, 0037-12-15, 0002-12-24, 00...
$ death       <date> 0014-08-19, 0037-03-16, 0041-01-24, 0054-10-13, 0068-06-09, 0069-01-15, 00...
$ birth_cty   <chr> "Rome", "Rome", "Antitum", "Lugdunum", "Antitum", "Terracina", "Terentinum"...
$ birth_prv   <chr> "Italia", "Italia", "Italia", "Gallia Lugdunensis", "Italia", "Italia", "It...
$ rise        <chr> "Birthright", "Birthright", "Birthright", "Birthright", "Birthright", "Seiz...
$ reign_start <date> 0026-01-16, 0014-09-18, 0037-03-18, 0041-01-25, 0054-10-13, 0068-06-08, 00...
$ reign_end   <date> 0014-08-19, 0037-03-16, 0041-01-24, 0054-10-13, 0068-06-09, 0069-01-15, 00...
$ cause       <chr> "Assassination", "Assassination", "Assassination", "Assassination", "Suicid...
$ killer      <chr> "Wife", "Other Emperor", "Senate", "Wife", "Senate", "Other Emperor", "Othe...
$ dynasty     <chr> "Julio-Claudian", "Julio-Claudian", "Julio-Claudian", "Julio-Claudian", "Ju...
$ era         <chr> "Principate", "Principate", "Principate", "Principate", "Principate", "Prin...
$ notes       <chr> "birth, reign.start are BCE. Assign negative for correct ISO 8601 dates. Ca...
$ verif_who   <chr> "Reddit user zonination", "Reddit user zonination", "Reddit user zonination...

# 再看看 head 函數(shù), 可以看到橫列是反的
head(emperors)
# A tibble: 6 x 16
  index name  name_full birth      death      birth_cty birth_prv rise  reign_start reign_end  cause killer dynasty
  <dbl> <chr> <chr>     <date>     <date>     <chr>     <chr>     <chr> <date>      <date>     <chr> <chr>  <chr>  
1     1 Augu~ IMPERATO~ 0062-09-23 0014-08-19 Rome      Italia    Birt~ 0026-01-16  0014-08-19 Assa~ Wife   Julio-~
2     2 Tibe~ TIBERIVS~ 0041-11-16 0037-03-16 Rome      Italia    Birt~ 0014-09-18  0037-03-16 Assa~ Other~ Julio-~
3     3 Cali~ GAIVS IV~ 0012-08-31 0041-01-24 Antitum   Italia    Birt~ 0037-03-18  0041-01-24 Assa~ Senate Julio-~
4     4 Clau~ TIBERIVS~ 0009-08-01 0054-10-13 Lugdunum  Gallia L~ Birt~ 0041-01-25  0054-10-13 Assa~ Wife   Julio-~
5     5 Nero  NERO CLA~ 0037-12-15 0068-06-09 Antitum   Italia    Birt~ 0054-10-13  0068-06-09 Suic~ Senate Julio-~
6     6 Galba SERVIVS ~ 0002-12-24 0069-01-15 Terracina Italia    Seiz~ 0068-06-08  0069-01-15 Assa~ Other~ Flavian
# ... with 3 more variables: era <chr>, notes <chr>, verif_who <chr>

加載后續(xù)所要用的包

library(dplyr) 
library(tidyverse)
library(lubridate)  # year() 函數(shù)要用
library(ggplot2)

數(shù)據(jù)處理

  • 插句題外話,這里的 = 對(duì)齊,可以用 remedy 實(shí)現(xiàn),操作很騷,對(duì)于 代碼整潔和 Markdown 特別方便

  • 不斷的利用 mutate() 函數(shù)創(chuàng)建新得變量,這里沒(méi)啥解釋的。

  • filter(): 各種條件篩選

  • select():選擇要輸出的列

data <- emperors %>%
  mutate(annee_naiss = year(birth)) %>%
  mutate(annee_mort  = year(death)) %>%
  mutate(annee_deb   = year(reign_start)) %>%
  mutate(annee_fin   = year(reign_end)) %>%
  mutate(age_mort    = abs(annee_mort - annee_naiss)) %>%
  mutate(age_deb     = abs(annee_deb - annee_naiss)) %>%
  mutate(age_fin     = abs(annee_fin - annee_naiss)) %>%
  mutate(duree       = abs(age_fin - age_deb)) %>%
  mutate(remove      = ifelse(age_deb == age_mort, 'retirer', NA)) %>%
  filter(!age_mort %in% NA, !age_deb %in% NA, !age_fin %in% NA,
         !age_mort %in% 4, !remove %in% "retirer") %>%
  select(name, age_deb, age_fin, age_mort, duree)

# 簡(jiǎn)單查看一下數(shù)據(jù)
dplyr::glimpse(data, width = 100)
Observations: 51
Variables: 5
$ name     <chr> "Augustus", "Caligula", "Claudius", "Nero", "Galba", "Vespasian", "Titus", "Do...
$ age_deb  <dbl> 36, 25, 32, 17, 66, 60, 40, 30, 66, 45, 41, 52, 40, 31, 16, 48, 10, 20, 52, 15...
$ age_fin  <dbl> 48, 29, 45, 31, 67, 70, 42, 45, 68, 64, 62, 75, 59, 39, 31, 66, 29, 22, 53, 19...
$ age_mort <dbl> 48, 29, 45, 31, 67, 70, 42, 45, 68, 64, 62, 75, 59, 39, 31, 66, 29, 22, 53, 19...
$ duree    <dbl> 12, 4, 13, 14, 1, 10, 2, 15, 2, 19, 21, 23, 19, 8, 15, 18, 19, 2, 1, 4, 13, 3,..

# 還是比較喜歡 head 來(lái)展示
head(data)
# A tibble: 6 x 5
  name      age_deb age_fin age_mort duree
  <chr>       <dbl>   <dbl>    <dbl> <dbl>
1 Augustus       36      48       48    12
2 Caligula       25      29       29     4
3 Claudius       32      45       45    13
4 Nero           17      31       31    14
5 Galba          66      67       67     1
6 Vespasian      60      70       70    10

畫(huà)圖(重頭戲)

為了說(shuō)明可視化不斷修整過(guò)程,我將分開(kāi)展示

  • 1、 就是一個(gè)簡(jiǎn)單的柱狀圖

參數(shù)說(shuō)明:

  • stat = identity : 繪圖函數(shù) stat 的參數(shù),用來(lái)對(duì)樣本進(jìn)行統(tǒng)計(jì),默認(rèn)為 identity,表示一個(gè) x 對(duì)應(yīng)一個(gè) y,即橫坐標(biāo) x 在數(shù)據(jù)中對(duì)應(yīng)的 y 值;同時(shí)可以是 bin 表示對(duì)一個(gè) x 對(duì)應(yīng)落在 x 里面的數(shù),即統(tǒng)計(jì)頻數(shù),官方說(shuō)明書(shū) geom_bar.html
    • stat 函數(shù)有 stat_bin()stat_count()stat_density()stat_bin_2d()stat_bind_hex()stat_density_2d()stat_ellipse()stat_contour()stat_summary_hex()stat_summary_2d()stat_boxplot()stat_ydensity()stat_ecdf()stat_quantile()stat_smooth()stat_qq()stat_summary(fun.data = "mean_cl_boot")stat_summary_bin(fun.y = "mean", geom = "bar")stat_unique() 等,最重要的是還可以自定函數(shù) stat_function(aes(x = -3:3), n = 99, fun = dnorm, args = list(sd=0.5)),詳情見(jiàn) ggplot2 cheat sheet,有時(shí)間要好好看下每一個(gè)對(duì)應(yīng)的功能。
  • position = stack: 用 Cheat sheet 里面內(nèi)容展示,一目了然。stack 表示堆積,dodge 表示分開(kāi),fill 表示百分比填充,jitter 表示散點(diǎn)圖抖動(dòng),nudge 表示注釋信息遠(yuǎn)離點(diǎn)。
gg <- ggplot(data, aes(x = reorder(name, -age_mort), y = age_mort))  
gg <- gg + 
  geom_bar(stat          = "identity", position = "stack", width = 0.65, 
           fill          = "#6D7C83", alpha = 0.4)  
  • 2、 通過(guò) geom_segment() 函數(shù)來(lái)畫(huà)直線, 因?yàn)檫@里是表示柱子,可以理解為線條,主要要指定 x 對(duì)應(yīng)的那一根柱子,然后再指定縱向即 Y 軸的起始 age_deb 和 終止 age_fin 坐標(biāo)即可,size = 2.3 制定柱子的寬度,不宜太大,然后涂上顏色。

至于這個(gè)函數(shù)式做什么的呢?就是你提供一個(gè)四邊形的區(qū)間,你就可以畫(huà)出一個(gè)四邊形,詳情可以參考 杜雨老師寫(xiě)的一篇超級(jí)棒的素材 ggplot2 都有哪些使用不多但是卻異常強(qiáng)大的圖層函數(shù)
引用其中一句話 geom_segment 通常用于制作直線段圖,路徑圖、放射線圖等,思路也很簡(jiǎn)單,只需要指定每一條線段的起點(diǎn)坐標(biāo)、終點(diǎn)坐標(biāo)即可。即分別制定 x,y,xend,yend

  • 后面會(huì)涉及一個(gè)函數(shù) geom_curve() 用來(lái)畫(huà)弧線,用官方 geom_segment 一張圖說(shuō)明
gg <- gg + 
  geom_segment(aes(y    = age_deb, x = name,
                   yend = age_fin, xend = name),
               color    = "#175676", size = 2.3, alpha = 0.8)  # size = 2.3 制定柱子的寬度,不宜太大
  • 3、 geom_errorbar() 加上誤差線,這里起始并不是真正的加上誤差線,給我感覺(jué)就是在每個(gè)柱子最上放劃一道橫線。用上面的函數(shù) geom_segment() 也可以做到。
gg <- gg + 
  geom_errorbar(aes(y    = age_mort, x = name, 
                    ymin = age_mort, ymax = age_mort),
                color    = "black", width = 0.85)  
  • 4、 通過(guò) geom_point() 函數(shù)加上散點(diǎn)圖( 仔細(xì)看柱子頂端中間多了一個(gè)點(diǎn) ),并且通過(guò) coord_flip() 函數(shù)將 X 和 Y 軸進(jìn)行交換
gg <- gg + geom_point(aes(name, age_mort), 
                      colour = "black", size = 1)  # 我將原文 0.75 改成了 1 ,這樣點(diǎn)的效果好點(diǎn)
gg <- gg + coord_flip()  
  • 5、 scale_y_continuous() 函數(shù)調(diào)整 y 坐標(biāo)軸刻度尺的內(nèi)容和范圍,注意因?yàn)槲覀兪峭ㄟ^(guò)函數(shù) coord_flip() 將 xy 軸交換了,但是修改參數(shù)的時(shí)候,仍然要對(duì)應(yīng)之前的坐標(biāo)軸。
    • scale_y_continuous() 函數(shù),指定 y 軸刻度尺標(biāo)簽,breaks 展示需要的內(nèi)容,limits 指定 y 軸的范圍。
gg <- gg + scale_y_continuous(breaks = seq(0, 80, 10), 
                              limits = c(0, 80)) 

seq(0, 80, 10)
[1]  0 10 20 30 40 50 60 70 80
  • 6、 expand_limits() 函數(shù)可以用來(lái)單向擴(kuò)展閾值,也可以用來(lái)指定 xy 軸的范圍,這里給后面要添加箭頭留白。
gg <- gg + expand_limits(x = c(0, 56)) # 沒(méi)咋理解這一步加不加有啥區(qū)別,先操作,再回來(lái)解釋

記住幾個(gè)主要的吧

參數(shù)  設(shè)置內(nèi)容    繼承自
line    所有線屬性    
rect    所有矩形區(qū)域?qū)傩?    
text    所有文本相關(guān)屬性     
title   所有標(biāo)題屬性   
axis.title  坐標(biāo)軸標(biāo)題   
axis.title.x    x 軸屬性   axis.title
axis.title.y    y 軸屬性   axis.title
axis.text   坐標(biāo)軸刻度標(biāo)簽屬性        
axis.ticks  坐標(biāo)軸刻度線   
axis.ticks.length   刻度線長(zhǎng)度    
axis.ticks.margin   刻度線和刻度標(biāo)簽之間的間距    
axis.line   坐標(biāo)軸線         
legend.background   圖例背景    
legend.margin   圖例邊界     
legend.key  圖例符號(hào)     
legend.key.size 圖例符號(hào)大小   
legend.key.height   圖例符號(hào)高度   
legend.key.width    圖例符號(hào)寬度   
legend.text 圖例文字標(biāo)簽   
legend.text.align   圖例文字標(biāo)簽對(duì)齊方式  0 為左齊,1 為右齊
legend.title    圖例標(biāo)題    text
legend.title.align  圖例標(biāo)題對(duì)齊方式     
legend.position 圖例位置    left, right, bottom, top, 兩數(shù)字向量
legend.direction    圖例排列方向  "horizontal" or "vertical"
legend.justification    居中方式    center 或兩數(shù)字向量
legend.box  多圖例的排列方式    "horizontal" or "vertical"
legend.box.just 多圖例居中方式  
panel.background    繪圖區(qū)背景   
panel.border    繪圖區(qū)邊框   
panel.margin    分面繪圖區(qū)之間的邊距   
panel.grid  繪圖區(qū)網(wǎng)格線  
panel.grid.major    主網(wǎng)格線     
panel.grid.minor    次網(wǎng)格線         
plot.background 整個(gè)圖形的背景  
plot.title  圖形標(biāo)題     
plot.margin 圖形邊距    top, right, bottom, left
strip.background    分面標(biāo)簽背景
strip.text  分面標(biāo)簽文本       
gg <- gg +  theme(panel.border       = element_blank(), # 繪圖區(qū)邊框
                  panel.background   = element_blank(), # 繪圖區(qū)背景,這里會(huì)變成純白,沒(méi)有灰色背景
                  plot.background    = element_blank(), # 整個(gè)圖形的背景
                  panel.grid.major.x = element_line(size = 0.2,linetype = "dotted", color = "#6D7C83"), # 垂直 x 軸的主網(wǎng)格線的類型、粗細(xì)、以及顏色
                  panel.grid.major.y = element_blank(), # 同上,只不過(guò)這里選擇為空,不顯示這條線,其實(shí)有點(diǎn)多余,本身就沒(méi)有這里
                  panel.grid.minor   = element_blank(), # 次網(wǎng)格線
                  axis.line.x        = element_blank(), # 坐標(biāo)軸線 x
                  axis.line.y        = element_blank(), # 坐標(biāo)軸線 y
                  axis.ticks.y       = element_blank(), # 坐標(biāo)軸 y 刻度線
                  axis.ticks.x       = element_blank())  # 坐標(biāo)軸 x 刻度線
  • 8、 通過(guò) labs() 函數(shù)來(lái)修改所有標(biāo)簽內(nèi)容
gg <- gg + labs(title  = " ",
              subtitle = "",
              y        = " ",
              x        = " ")
  • 9、 通過(guò) theme() 函數(shù)來(lái)修改所有坐標(biāo)軸刻度尺內(nèi)容,可以看到 xy 軸刻度尺的字體和顏色都改變了。
gg <- gg + theme(plot.title    = element_blank(),
               plot.subtitle   = element_blank(),
               axis.title.y    = element_blank(),
               axis.title.x    = element_blank(),
               axis.text.y     = element_text(hjust = 1, vjust = 0.5, size = 12,
                                              color = "#6D7C83", face = "bold"),
               axis.text.x     = element_text(hjust = 0.5, vjust = 0, size = 12,
                                              color = "#6D7C83", face = "bold")
  • 10、 通過(guò) geom_curve() 函數(shù)用來(lái)畫(huà)弧線,來(lái)實(shí)現(xiàn)圖中的箭頭標(biāo)志,這里我們可以看出來(lái)前面的函數(shù) expand_limits() 是為了給這里的箭頭留白。
# 制備箭頭的坐標(biāo)
arrows <- tibble(    
  x1 = c(50, 16, 53.5, 53.5, 53.5),    
  x2 = c(49, 15,   51,   51,   51),    
  y1 = c(35, 70,    5,   25,   40),    
  y2 = c(22, 61,    0,   13,   19)  
) 

# 添加箭頭
gg <- gg +    
  geom_curve(data                  = arrows, 
                         aes(x     = x1, y = y1, xend = x2, yend = y2),
                         arrow     = arrow(length = unit(0.1, "inch")),
                         size      = 0.3, 
                         color     = "#6D7C83",
                         curvature = -0.3) 
  • 11、 使用 annotate() 函數(shù)在圖上加一點(diǎn)文本注釋,從這里可以發(fā)現(xiàn)作者全文的顏色都是統(tǒng)一的。
gg <- gg + 
  annotate(geom  = "text", x = 50, y = 35, label = "Le plus jeune à\ndevenir Empereur", 
           color = "#6D7C83", size=3, hjust = 0, vjust = 0.5, fontface = "bold")
  • 12、 使用 annotate() 函數(shù)在圖上其它幾處加文本注釋
gg <- gg +
  annotate(geom          = "text", x = 18, y = 70, label = "Son reigne\na pris fin\navant\nson décès", 
           color         = "#6D7C83", size = 3, hjust = 0.5, vjust = 0.5, fontface = "bold")  

gg <- gg + 
  annotate(geom          = "text", x = 54,y = 5, label = "Naissance", 
           color         = "#6D7C83", size = 3, hjust = 0.5,vjust = 0.5, fontface = "bold")  

gg <- gg + annotate(geom = "text", x = 55, y = 25, label = "Début du\nreigne",
                  color  = "#6D7C83", size = 3, hjust = 0.5,vjust = 0.8, fontface = "bold")

gg <- gg + annotate(geom = "text", x = 54,y = 40, label = "Décès",
                  color  = "#6D7C83", size = 3, hjust = 0.5,vjust = 0.5, fontface = "bold")

我的膝蓋現(xiàn)在還疼,為啥?我跪著學(xué)完的。

?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請(qǐng)聯(lián)系作者
平臺(tái)聲明:文章內(nèi)容(如有圖片或視頻亦包括在內(nèi))由作者上傳并發(fā)布,文章內(nèi)容僅代表作者本人觀點(diǎn),簡(jiǎn)書(shū)系信息發(fā)布平臺(tái),僅提供信息存儲(chǔ)服務(wù)。

推薦閱讀更多精彩內(nèi)容