BBC 新聞資料視覺化 Cookbook

沒有做到信雅達的能力和時間，結合原文去粗取精。

如何建立 BBC 風格的資料視覺化圖表

BBC 的資料部門在 ggplot 的基礎上，結合自身業務開發了 bbplot 。利用 bbplot 可以更加高效的建立供新聞出版使用的資料視覺化圖表。同時 BBC 的資料部門還撰寫了本手冊供有興趣使用 bbplot 建立類似以下圖表的人使用：

載入所有需要使用的庫

利用 pacman 的 p_load 函式一次載入所有需要使用的庫：

# 本行程式碼會未安裝 pacman 的時候安裝 pacman，如果已安裝則直接載入
if(!require(pacman)) install.packages("pacman")

pacman::p_load('dplr', 'tidyr', 'gapminder', 'ggplot2', 'ggalt',
'forcats', 'R.utils', 'png', 'grid', ' ggpubr', bbplot)
複製程式碼

安裝 bbplot 包

由於 bbplot 沒有上傳到 CRAN，所以目前只能使用 devtools 安裝。

# 執行此行安裝 devtools 包?
# install.packages('devtools')
devtools::install_github('bbc/bbplot')
複製程式碼

關於 bbplot 更詳細的資訊可以在官方 github 庫查閱，本文接下來也會詳細記錄此庫的大部分使用方法及相關函式。

bbplot 是如何工作的

本包有兩個函式：bbc_style() 和finalise_plot()。

bbc_style():此函式不需要傳入引數，會在建立完繪圖之後被新增至 ggplot 的繪圖流程中。這個函式的作用是建立 BBC 風格的字號、字型、顏色、標尺、邊距等元件，繪圖的風格是根據設計部門的推薦和反饋定製的。

需要注意的是折線圖中的線條或者條形圖?中條形的顏色不由 bbc_style() 函式定製，需要使用標準的 ggplot 繪圖函式指定。

下面的程式碼展示了 bbc_style() 常規使用方式。例子本身是用 gapminder 包提供的資料繪製一個簡單的折線圖。

# 繪圖所使用的資料來自 gapminder 包

line_df <- gapminder %>% filter(country == "Malawi")

# 繪圖
line <- ggplot(line_df, aes(x = year, y = lifeExp)) +
geom_line(colour = "#1390A1", size = 1)+
geom_hline(yintercept = 0,size = 1)+
bbc_style()+
labs(title = "Living longer",subtitle = "Life expectancy in Malawi 1952-2007")
複製程式碼

這就是 bbc_style() 實際完成的工作。本質上是調整了 ggplot2 的theme 函式的引數。

舉個例子，第一個引數設定了標題的字形、字號、字型以及顏色。

## function () 
## {
##     font <- "Helvetica"
##     ggplot2::theme(plot.title = ggplot2::element_text(family = font, 
##         size = 28, face = "bold", color = "#222222"), plot.subtitle = ggplot2::element_text(family = font, 
##         size = 22, margin = ggplot2::margin(9, 0, 9, 0)), plot.caption = ggplot2::element_blank(), 
##         legend.position = "top", legend.text.align = 0, legend.background = ggplot2::element_blank(), 
##         legend.title = ggplot2::element_blank(), legend.key = ggplot2::element_blank(), 
##         legend.text = ggplot2::element_text(family = font, size = 18, 
##             color = "#222222"), axis.title = ggplot2::element_blank(), 
##         axis.text = ggplot2::element_text(family = font, size = 18, 
##             color = "#222222"), axis.text.x = ggplot2::element_text(margin = ggplot2::margin(5, 
##             b = 10)), axis.ticks = ggplot2::element_blank(), 
##         axis.line = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), 
##         panel.grid.major.y = ggplot2::element_line(color = "#cbcbcb"), 
##         panel.grid.major.x = ggplot2::element_blank(), panel.background = ggplot2::element_blank(), 
##         strip.background = ggplot2::element_rect(fill = "white"),
##         strip.text = ggplot2::element_text(size = 22, hjust = 0))
## }
## <environment: namespace:bbplot>
複製程式碼

