手把手教程--用R做動態柱狀圖（附完整代碼）

這是“投必得學術”推送的第71篇文章，專注科研技能和資訊分享！

相較於信息豐富的箱線圖（箱線圖及其變體），柱狀圖（強大的直方圖和箱線圖）由於展示信息較少而經常被詬病或者忽視，但近期我對做動圖很有興趣（用R繪製局部地區疫情分佈圖+時間序列動態圖），學習到一種做出動態柱狀圖的方法，瞬間讓柱狀圖變得高大上起來。

巧合的是，在我摸索出方法的幾天後，看到有朋友在朋友圈裡分享了他們公司的業績圖，正是用這種動態柱狀圖展示數據的，先貼出來給大家看看效果（這裡沒有廣告嫌疑喲 :-P）：

今天筆者就來跟大家分享這種能反映時間發展排名的動態柱狀圖，讓數據像賽跑一樣，一個趕超一個。

安裝所需的R包

<code>
library
(ggplot2)
library
(gganimate)
library
(tidyverse)
library
(scales)
library
(gifski)
library
(viridis)/<code>

我們用一個數據包裡的數據做例子

<code>
library
(gapminder)
View
(gapminder)/<code>

這個gapminder包裡包含了從1952年到2007年期間各地區每5年的預期壽命（lifeExp）、總人口（pop）和人均GDP（gdpPercap），這三個數據都可以用動態柱狀圖很好的展示。加載這個數據包後，查看數據。

更多關於gapminder包的信息，請戳：
https://cran.r-project.org/web/packages/gapminder/README.html

整理數據

可以用預期壽命、總人口或人均GDP做圖，但是我試了一下，這些數據要麼因為本身數值差別不大要麼在地區或年份之間差別不大，做出的動圖不夠“動”，所以用總人口乘以人均GDP計算出總GDP，以此為例，做出每年GDP排名最高的10個國家的情況。

<code>gapminder_formatted %   
mutate(
value
 = pop*gdpPercap) %>%    
group_by(year) %>%   
mutate(rank = rank(-
value
),        
       Value_lbl = paste0(
" "
, round(
value
/
1e9
))) %>%   
group_by(country) %>%    
filter(rank <= 
10
) %>%   ungroup()/<code>

向左滑動查看完整代碼

做靜態圖

<code>
staticplot
 
=
 
ggplot(gapminder_formatted,
 
aes(rank,
 
group
 
=
  
country,
 
fill
 
=
 
as.factor(country),
 
colour
 
=
 
as.factor(country)))
 
+
   
geom_tile(aes(y
 
=
 
value/2,
 
height
 
=
 
value,
 
width
 
=
 
0.8
),
 
alpha
 
=
 
0.8
,
 
colour
 
=
 
NA)
  
+
   
geom_text(aes(y
 
=
 
0
,
 
label
 
=
 
paste(country,
 
" "
)),
 
vjust
 
=
 
0.2
,
 
hjust
 
=
 
1
,
 
size
 
=
 
8
)
 
+
   
geom_text(aes(y
 
=
  
value,
 
label
 
=
 
Value_lbl,
 
hjust
 
=
 
0
),
 
size
 
=
 
8
)
 
+
   
coord_flip(clip
 
=
 
"off"
,
 
expand
 
=
 
FALSE
)
 
+
  
scale_x_reverse()
 
+
   
guides(colour
  
=
 
FALSE
,
 
fill
 
=
 
FALSE
)
 
+
  
theme(axis.line
 
=
 
element_blank(),
  
                                              
axis.text.x
 
=
 
element_blank(),
     
                                              
axis.text.y
 
=
 
element_blank(),
                                              
axis.ticks
 
=
 
element_blank(),
  
                                              
axis.title.x
 
=
 
element_blank(),
    
                                              
axis.title.y
 
=
  
element_blank(),
      
                                              
legend.position
 
=
 
"none"
,
     
                                              
panel.background
 
=
 
element_blank(),
        
                                              
panel.border
 
=
 
element_blank(),
   
                                              
panel.grid.major
 
=
 
element_blank(),
  
                                              
panel.grid.minor
 
=
 
element_blank(),
    
                                              
panel.grid.major.x
 
=
 
element_line(),
    
                                              
panel.grid.minor.x
 
=
 
element_line(),
  
                                              
plot.title
 
=
  
element_text(size
 
=
 
32
,
 
hjust
 
=
 
0.5
,
 
face
 
=
 
"bold"
,
 
colour
 
=
 
"black"
,
 
vjust
 
=
 
-1
),
        
                                              
plot.subtitle=element_text(size
 
=
 
32
,
 
hjust
  
=
 
0.5
,
 
face
 
=
 
"italic"
,
 
colour
 
=
 
"black"
),
   
                                              
plot.caption
 
=
 
element_text(size
 
=
 
16
,
 
hjust
 
=
 
0.5
,
 
face
 
=
 
"italic"
,
  
colour
 
=
 
"black"
),
   
                                              
plot.background
 
=
 
element_blank(),
   
                                              
plot.margin
 
=
 
margin(1,
 
3
,
 
1
,
 
6.5
,
 
"cm"
))staticplot
/<code>

