英國(guó)廣播公司（British Broadcasting Corporation；BBC）是全球最大的新聞媒體，其中各類(lèi)新聞稿件采用的統(tǒng)計(jì)圖表能很好地傳達(dá)信息。為了方便清洗可重復(fù)數(shù)據(jù)和繪制圖表，BBC數(shù)據(jù)團(tuán)隊(duì)用R對(duì)數(shù)據(jù)進(jìn)行處理和可視化，經(jīng)年累月下于去年整理繪圖經(jīng)驗(yàn)并開(kāi)發(fā)了R包-bbplot，幫助我們畫(huà)出和BBC新聞中一樣好看的圖形。

加載需要的R包

使用pacman[1]軟件包中的p_load函數(shù)通過(guò)以下代碼一次性加載。

#安裝pcaman軟件包并對(duì)其他R包進(jìn)行加載 if(!require(pacman))install.packages("pacman")pacman::p_load('dplyr', 'tidyr', 'gapminder','ggplot2', 'ggalt','forcats', 'R.utils', 'png','grid', 'ggpubr', 'scales','bbplot')

安裝bbplot軟件包

bbplot不在CRAN上，因此必須使用devtools直接從Github安裝它（編程模板-R語(yǔ)言腳本寫(xiě)作：最簡(jiǎn)單的統(tǒng)計(jì)與繪圖，包安裝、命令行參數(shù)解析、文件讀取、表格和矢量圖輸出）。

# install.packages('devtools') devtools::install_github('bbc/bbplot')

下載軟件包并成功安裝后，就可以創(chuàng)建圖表了（ Science組合圖表解讀）。

bbplot軟件包如何工作？

該軟件包具有兩個(gè)函數(shù)功能，bbc_style（）和finalise_plot（）。

bbc_style（）：沒(méi)有參數(shù)，通常是將文本大小、字體和顏色，軸線，軸線文本，邊距和許多其他標(biāo)準(zhǔn)圖表組件轉(zhuǎn)換為BBC樣式。

對(duì)于折線圖而言，折線的顏色或條形圖的顏色，并不是從bbc_style（）函數(shù)中直接實(shí)現(xiàn)的，而是需要在其他標(biāo)準(zhǔn)ggplot（ggplot2高效實(shí)用指南 (可視化腳本、工具、套路、配色)）圖表函數(shù)中明確設(shè)置。

下面的代碼顯示了如何在標(biāo)準(zhǔn)圖表制作工作流程中使用bbc_style（）。這是一個(gè)非常簡(jiǎn)單的折線圖的示例，使用了gapminder程序包中的數(shù)據(jù)。

#Data for chart from gapminder package line_df <- gapminder %>%filter(country == "Malawi")#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 Malawi 1952-2007")

這是bbc_style（）函數(shù)在后臺(tái)實(shí)際執(zhí)行的操作。它實(shí)質(zhì)上修改了ggplot2主題功能（ggplot2學(xué)習(xí)筆記之圖形排列）中的某些參數(shù)。

例如，第一個(gè)參數(shù)是設(shè)置圖標(biāo)題元素的字體、大小、和字體顏色。

## 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>

通過(guò)向bbc_style（）函數(shù)中包含的主題添加額外的主題參數(shù)，例如添加一些網(wǎng)格線。

theme(panel.grid.major.x = element_line(color="#cbcbcb"),panel.grid.major.y=element_blank())

保存完成的圖表

finalise_plot（）是bbplot程序包的第二個(gè)函數(shù)。它能按照BBC圖形的標(biāo)準(zhǔn)將標(biāo)題和副標(biāo)題左對(duì)齊，在繪圖的右下角添加頁(yè)腳，也可以在左下角添加來(lái)源。它還可以將圖表保存到指定的位置。該函數(shù)有五個(gè)參數(shù)：

• plot_name: the variable name that you have called your plot, for example for the chart example above plot_name would be "line"

• source: the source text that you want to appear at the bottom left corner of your plot. You will need to type the word "Source:" before it, so for example source = "Source: ONS" would be the right way to do that.

• save_filepath: the precise filepath that you want your graphic to save to, including the .png extension at the end. This does depend on your working directory and if you are in a specific R project. An example filepath would be: Desktop/R_projects/charts/line_chart.png.

• width_pixels: this is set to 640px by default, so only call this argument if you want the chart to have a different width, and specify what you want it to be.

• height_pixels: this is set to 450px by default, so only call this argument if you want the chart to have a different height, and specify what you want it to be.

• logo_image_path: this argument specifies the path for the image/logo in the bottom right corner of the plot. The default is for a placeholder PNG file with a background that matches the background colour of the plot, so do not specify the argument if you want it to appear without a logo. If you want to add your own logo, just specify the path to your PNG file. The package has been prepared with a wide and thin image in mind.

在標(biāo)準(zhǔn)工作流程中使用finalise_plot（）的示例：

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")

那么如何保存上面創(chuàng)建的示例圖？

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

！！前方高能！！一大波圖即將“來(lái)襲”……

制作折線圖

