学会这个BBC，你的图也可以上新闻啦！

生信宝典

发布于 2022-04-19 12:26:07

4.5K00

代码可运行

运行总次数：0

代码可运行

英国广播公司（British Broadcasting Corporation；BBC）是全球最大的新闻媒体，其中各类新闻稿件采用的统计图表能很好地传达信息。为了方便清洗可重复数据和绘制图表，BBC数据团队用R对数据进行处理和可视化，经年累月下于去年整理绘图经验并开发了R包-bbplot，帮助我们画出和BBC新闻中一样好看的图形。

加载需要的R包

使用pacman[1]软件包中的p_load函数通过以下代码一次性加载。

#安装pcaman软件包并对其他R包进行加载
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语言脚本写作：最简单的统计与绘图，包安装、命令行参数解析、文件读取、表格和矢量图输出）。

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

下载软件包并成功安装后，就可以创建图表了（ Science组合图表解读）。

bbplot软件包如何工作？

该软件包具有两个函数功能，bbc_style（）和finalise_plot（）。

bbc_style（）：没有参数，通常是将文本大小、字体和颜色，轴线，轴线文本，边距和许多其他标准图表组件转换为BBC样式。

对于折线图而言，折线的颜色或条形图的颜色，并不是从bbc_style（）函数中直接实现的，而是需要在其他标准ggplot（ggplot2高效实用指南 (可视化脚本、工具、套路、配色)）图表函数中明确设置。

下面的代码显示了如何在标准图表制作工作流程中使用bbc_style（）。这是一个非常简单的折线图的示例，使用了gapminder程序包中的数据。

#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（）函数在后台实际执行的操作。它实质上修改了ggplot2主题功能（ggplot2学习笔记之图形排列）中的某些参数。

例如，第一个参数是设置图标题元素的字体、大小、和字体颜色。

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

通过向bbc_style（）函数中包含的主题添加额外的主题参数，例如添加一些网格线。

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

保存完成的图表

finalise_plot（）是bbplot程序包的第二个函数。它能按照BBC图形的标准将标题和副标题左对齐，在绘图的右下角添加页脚，也可以在左下角添加来源。它还可以将图表保存到指定的位置。该函数有五个参数：

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.

在标准工作流程中使用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")

那么如何保存上面创建的示例图？

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

！！前方高能！！一大波图即将“来袭”……

制作折线图

#准备数据
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")

制作多条折线的图

#准备数据
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语言 - 线图绘制

制作条形图

#准备数据
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语言 - 柱状图

制作堆叠条形图

#准备数据
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))

堆叠柱状图各成分连线画法：突出组间变化

制作分组条形图

只需要将position =“identity”更改为position =“dodge”：

#准备数据
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)

#画图
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")

#准备数据
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")

对图例进行更改

去掉图例：

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

改变图例位置：

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

改变坐标轴

翻转坐标轴：

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

添加/删除网格线：

bars <- bars + coord_flip() +
  theme(panel.grid.major.x = element_line(color="#cbcbcb"),
        panel.grid.major.y=element_blank())

#默认主题只有y轴的网格线。使用panel.grid.major.x = element_line添加x轴上的网格线。（使用panel.grid.major.y = element_blank（）删除y轴上的网格线）

人工更改轴间距：

使用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

在轴标签上添加千位分隔符

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

将百分比符号添加到轴标签：

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

构面

ggplot可以轻松创建多个小图表，这被称为构面。如果将需要可视化的数据按某个变量划分，则需要使用函数facet_wrap或facet_grid。

#准备数据
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")

可以尝试的参数实在是太多啦！大家可以试一试呀！

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

来源：https://bbc.github.io/rcookbook/

撰文：May

编辑：生信宝典

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2022-03-31，如有侵权请联系 cloudcommunity@tencent.com 删除

r 语言

本文分享自生信宝典微信公众号，前往查看

如有侵权，请联系 cloudcommunity@tencent.com 删除。

本文参与腾讯云自媒体同步曝光计划，欢迎热爱写作的你一起参与！

r 语言

登录后参与评论

0 条评论

热度