BBC 新闻数据可视化 Cookbook

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 包:point_down:
# install.packages('devtools')
devtools::install_github('bbc/bbplot')

 

关于 bbplot 更详细的信息可以在 官方 github 库 查阅,本文接下来也会详细记录此库的大部分使用方法及相关函数。

 

bbplot 是如何工作的

 

本包有两个函数: bbc_style()finalise_plot()

 

bbc_style() :此函数不需要传入参数,会在创建完绘图之后被添加至 ggplot 的绘图流程中。这个函数的作用是创建 BBC 风格的字号、字体、颜色、标尺、边距等组件,绘图的风格是根据设计部门的推荐和反馈定制的。

 

需要注意的是折线图中的线条或者条形图:bar_chart:中条形的颜色不由 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() 实际完成的工作。本质上是调整了 ggplot2theme 函数的参数。

 

举个例子,第一个参数设置了标题的字形、字号、字体以及颜色。

 

## 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 来指定绘图范围,但是如果不需要设置坐标轴标签的话,使用 xlimylim 就行:

 

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)

注释准确的位置和 xy 参数以及文本对齐方式有关。

 

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

左对齐/右对齐文本

 

hjustvjust 控制文本的水平和垂直对齐。它们的取值范围为 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())

(未完)

发表评论

电子邮件地址不会被公开。 必填项已用*标注