#準(zhǔn)備數(shù)據(jù) line_df <- gapminder %>%filter(country == "China")#作圖 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")

制作多條折線的圖

#準(zhǔn)備數(shù)據(jù) multiple_line_df <- gapminder %>%filter(country == "China" | country == "United States")#作圖 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")

R語(yǔ)言 - 線圖繪制

制作條形圖

#準(zhǔn)備數(shù)據(jù) bar_df <- gapminder %>%filter(year == 2007 & continent == "Africa") %>%arrange(desc(lifeExp)) %>%head(5)#作圖 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")

R語(yǔ)言 - 柱狀圖

制作堆疊條形圖

#準(zhǔn)備數(shù)據(jù) 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)))#作圖 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))

堆疊柱狀圖各成分連線畫(huà)法：突出組間變化

制作分組條形圖

只需要將position =“identity”更改為position =“dodge”：

#準(zhǔn)備數(shù)據(jù) 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)#畫(huà)圖 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")

是Excel的圖，不！是R的圖

制作啞鈴圖

library("ggalt") library("tidyr")#準(zhǔn)備數(shù)據(jù) dumbbell_df <- gapminder %>%filter(year == 1967 | year == 2007) %>%select(country, year, lifeExp) %>%spread(year, lifeExp) %>%mutate(gap = `2007` - `1967`) %>%arrange(desc(gap)) %>%head(10)#作圖 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")

對(duì)圖例進(jìn)行更改

去掉圖例：

multiple_line + guides(colour=FALSE) #or multiple_line + theme(legend.position = "none")

改變圖例位置：

multiple_line + theme(legend.position = "right")

改變坐標(biāo)軸

翻轉(zhuǎn)坐標(biāo)軸：

bars <- bars + coord_flip()#垂直變成水平

添加/刪除網(wǎng)格線：

bars <- bars + coord_flip() +theme(panel.grid.major.x = element_line(color="#cbcbcb"),panel.grid.major.y=element_blank())#默認(rèn)主題只有y軸的網(wǎng)格線。使用panel.grid.major.x = element_line添加x軸上的網(wǎng)格線。（使用panel.grid.major.y = element_blank（）刪除y軸上的網(wǎng)格線）

人工更改軸間距：

使用scale_y_continuous或scale_x_continuous更改軸文本標(biāo)簽：

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

在軸標(biāo)簽上添加千位分隔符

+ scale_y_continuous(labels = function(x) format(x, big.mark = ",",scientific = FALSE))

將百分比符號(hào)添加到軸標(biāo)簽：

+ scale_y_continuous(labels = function(x) paste0(x, "%"))

構(gòu)面

ggplot可以輕松創(chuàng)建多個(gè)小圖表，這被稱(chēng)為構(gòu)面。如果將需要可視化的數(shù)據(jù)按某個(gè)變量劃分，則需要使用函數(shù)facet_wrap或facet_grid。

#準(zhǔn)備數(shù)據(jù) facet <- gapminder %>%filter(continent != "Americas") %>%group_by(continent, year) %>%summarise(pop = sum(as.numeric(pop)))#作圖 facet_plot <- ggplot() +geom_area(data = facet, aes(x = year, y = pop, fill = continent)) +scale_fill_manual(values = c("#FAAB18", "#1380A1","#990000", "#588300")) +facet_wrap( ~ continent, ncol = 5) +scale_y_continuous(breaks = c(0, 2000000000, 4000000000),labels = c(0, "2bn", "4bn")) +bbc_style() +geom_hline(yintercept = 0, size = 1, colour = "#333333") +theme(legend.position = "none",axis.text.x = element_blank()) +labs(title = "Asia's rapid growth",subtitle = "Population growth by continent, 1952-2007")

可以嘗試的參數(shù)實(shí)在是太多啦！大家可以試一試呀！

[1]：https://bbc.github.io/rcookbook/#how_to_create_bbc_style_graphics

來(lái)源：https://bbc.github.io/rcookbook/

撰文：May

編輯：生信寶典

推薦閱讀

• 史上最全的圖表色彩運(yùn)用原理

• 學(xué)術(shù)圖表的基本配色方法

• 數(shù)據(jù)可視化基本套路總結(jié)

• 萬(wàn)能轉(zhuǎn)換：R圖和統(tǒng)計(jì)表轉(zhuǎn)成發(fā)表級(jí)的Word、PPT、Excel、HTML、Latex、矢量圖等

• 2019年諾貝爾生理醫(yī)學(xué)獎(jiǎng)揭曉 |動(dòng)圖展示歷年生理學(xué)獎(jiǎng)

往期精品(點(diǎn)擊圖片直達(dá)文字對(duì)應(yīng)教程)

后臺(tái)回復(fù)“生信寶典福利第一波”或點(diǎn)擊閱讀原文獲取教程合集

總結(jié)

以上是生活随笔為你收集整理的学会这个BBC，你的图也可以上新闻啦！的全部?jī)?nèi)容，希望文章能夠幫你解決所遇到的問(wèn)題。

如果覺(jué)得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。