使用 streamgrapher 和 highcharter 绘制溪流图： 世界各国新冠肺炎发展趋势

大家还记得我之前使用 Stata 绘制的堆积面积图么？就是下面这个：

图表

这幅图展示的是全世界的疫情状况，看到这幅图我意识到展示世界各国疫情状况的最好方案可能是溪流图，不过已有的绘制溪流图的 R 包我觉得都不怎么好看，于是乎，我今天上午快速地写了个绘制溪流图的 R 包（基于 htmlwidgets 的），经过测试还挺好用，不过帮助文档写的很粗糙，以后有时间再进一步完善，我们来一起使用这个 R 包可视化世界各国的疫情状况吧！

另外 highcharter 包提供了一种更系统的方法来绘制，代码稍微复杂点。

首先安装这个包（附件中有这个包的安装包）：

devtools::install_local('streamgrapher_0.1.0.tar.gz')

安装好之后就可以使用了，在使用之前我们先把数据整理下，还是之前使用的 world-covid19.dta：

# 安装
# devtools::install_local('streamgrapher_0.1.0.tar.gz')
library(tidyverse)
library(lubridate)
library(streamgrapher)
haven::read_dta("world-covid19.dta") -> df

# 保留截止最后一天确诊最多的 12 个国家
df %>%
  dplyr::filter(date == max(date)) %>%
  top_n(12, wt = confirmed) %>%
  pull(country) -> countrylist

df %>%
  dplyr::filter(country %in% countrylist) -> df

df

然后就可以使用 streamgrapher 包绘制溪流图了：

library(streamgrapher)
streamgrapher(
  date = df$date,
  name = df$country,
  value = df$confirmed,
  title = "部分国家新冠疫情发展趋势",
  subtitle = "数据来源: CSSEGISandData/COVID-19: Novel Coronavirus (COVID-19) Cases, provided by JHU CSSE<br>https://github.com/CSSEGISandData/COVID-19<br>绘制：微信公众号 RStata",
  titleAlign = "left",
  subtitleAlign = "left",
  marginBottom = 40,
  xAxisMargin = 50,
  height = "400px",
  width = "100%"
)

图表

streamgrapher 包是基于 htmlwidgets 开发的，所以你可以在 RMarkdown 和 Shiny 应用中使用。这个函数有很多参数，难以一一解释，必须的参数有三个，date、name 和 value，使用的时候你需要给三个参数传递相同长度的向量，建议先把三个向量组装成数据框。还有一个有用的参数是 color，默认使用的是 Color Brewer 的 Set2 调色板，可以自定义，但是需要注意长度应该大于 length(unique(name))。例如我们换一种调色方案：

# 自定义填充色
streamgrapher(
  date = df$date,
  name = df$country,
  value = df$confirmed,
  color = c("#fed439", "#709ae1", "#8a9197", "#d2af81", "#fd7446", "#d5e4a2", "#197ec0", "#f05c3b", "#46732e", "#71d0f5", "#370335", "#075149"),
  title = "部分国家新冠疫情发展趋势",
  subtitle = "数据来源: CSSEGISandData/COVID-19: Novel Coronavirus (COVID-19) Cases, provided by JHU CSSE<br>https://github.com/CSSEGISandData/COVID-19<br>绘制：微信公众号 RStata",
  titleAlign = "left",
  subtitleAlign = "left",
  marginBottom = 40,
  xAxisMargin = 50,
  height = "400px",
  width = "100%"
)

图表

其他的参数基本都是字面意思，很容易理解，就不再一一解释了。

另外还可以使用 highcharter 包绘制这幅图（底层代码实际上都是 highcharts.js）

下面的代码实际上是仿照：https://www.highcharts.com.cn/demo/highcharts/streamgraph 编写的：

# 使用 highcharter 绘制
library(highcharter)

# 构造数据
df %>%
  select(country, confirmed) %>%
  mutate(confirmed = as.numeric(confirmed)) %>%
  set_names(c("name", "data")) %>%
  nest(data = c(data)) %>%
  mutate(data = map(data, pull)) %>%
  list_parse() -> data

highchart() %>%
  hc_chart(type = 'streamgraph',
           marginBottom =  30,
           zoomType = 'x') %>%
  hc_colors(c("#fed439", "#709ae1", "#8a9197", "#d2af81", "#fd7446", "#d5e4a2", "#197ec0", "#f05c3b", "#46732e", "#71d0f5", "#370335", "#075149")) %>%
  hc_title(
    floating = T,
    align = 'left',
    text = '部分国家新冠疫情发展趋势'
  ) %>%
  hc_subtitle(
    floating = T,
    align = 'left',
    y = 30,
    text = '数据来源: CSSEGISandData/COVID-19: Novel Coronavirus (COVID-19) Cases, provided by JHU CSSE<br>https://github.com/CSSEGISandData/COVID-19<br>绘制：微信公众号 RStata'
  ) %>%
  hc_xAxis(
    maxPadding = 0,
    type = 'category',
    crosshair = T,
    categories = unique(df$date),
    labels = list(
      align = 'left',
      reserveSpace = F,
      rotation = 270
    ),
    lineWidth = 0,
    margin = 20,
    tickWidth = 0
  ) %>%
  hc_yAxis(
    visible = F,
    startOnTick = F,
    endOnTick = F
  ) %>%
  hc_legend(enabled = F) %>%
  hc_plotOptions(
    series = list(
      label = list(
        enabled = T,
        minFontSize = 5,
        maxFontSize = 25,
        style = list(color = 'rgba(255,255,255,0.75)')
      )
    )
  ) %>%
  hc_add_series_list(data) %>%
  hc_add_theme(hc_theme_darkunica())

图表

点击这里跳转到 RStata 短书平台获取附件：使用 streamgrapher 和 highcharter 绘制溪流图： 世界各国新冠肺炎发展趋势