向左滑動查看完整代碼

可以看一下此時的靜態圖，亂糟糟的，暫時看不出什麼來。

生成按時間發展的動圖

這一步就是見證奇蹟的時刻啦，其中的關鍵就是transition_states這個函數，我們用它來定義時間軸是year。設置其中的transition_length和state_length可以讓柱子們或“平滑”或“跳動”地“賽跑”，以及在每一個狀態（每一年）停留的時間，大家可以調整試試看。

<code>anim = staticplot + transition_states(year, transition_length = 
2
, state_length = 
1
) +  
  view_follow(fixed_y = TRUE)  +   
  
labs
(title = 
"GDP (Top 10 Countries): {closest_state}"
,    
       subtitle = 
" "
,     
       caption = 
"GDP in Billions Dollars | Data Source: R Package gapminder"
)
anim/<code>

向左滑動查看完整代碼

如果你急不可耐地想立刻見證奇蹟，可以直接運行anim這個對象，在RStudio窗口查看。但我們還是要保存一下的，下一步也很重要。

保存

這裡我用的是播放速度的默認值（nframes = 100, fps = 10），大家可以試著調整總幀數和每秒幀數，放慢或者加快動圖。

<code> 
animate(anim,
 
nframes
 
=
 
100
,
 
fps
 
=
 
10
,
  
width
 
=
 
1200
,
 
height
 
=
 
600
,
   
        
renderer
 
=
 
gifski_renderer("Barplot_country.gif"))
/<code>

向左滑動查看完整代碼

改變顏色

柱子的顏色是按照地區名字的字母順序安排的，顯得有些亂糟糟，讓人摸不著頭腦，下面用兩種方式改變顏色。

（1）現在的顏色是按國家顯示的，如果我想按大洲（continent）顯示呢？

很簡單，只需將執行staticplot的代碼第一句改成：

<code>fill = 
as
.factor(continent), 
  colour = 
as
.factor(continent)/<code>

向左滑動查看完整代碼

（2）想徹底換個色板？

就換成流行的viridis色板吧，而且讓最終時間的柱子顏色按數值梯度顯示。

首先查看曾經躋身前十的到底有幾個國家：

<code>
country
 $country)
length(country)/<code>

向左滑動查看完整代碼

哦！有11個呢，應該有一個國家在這些年間被擠出前十了。

查看一下viridis色板的11個顏色（我覺得這個色板黃色的那部分太淺，可能會看不清，所以加了end = 0.9去掉黃色這端的顏色）：

<code>
show_col
(viridis_pal(end = 
0.9
)(
11
))/<code>

向左滑動查看完整代碼

提取這11種顏色的RGB代碼，編輯成一個色彩表格：

<code>
viridis_11
 

colour_rank
 

virids_palette
 
% as_tibble()
/<code>

向左滑動查看完整代碼

按最終時間的數值由大到小排序，跟色彩表格結合後，再按照地區名字的字母順序排序，提取顏色的RGB代碼。這一步有點繞，大家慢慢體會：

<code>colour %  
  group_by(country) %>%  summarise(value_max = max(
value
)) %>% 
  arrange(-value_max) %>%  mutate(value_rank = rank(country)) %>%  
  bind_cols(virids_palette) %>%  arrange(value_rank) %>% 
  pull(colour) %>%  
as
.character()/<code>

向左滑動查看完整代碼

在剛才的靜態圖裡加上新安排的顏色：

<code>staticplot 
<
-
 
staticplot
 +   
   
scale_fill_manual
(
values
 = 
colour)
 + 
  
scale_colour_manual
(
values
 = 
colour)
/<code>

向左滑動查看完整代碼

後面生成動圖的步驟都一樣啦：