可以通過修改或新增 theme 函式的引數來調整圖表樣式。不過一定要在呼叫了 bbc_style() 之後再呼叫theme(),否則的話 bbc_style() 會覆蓋掉你的調整。

下面的程式碼會給圖片新增網格線：

theme(panel.grid.major.x = element_line(color = "#cbcbcb"),
panel.grid.major.y = element_blank())
複製程式碼

儲存繪製完畢的圖表

新增完bbc_style()後還需要一步操作才可以讓你的圖表可以公佈。finalise_plot() 能夠使圖表的標題和副標題左對齊、新增資訊來源、在圖表右下腳新增照片。它還能將圖表儲存至指定的位置。這個函式有5個引數：

finalise_plot(plot_name, source, save_filepath, width_pixels = 640, height_pixels = 450)

• plot_name: 圖表的名字。比如上面繪製的表格 plot_name 是 "line"。
• source:需要在圖表左下角暫時的來源文字，需要在文字前先打上 "Source:",比如 `source = "Source: ONS"。
• svae_filepath:圖表的儲存路徑，需要包括.png 字尾。
• width_pixels:預設 640 px。
• hieght_pixels:，預設 450 px。
• logo_image_path:指定在圖表右下角需要展示的 logo 儲存的位置。預設是一個 png 格式的佔位檔案，顏色和圖表的背景色一樣。如果你不需要展示 logo， 則無需調整此引數。當你想給圖表增加 logo 時，通過此引數指定 logo 的位置即可。

finalise_plot(plot_name = my_line_plot,
              source = "Source: Gapminder",
              save_filepath = "filename_that_my_plot_should_be_saved_to.png",
              width_pixels = 640,
              height_pixels = 450,
              logo_image_path = "placeholder.png")
複製程式碼

通過 finalise_plot() 函式，可以在圖片釋出前做最後的微調並儲存圖片。

因為 RStudio 的 plot 皮膚展示的圖表可能與最終儲存的圖表不一樣，所以應該儘早儲存並檢視儲存後圖表避免出錯。

所以，如何儲存我們之前繪製的圖表呢？

finalise_plot(plot_name = line,
              source = "Source: Gapminder",
              save_filepath = "images/line_plot_finalised_test.png",
              width_pixels = 640,
              height_pixels = 550)
複製程式碼

繪製折線圖

#Prepare data
line_df <- gapminder %>%
  filter(country == "China") 

#Make plot
line <- ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(colour = "#1380A1", size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  bbc_style() +
  labs(title="Living longer",
       subtitle = "Life expectancy in China 1952-2007")
複製程式碼

繪製多重線圖

#Prepare data
multiple_line_df <- gapminder %>%
  filter(country == "China" | country == "United States") 

#Make plot
multiple_line <- ggplot(multiple_line_df, aes(x = year, y = lifeExp, colour = country)) +
  geom_line(size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  scale_colour_manual(values = c("#FAAB18", "#1380A1")) +
  bbc_style() +
  labs(title="Living longer",
       subtitle = "Life expectancy in China and the US")
複製程式碼

繪製條形圖

#Prepare data
bar_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  arrange(desc(lifeExp)) %>%
  head(5)

#Make plot
bars <- ggplot(bar_df, aes(x = country, y = lifeExp)) +
  geom_bar(stat="identity", 
           position="identity", 
           fill="#1380A1") +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  bbc_style() +
  labs(title="Reunion is highest",
       subtitle = "Highest African life expectancy, 2007")
複製程式碼

繪製堆疊圖

#prepare data
stacked_df <- gapminder %>% 
  filter(year == 2007) %>%
  mutate(lifeExpGrouped = cut(lifeExp, 
                    breaks = c(0, 50, 65, 80, 90),
                    labels = c("Under 50", "50-65", "65-80", "80+"))) %>%
  group_by(continent, lifeExpGrouped) %>%
  summarise(continentPop = sum(as.numeric(pop)))

#set order of stacks by changing factor levels
stacked_df$lifeExpGrouped = factor(stacked_df$lifeExpGrouped, levels = rev(levels(stacked_df$lifeExpGrouped)))

#create plot
stacked_bars <- ggplot(data = stacked_df, 
                       aes(x = continent,
                           y = continentPop,
                           fill = lifeExpGrouped)) +
  geom_bar(stat = "identity", 
           position = "fill") +
  bbc_style() +
  scale_y_continuous(labels = scales::percent) +
  scale_fill_viridis_d(direction = -1) +
  geom_hline(yintercept = 0, size = 1, colour = "#333333") +
  labs(title = "How life expectancy varies",
       subtitle = "% of population by life expectancy band, 2007") +
  theme(legend.position = "top", 
        legend.justification = "left") +
  guides(fill = guide_legend(reverse = TRUE))
複製程式碼

這個例子中展示的是比例，有些時候需要展示準確的數字。只需要將 position = "fill" 修改為 position = "identity" 就行。

繪製分組條形圖

繪製分組條形圖和繪製條形圖的方法差不多，只需要將 position = "identity" 修改為 position = "dodge" 並設定 fill 即可。

#Prepare data
grouped_bar_df <- gapminder %>%
 filter(year == 1967 | year == 2007) %>%
 select(country, year, lifeExp) %>%
 spread(year, lifeExp) %>%
 mutate(gap = `2007` - `1967`) %>%
 arrange(desc(gap)) %>%
 head(5) %>%
 gather(key = year, 
        value = lifeExp,
        -country,
        -gap) 
 
#Make plot
grouped_bars <- ggplot(grouped_bar_df, 
                      aes(x = country, 
                          y = lifeExp, 
                          fill = as.factor(year))) +
 geom_bar(stat="identity", position="dodge") +
 geom_hline(yintercept = 0, size = 1, colour="#333333") +
 bbc_style() +
 scale_fill_manual(values = c("#1380A1", "#FAAB18")) +
 labs(title="We're living longer",
      subtitle = "Biggest life expectancy rise, 1967-2007")
複製程式碼

繪製啞鈴圖

library("ggalt")
library("tidyr")

#Prepare data
dumbbell_df <- gapminder %>%
  filter(year == 1967 | year == 2007) %>%
  select(country, year, lifeExp) %>%
  spread(year, lifeExp) %>%
  mutate(gap = `2007` - `1967`) %>%
  arrange(desc(gap)) %>%
  head(10)

#Make plot
ggplot(dumbbell_df, aes(x = `1967`, xend = `2007`, y = reorder(country, gap), group = country)) + 
  geom_dumbbell(colour = "#dddddd",
                size = 3,
                colour_x = "#FAAB18",
                colour_xend = "#1380A1") +
  bbc_style() + 
  labs(title="We're living longer",
       subtitle="Biggest life expectancy rise, 1967-2007")
複製程式碼

繪製直方圖

hist_df <- gapminder %>%
  filter(year == 2007)

ggplot(hist_df, aes(lifeExp)) +
  geom_histogram(binwidth = 5, colour = "white", fill = "#1380A1") +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  bbc_style() +
  scale_x_continuous(limits = c(35, 95),
                     breaks = seq(40, 90, by = 10),
                     labels = c("40", "50", "60", "70", "80", "90 years")) +
  labs(title = "How life expectancy varies",
       subtitle = "Distribution of life expectancy in 2007")
複製程式碼

調整圖例

移除圖例

有時候直接用文字註釋來識別資料會比圖例的效果更好。

使用 guides(colour = FALSE)來刪除指定的元素。

multiple_line + guides(colours = FALSE)
複製程式碼

也可以一次性移除所有的圖例theme(legned.position = "none")

multiple_line + theme(legend.position ="none")
複製程式碼

調整圖例的位置

圖例預設展示在圖表的上方，可以使用 legend.position = right/left/bottom 將圖例移動至其它位置：

mulitiple_line + theme(legend.position = "right")
複製程式碼

如果需要精確指定圖例的位置，可以給 legend.position傳入座標引數。 legend.position = c(0.98,0.1)會將圖例移動至右下方。c(0,0)是左下角，c(1,0) 是右下角，c(0,1)是左上角。

如果想知道最終的圖表中圖例的實際位置，需要先通過finalise_plot()函式將圖表儲存後，檢視實際的圖片。因為位置和圖片的大小有關。

 multiple_line + theme(legend.position = c(0.115,1.05),
                      legend.direction = "horizontal") +  
  labs(title="Living longer",
       subtitle = "Life expectancy in China and the US\n")
複製程式碼

如果想讓圖例左對齊，設定一個負邊距是比較簡單的辦法。語法是 margin(top, right, bottom, left)，但這需要多次儲存和檢視圖片來找到正確的數字。

+ theme(legend.margin = margin(0, 0, 0, -200)
複製程式碼

刪除圖例文字

通過調整 theme() 來刪除標題。記住，對 theme()的所有修改都要放在bbc_style()之後。

+ theme(legend.title = element_blank())
複製程式碼

讓圖例逆序

有時候需要調整圖例的順序，使得圖例和圖形的順序一致。

+ guides(fill = guide_legned(reverse = TRUE))
複製程式碼

圖例重新佈局

如果圖例特別多，出於美觀考慮，我們可能需要對圖例重新佈局。

通過給 guides 傳遞引數可以指定圖例的行數，下面的例子展示瞭如何建立一個共4行的圖例：

+ guides(fill = guide_legend(nrow = 4, byrow = T)
複製程式碼

調整圖例的標誌

給 guides 傳入 override.aes 引數會在不影響原圖表的情況下修改圖例的預設樣式。

+gides(fill = guide_legned(override.aes = list(size = 4)))
複製程式碼

給圖例新增間隙

預設的 ggplot 圖例幾乎沒有間隙。可以調整 scale labels manually 來增加間隙。

舉個例子：

如果你有一個圖形，顏色是根據資料來設定的，這時候你會有一個關於顏色的圖例。微調標籤就能調整圖例的間距：

+ scale_colour_manual(labels = function(x) paste0(" ",x," ")
複製程式碼

如果你的圖例展示的資訊有變化，上面的程式碼也要相應作出修改。比如 fill，需要修改為 scale_fill_manual()

調整座標軸

變換座標軸

coord_flip()可以將橫座標修改為縱座標。

bars <- bars + coord_filp()
複製程式碼

新增/移除網格線

bbplot 預設只有水平網格線。如果要新增垂直網格線，可以 panel.grid.major.x = element_line (同樣的，移除水平網格線panel.grid.major.y = element_blank())

bars <- bars + coord_flip() +
  theme(panel.grid.major.x = element_line(color="#cbcbcb"), 
        panel.grid.major.y=element_blank())
## 新新增的座標系會代替原有的座標系。
複製程式碼

修改座標軸的文字

可以使用 scale_y_continuous 或者 scale_x_continuous 任意修改座標軸標籤。

bars <- bars + scale_y_continuous(limits=c(0,85),
                   breaks = seq(0, 80, by = 20),
                   labels = c("0","20", "40", "60", "80 years"))

bars
複製程式碼

在指定座標軸標籤的同時，也指定了座標軸的區間(limits)。

給座標軸標籤新增千位符號

通過 scale_y_continuous 可以給座標軸標籤新增千位符號。第一種辦法是：

+ scale_y_continuous(labels = function(x) format(x, big.mark = ",",
                                                 scientific = FALSE))
複製程式碼

這個辦法有點麻煩。第二個辦法需要用到 scale包，但是簡單點：

+ scale_y_cpntinuous(labels = scales::comma)
複製程式碼

給座標軸標籤新增 %

通過 scale_y_continuous 很容易做到：

+ scale_y_continuous(labels = function(x) paste0(x, "%")
複製程式碼

限定繪圖範圍

比較麻煩的方法是使用scale_y_continuous來指定繪圖範圍，但是如果不需要設定座標軸標籤的話，使用 xlim 或 ylim 就行：

bars + ylim(c(0,500))
複製程式碼

給座標軸新增 title

預設的 theme 座標軸是沒有 title 的，不過可以手工新增：

+ theme(axis.title = element_text(size = 18))
複製程式碼

修改座標軸 title

新增了座標軸 title 後，預設的 title 是變數名。可以通過 labs()修改為任意的 title。

+labs(x = "I'm an axis",
      y = "")
複製程式碼

修改座標軸刻度

可以使用axis.ticks.x 或者 axis.ticks.y修改座標軸刻度：

multiple_line+ theme(
    axis.ticks.x = element_line(colour = "#333333"),
    axis.ticks.length = unit(0.26,"cm")
)
複製程式碼

新增註釋

新增一條註釋

最簡單的新增註釋的辦法是使用 geom_label:

multiple_line + geom_label(aes(x = 1980, y = 45, label = "I'm an annotation!"),hjust = 0, vjust = 0.5, colour = "#555555", fill = "white", label.size = NA, family = "Helvetica", size = 6)
複製程式碼

註釋準確的位置和 x、y 引數以及文字對齊方式有關。

使用 \n 進行換行，使用 lineheight 設定行高。

multiple_line <- multiple_line + 
  geom_label(aes(x = 1980, y = 45, label = "I'm quite a long\nannotation over\nthree rows"), 
             hjust = 0, 
             vjust = 0.5, 
             lineheight = 0.8,
             colour = "#555555", 
             fill = "white", 
             label.size = NA, 
             family="Helvetica", 
             size = 6) 
複製程式碼

在我們的案例中試一下：

multiple_line <- multiple_line + 
  theme(legend.position = "none") + 
  xlim(c(1950, 2011)) +
  geom_label(aes(x = 2007, y = 79, label = "US"), 
             hjust = 0, 
             vjust = 0.5, 
             colour = "#1380A1", 
             fill = "white", 
             label.size = NA, 
             family="Helvetica", 
             size = 6) +
  geom_label(aes(x = 2007, y = 72, label = "China"), 
             hjust = 0, 
             vjust = 0.5, 
             colour = "#FAAB18", 
             fill = "white", 
             label.size = NA, 
             family="Helvetica", 
             size = 6)
複製程式碼

左對齊/右對齊文字

hjust 和 vjust 控制文字的水平和垂直對齊。它們的取值範圍為 0 ～ 1。0 表示左（底部）對齊，1 表示右（頂部）對齊。

根據資料新增標籤

以上方法在新增文字標籤時很有用，但是重複使用以上方法為圖表新增註釋會讓工作變得很枯燥。

所以，如果你想給所有的資料點新增標籤，可以直接根據資料來設定位置。

labelled.bars <- bars + geom_label(aes(x = country, y = lifeExp, label = round(lifeExp, 0)),
    hjust =1,
    vjust =0.5
    colour = "white",
    fill = NA,
    label.size = NA,
    family = "Helvetica",
    size = 6)

baelled.bars
複製程式碼

上面的程式碼自動給每個國家都加上了文字標籤，免去了新增5次 geom_label 的麻煩。

為條形圖新增左對齊的標籤

如果你想給條形圖新增左對齊的標籤，只需要根據資料集設定 x 引數，然後專門直接設定y引數就行。

labelled.bars.v2 <- bars +
 geom_label(aes(x = country, y = 4, label = round(lifeExp, 0)),
    hjust = 0,
    vjusy = 0.5,
    colour = "white",
    fill = NA,
    label.size = NA,
    family = "Helvetica",
    size = 6)

labelled.bars.v2
複製程式碼

條形圖重排序

有時候，需要重新排列條形的順序。為了達到這個目的，需要在繪圖前設定資料的 factor levels。明確在繪製分類資料時想使用的順序。

dataset$column <- factor(dataset$column, levels = c("18-24","25-64","65+"))
複製程式碼

這也可以用於堆疊圖。

按情況設定條形顏色

通過 ifelse()可以根據情況設定 fill、alpha、size 等元素的值。

fill = ifelse(logical_condition, fill_if_true, fill_if_false)

ggplot(bar_df, aes(x = reorder(country, lifeExp),y =lifeExp))+
    geom_bar(stat = "identify", position = "Identity", fill = ifelse(
    bar_df$country == "#Mauritius","#1380A1","#ddddddd"))+
    coord_filp()+
    labs(title = "Reunion is highest", subtitle = "Hightest African life expectancy, 2007")+
    theme(panel.grid.major.x = element_line(color = "#cbcbcb"),
    panel.grid.major.y = element_blank())
複製程式碼

（未完）