library(highcharter)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

0.1 地图

library(highcharter)
data("USArrests", package = "datasets")
data("usgeojson") # 加载地图数据 地图数据的结构

USArrests <- transform(USArrests, state = rownames(USArrests))

highchart() %>%
  hc_title(text = "Violent Crime Rates by US State") %>%
  hc_subtitle(text = "Source: USArrests data") %>%
  hc_add_series_map(usgeojson, USArrests,
    name = "Murder arrests (per 100,000)",
    value = "Murder", joinBy = c("woename", "state"),
    dataLabels = list(
      enabled = TRUE,
      format = "{point.properties.postalcode}"
    )
  ) %>%
  hc_colorAxis(stops = color_stops()) %>%
  hc_legend(valueDecimals = 0, valueSuffix = "%") %>%
  hc_mapNavigation(enabled = TRUE)

highcharter 包含三个数据集分别是： worldgeojson 世界地图（国家级）、 usgeojson 美国地图（州级）、 uscountygeojson 美国地图（城镇级）。其它地图数据见 https://code.highcharts.com/mapdata/。

# 添加地图数据
hcmap(map = "countries/cn/custom/cn-all-sar-taiwan.js") %>%
  hc_title(text = "中国地图")

这才是真的动态图形，底层设计的图形语法已经与 ggplot2 大不相同，和用户交互是核心的部分。

rgl 只是一种展现形式，它是基于 OpenGL，不拘泥于显示设备， plotly 包 [@plotly2020] 和 highcharter 是基于网页的。

library(magrittr)
# 获取 R 包元数据
Sys.setenv(R_CRAN_WEB = "https://mirrors.tuna.tsinghua.edu.cn/CRAN")
pdb <- tools::CRAN_package_db()
js_pkg <- tools::dependsOnPkgs("htmlwidgets", installed = pdb, recursive = FALSE)
js_lib <- c(
  "Altair", "ApexCharts", "HTML", "Excel", "Billboard",
  "[Hh]tmlwidgets", "[Hh]tmlwidget", "D3", "D3Plus",
  "diffrprojects", "[Ss]hiny", "DataTables", "BioCircos.js",
  "[Dd]3.js", "C3.js", "[Dd]eck.gl",
  "Echarts JavaScript", "Microsoft", "jExcel", "JavaScript",
  "Formattable", "ggplot2", "Dragula Javascript Library",
  "jquery-gradient-picker", "plotly", "Highcharts",
  "jQuery", "jsTree", "mapview", "[Ll]eaflet",
  "Leaflet-timeline", "Mapbox GL JS", "MetricsGraphics", "UML", "easyalluvial",
  "Phylocanvas", "plotly.js", "QRA", "Chart.js",
  "agGrid", "React Table", "Handsontable.js",
  "WebVR", "RStudio Shiny", "Mozilla A-Frame", "Sigma.js", "heatmaply",
  "Slick", "jQuery UI", "JavaScript Datamaps",
  "SortableJS", "SMITIDstruct", "Vega", "Vega-Lite", "vis.js",
  "Grammar of Graphics", "R markdown", "Dygraphs",
  "Spec", "iframes"
)
js_regexp <- paste("'(", paste(js_lib, collapse = "|"), ")'", sep = "")
subset(pdb, subset = Package %in% js_pkg & grepl("(JavaScript|htmlwidgets|js|Interactive|Library)", Title), select = c("Package", "Title")) %>%
  transform(., Title = gsub("(\\\n)", " ", Title), Package = paste("**", Package, "**", sep = "")) %>%
  transform(., Title = gsub(js_regexp, "\\1", Title)) %>%
  knitr::kable(.,
    caption = "JavaScript 生态系统", format = "pandoc",
    booktabs = TRUE, row.names = FALSE
  )
JavaScript 生态系统
Package Title
apexcharter Create Interactive Chart with the JavaScript ApexCharts Library
aweSOM Interactive Self-Organizing Maps
billboarder Create Interactive Chart with the JavaScript Billboard Library
BioCircos Interactive Circular Visualization of Genomic Data using htmlwidgets and BioCircos.js
c3 C3.js Chart Library
chromoMap Interactive Genomic Visualization of Biological Data
collapsibleTree Interactive Collapsible Tree Diagrams using D3.js
ctrialsgov Query Data from U.S. National Library of Medicine’s Clinical Trials Database
cubeview View 3D Raster Cubes Interactively
cyjShiny Cytoscape.js Shiny Widget (cyjShiny)
D3partitionR Interactive Charts of Nested and Hierarchical Data with D3.js
d3po Fast and Beautiful Interactive Visualization for ‘Markdown’ and Shiny
d3Tree Create Interactive Collapsible Trees with the JavaScript D3 Library
datacleanr Interactive and Reproducible Data Cleaning
diffr Display Differences Between Two Files using Codediff Library
dragulaR Drag and Drop Elements in Shiny using Dragula Javascript Library
DT A Wrapper of the JavaScript Library DataTables
dygraphs Interface to Dygraphs Interactive Time Series Charting Library
echarts4r Create Interactive Graphs with Echarts JavaScript Version 5
echarty Minimal R/Shiny Interface to JavaScript Library ‘ECharts’
excelR A Wrapper of the JavaScript Library jExcel
flipdownWidgets A Wrapper of JavaScript Library ‘flipdown.js’
focusedMDS Focused, Interactive Multidimensional Scaling
fusionchartsR Embedding ‘FusionCharts Javascript’ Library in R
ggiraph Make ggplot2 Graphics Interactive
gradientPickerD3 Interactive Color Gradient Picker Using htmlwidgets and the Modified JS Script jquery-gradient-picker
graph3d A Wrapper of the JavaScript Library ‘vis-graph3d’
heatmaply Interactive Cluster Heat Maps Using plotly and ggplot2
highcharter A Wrapper for the Highcharts Library
iheatmapr Interactive, Complex Heatmaps
imageviewer Simple htmlwidgets Image Viewer with WebGL Brightness/Contrast
jsTree Create Interactive Trees with the jQuery jsTree Plugin
jsTreeR A Wrapper of the JavaScript Library jsTree
leaflet Create Interactive Web Maps with the JavaScript Leaflet Library
learnr Interactive Tutorials for R
listviewer htmlwidget for Interactive Views of R Lists
manipulateWidget Add Even More Interactivity to Interactive Charts
mapdeck Interactive Maps Using Mapbox GL JS and Deck.gl
mapedit Interactive Editing of Spatial Data in R
mapview Interactive Viewing of Spatial Data in R
metricsgraphics Create Interactive Charts with the JavaScript MetricsGraphics Library
networkD3 D3 JavaScript Network Graphs from R
NGLVieweR Interactive 3D Visualization of Molecular Structures
packer An Opinionated Framework for Using JavaScript
phylocanvas Interactive Phylogenetic Trees Using the Phylocanvas JavaScript Library
plainview Plot Raster Images Interactively on a Plain HTML Canvas
plotly Create Interactive Web Graphics via plotly.js
PRISMA2020 Make Interactive ‘PRISMA’ Flow Diagrams
profvis Interactive Visualizations for Profiling R Code
QRAGadget A Shiny Gadget for Interactive QRA Visualizations
qrage Tools that Create D3 JavaScript Force Directed Graph from R
qtlcharts Interactive Graphics for QTL Experiments
r3dmol Create Interactive 3D Visualizations of Molecular Data
radarchart Radar Chart from Chart.js
RagGrid A Wrapper of the JavaScript Library agGrid
rAmCharts JavaScript Charts Tool
rAmCharts4 Interface to the JavaScript Library ‘amCharts 4’
reactable Interactive Data Tables Based on React Table
recogito Interactive Annotation of Text and Images
rhandsontable Interface to the Handsontable.js Library
Rnvd3 An Incomplete Wrapper of the ‘nvd3’ JavaScript Library
safetyGraphics Interactive Graphics for Monitoring Clinical Trial Safety
scatterD3 D3 JavaScript Scatterplot from R
shinyCyJS Create Interactive Network Visualizations in R and shiny
shinyTree jsTree Bindings for Shiny
sigmajs Interface to Sigma.js Graph Visualization Library
slickR Create Interactive Carousels with the JavaScript Slick Library
threejs Interactive 3D Scatter Plots, Networks and Globes
timevis Create Interactive Timeline Visualizations in R
toastui Interactive Tables, Calendars and Charts for the Web
trelliscopejs Create Interactive Trelliscope Displays
upsetjs ‘HTMLWidget’ Wrapper of ‘UpSet.js’ for Exploring Large Set Intersections
visNetwork Network Visualization using vis.js Library
vueR ‘Vuejs’ Helpers and Htmlwidget

不推荐使用 highcharter 包提供的 hchart() 接口，这个接口函数走的路线和 ggplot2 包内的 qplot() 函数一致，用它就好像在拄着拐杖走路，很别扭！

以数据集 discoveries 为例介绍 highcharter 包的使用

library(highcharter)
highchart() %>%
  hc_xAxis(type = "datetime") %>%
  hc_title(
    text = "Yearly Numbers of Important Discoveries",
    margin = 20, align = "left",
    style = list(color = "#51B749", useHTML = TRUE)
  ) %>%
  hc_add_series(data = discoveries, name = "discoveries") %>%
  hc_exporting(enabled = TRUE)
library(magrittr)
library(ggplot2)
library(ggfortify)
library(highcharter)

0.2 折线图

0.2.1 简单折线图

ggplot(data = BOD, aes(x = Time, y = demand)) +
  geom_point() +
  geom_line() +
  theme_minimal()

hchart(BOD, "line", hcaes(x = Time, y = demand))

0.2.2 分组折线图

ggplot(data = Orange, aes(x = age, y = circumference, color = Tree)) +
  geom_point() +
  geom_line() +
  theme_minimal()

hchart(Orange, "line", hcaes(x = age, y = circumference, group = Tree))
# hchart(DNase, "line", hcaes(x = conc, y = density, group = Run))
# hchart(Loblolly, "line", hcaes(x = age, y = height, group = Seed))

0.2.3 时间序列图

ggfortify 包 [@Tang_2016_ggfortify] 大大扩展了 ggplot2 包内置的函数 autoplot() 的功能，使得它可以适用多种数据对象的直接绘图

Base R 对时间序列类型 ts 的数据对象提供了泛型函数 plot.ts() 支持

plot(Nile, main = "Flow of the River Nile")
autoplot(Nile, xlab = "Time", ylab = "Nile", main = "Flow of the River Nile") +
  theme_minimal()
时序图时序图

时序图 

highchart() %>%
  hc_xAxis(type = "datetime") %>%
  hc_add_series(data = Nile, name = "Nile")

可能需要研究下 highcharts.js 的 API https://api.highcharts.com/highcharts/series

methods(hchart)
##  [1] hchart.acf*        hchart.character*  hchart.data.frame* hchart.default*   
##  [5] hchart.density*    hchart.dist*       hchart.ets*        hchart.factor*    
##  [9] hchart.forecast*   hchart.histogram*  hchart.igraph*     hchart.list*      
## [13] hchart.matrix*     hchart.mforecast*  hchart.mts*        hchart.numeric*   
## [17] hchart.prcomp*     hchart.princomp*   hchart.stl*        hchart.survfit*   
## [21] hchart.tibble*     hchart.ts*         hchart.xts*       
## see '?methods' for accessing help and source code
getAnywhere(hchart.mts)
## A single object matching 'hchart.mts' was found
## It was found in the following places
##   registered S3 method for hchart from namespace highcharter
##   namespace:highcharter
## with value
## 
## function (object, ..., separate = TRUE, heights = rep(1, ncol(object))) 
## {
##     if (separate) {
##         hc <- hchart.mts2(object, heights = heights, ...)
##     }
##     else {
##         hc <- hchart.mts1(object, ...)
##     }
##     hc
## }
## <bytecode: 0x7fe9d6a671f8>
## <environment: namespace:highcharter>
class(EuStockMarkets)
## [1] "mts"    "ts"     "matrix"

为何不能绘制多元时间序列 EuStockMarkets zoo::as.Date.ts() 仅支持周期为 1、4 和 12 的时间序列，详见 说明

hchart(EuStockMarkets)
hchart(AirPassengers)
highchart() %>%
  hc_chart(type = "line") %>%
  hc_title(text = "Monthly Average Temperature") %>%
  hc_subtitle(text = "Source: WorldClimate.com") %>%
  hc_xAxis(categories = c(
    "Jan", "Feb", "Mar", "Apr", "May", "Jun",
    "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
  )) %>%
  hc_yAxis(title = list(text = "Temperature (C)")) %>%
  hc_plotOptions(line = list(
    dataLabels = list(enabled = TRUE),
    enableMouseTracking = FALSE
  )) %>%
  hc_series(
    list(
      name = "Tokyo",
      data = c(7.0, 6.9, 9.5, 14.5, 18.4, 21.5, 25.2, 26.5, 23.3, 18.3, 13.9, 9.6)
    ),
    list(
      name = "London",
      data = c(3.9, 4.2, 5.7, 8.5, 11.9, 15.2, 17.0, 16.6, 14.2, 10.3, 6.6, 4.8)
    )
  )

0.3 散点图

散点图，没有比散点图更能表达数据

highchart() |>
  hc_add_series(
    data = lapply(0:4, function(x) list(x, x + 1)),
    type = "scatter", color = "orange"
  )
purrr::map(0:4, function(x) list(x, x))
## [[1]]
## [[1]][[1]]
## [1] 0
## 
## [[1]][[2]]
## [1] 0
## 
## 
## [[2]]
## [[2]][[1]]
## [1] 1
## 
## [[2]][[2]]
## [1] 1
## 
## 
## [[3]]
## [[3]][[1]]
## [1] 2
## 
## [[3]][[2]]
## [1] 2
## 
## 
## [[4]]
## [[4]][[1]]
## [1] 3
## 
## [[4]][[2]]
## [1] 3
## 
## 
## [[5]]
## [[5]][[1]]
## [1] 4
## 
## [[5]][[2]]
## [1] 4

等价于

lapply(0:4, function(x) list(x, x + 1))
## [[1]]
## [[1]][[1]]
## [1] 0
## 
## [[1]][[2]]
## [1] 1
## 
## 
## [[2]]
## [[2]][[1]]
## [1] 1
## 
## [[2]][[2]]
## [1] 2
## 
## 
## [[3]]
## [[3]][[1]]
## [1] 2
## 
## [[3]][[2]]
## [1] 3
## 
## 
## [[4]]
## [[4]][[1]]
## [1] 3
## 
## [[4]][[2]]
## [1] 4
## 
## 
## [[5]]
## [[5]][[1]]
## [1] 4
## 
## [[5]][[2]]
## [1] 5

0.3.1 简单散点图

hchart(faithful, "scatter", hcaes(x = waiting, y = eruptions))
hchart(women, "scatter", hcaes(x = weight, y = height))

0.3.2 分组散点图

hchart(sleep, "scatter", hcaes(x = ID, y = extra, group = group))
hchart(Puromycin, "scatter", hcaes(x = conc, y = rate, group = state))
hchart(Orange, "scatter", hcaes(x = age, y = circumference, group = Tree))

0.4 条形图

本书中条形图和柱形图不再做区分，一般来讲，横着放叫条形图，否则就叫柱形图

0.4.1 简单条形图

严格来讲，条形图适合分类数据的展示

barplot(
  data = BOD, demand ~ Time, col = "#4285F4",
  border = "white", horiz = TRUE, xlim = c(0, 20)
)
ggplot(data = BOD, aes(x = factor(Time), y = demand)) +
  geom_col(fill = "#4285F4") +
  coord_flip() +
  theme_minimal() +
  labs(x = "Time")
条形图条形图

条形图 

# 条形图
hchart(BOD, "bar", hcaes(x = factor(Time), y = demand))
# 柱形图
hchart(BOD, "column", hcaes(x = factor(Time), y = demand), color = "#4285F4") %>%
  hc_xAxis(title = list(text = "Time"))

0.4.2 复合条形图

longer_VADeaths <- transform(
  expand.grid(
    sex = colnames(VADeaths),
    age = rownames(VADeaths)
  ),
  rates = as.vector(t(VADeaths))
)
hchart(longer_VADeaths, "column", hcaes(x = sex, y = rates, group = age))

0.4.3 简单箱线图

with(ToothGrowth, {
  hcboxplot(x = len, var = supp)
})
## Warning: 'hcboxplot' is deprecated.
## Use 'data_to_boxplot' instead.
## See help("Deprecated")
## Warning: `unite_()` was deprecated in tidyr 1.2.0.
## Please use `unite()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

0.4.4 复合箱线图

with(ToothGrowth, {
  hcboxplot(x = len, var = supp, var2 = dose, outliers = FALSE) %>%
    hc_chart(type = "column") # to put box vertical
})
## Warning: 'hcboxplot' is deprecated.
## Use 'data_to_boxplot' instead.
## See help("Deprecated")
## Warning in is.na(var2) || is.na(var): 'length(x) = 60 > 1' in coercion to
## 'logical(1)'

## Warning in is.na(var2) || is.na(var): 'length(x) = 60 > 1' in coercion to
## 'logical(1)'

0.5 动态散点图

highchart() %>%
  hc_chart(type = "scatter") %>%
  hc_yAxis(max = 6, min = 0) %>%
  hc_xAxis(max = 6, min = 0) %>%
  hc_add_series(
    name = "Australia",
    data = list(
      list(sequence = list(c(1, 1), c(2, 2), c(3, 3), c(4, 4)))
    )
  ) %>%
  hc_add_series(
    name = "United States",
    data = list(
      list(sequence = list(c(0, 0), c(3, 2), c(4, 3), c(4, 1)))
    )
  ) %>%
  hc_add_series(
    name = "China",
    data = list(
      list(sequence = list(c(3, 2), c(2, 2), c(1, 1), c(2, 5)))
    )
  ) %>%
  hc_motion(
    enabled = TRUE,
    labels = 2000:2003,
    series = c(0, 1, 2)
  )

0.6 气泡图

highchart() %>%
  hc_xAxis(min = 0, max = 10) %>%
  hc_yAxis(min = 0, max = 10) %>%
  hc_add_series(
    type = "bubble",
    name = "气泡图",
    data = list(
      list(x = 1, y = 1, z = 10)
    )
  )

0.7 动态气泡图

highchart() %>%
  hc_xAxis(min = 0, max = 10) %>%
  hc_yAxis(min = 0, max = 10) %>%
  hc_motion(enabled = TRUE) %>%
  hc_add_series(
    type = "bubble",
    data = list(
      list(
        sequence = list(
          list(x = 1, y = 1, z = 10),
          list(x = 2, y = 3, z = 5),
          list(x = 3, y = 5, z = 8)
        )
      )
    )
  )

0.8 动态柱状图

highchart() %>%
  hc_chart(type = "column") %>%
  hc_yAxis(max = 6, min = 0) %>%
  hc_add_series(name = "A", data = c(2, 3, 4), zIndex = -10) %>%
  hc_add_series(
    name = "B",
    data = list(
      list(sequence = c(1, 2, 3, 4)),
      list(sequence = c(3, 2, 1, 3)),
      list(sequence = c(2, 5, 4, 3))
    )
  ) %>%
  hc_add_series(
    name = "C",
    data = list(
      list(sequence = c(3, 2, 1, 3)),
      list(sequence = c(2, 5, 4, 3)),
      list(sequence = c(1, 2, 3, 4))
    )
  ) %>%
  hc_motion(
    enabled = TRUE,
    labels = 2000:2003,
    series = c(1, 2),
    playIcon = "fa fa-play",
    pauseIcon = "fa fa-pause"
  )

0.9 密度图

hchart(density(diamonds$price), type = "area", color = "#B71C1C", name = "Price")

0.10 直方图

hchart(diamonds$price, name = "price")

0.11 生存图

library(survival)
leukemia.surv <- survfit(Surv(time, status) ~ x, data = aml)
hchart(leukemia.surv, ranges = TRUE)

0.12 等高图

颜色等高图

hchart(volcano) %>%
  hc_colorAxis(stops = color_stops(colors = hcl.colors(10)))

0.13 相关图

hchart(cor(swiss))

0.14 矩阵图

library("treemap")
data(GNI2014)
treemap(GNI2014,
  index = c("continent", "iso3"),
  vSize = "population", vColor = "GNI",
  type = "comp", palette = hcl.colors(6),
  draw = TRUE
)

tm <- treemap(GNI2014,
  index = c("continent", "iso3"),
  vSize = "population", vColor = "GNI",
  type = "comp", palette = hcl.colors(6),
  draw = FALSE
)

hctreemap(tm, allowDrillToNode = TRUE, layoutAlgorithm = "squarified") %>%
  hc_title(text = "Gross National Income World Data") %>%
  hc_tooltip(pointFormat = "<b>{point.name}</b>:<br>
                             Pop: {point.value:,.0f}<br>
                             GNI: {point.valuecolor:,.0f}")
## Warning: 'hctreemap' is deprecated.
## Use 'data_to_hierarchical' instead.
## See help("Deprecated")
## Warning: `filter_()` was deprecated in dplyr 0.7.0.
## Please use `filter()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

考虑用 hctreemap2() 函数

hctreemap2(GNI2014,
  group_vars = c("continent", "iso3"),
  size_var = "population", color_var = "GNI",
  layoutAlgorithm = "squarified"
)
## Warning: 'hctreemap2' is deprecated.
## Use 'data_to_hierarchical' instead.
## See help("Deprecated")
library(RColorBrewer)

data.frame(
  index1 = sample(LETTERS[1:5], 500, replace = T),
  index2 = sample(LETTERS[6:10], 500, replace = T),
  index3 = sample(LETTERS[11:15], 500, replace = T),
  value = rpois(500, 5),
  color_value = rpois(500, 5)
) %>%
  hctreemap2(
    group_vars = c("index1", "index2", "index3"),
    size_var = "value",
    color_var = "color_value",
    layoutAlgorithm = "squarified",
    levelIsConstant = FALSE,
    levels = list(
      list(level = 1, dataLabels = list(enabled = TRUE)),
      list(level = 2, dataLabels = list(enabled = FALSE)),
      list(level = 3, dataLabels = list(enabled = FALSE))
    )
  ) %>%
  hc_colorAxis(
    minColor = brewer.pal(7, "Greens")[1],
    maxColor = brewer.pal(7, "Greens")[7]
  ) %>%
  hc_tooltip(pointFormat = "<b>{point.name}</b>:<br>
             Value: {point.value:,.0f}<br>
             Color Value: {point.colorValue:,.0f}")
## Warning: 'hctreemap2' is deprecated.
## Use 'data_to_hierarchical' instead.
## See help("Deprecated")

0.15 地图

美国失业率数据

data(unemployment, package = "highcharter")
temp <- unlist(strsplit(unemployment[, 2], ",")) # 拆成两列
unique(temp[seq(from = 2, to = length(temp), by = 2)]) # 51 个州
# US Counties unemployment rate
# code: The county code.
#
# name: The county name.
#
# value: The unemployment.
# A data.frame with 3 variables and 3216 observations.
data(unemployment)
hcmap("countries/us/us-all-all",
  data = unemployment,
  name = "Unemployment", value = "value", joinBy = c("hc-key", "code"),
  borderColor = "transparent"
) %>%
  hc_colorAxis(dataClasses = color_classes(c(seq(0, 10, by = 2), 50))) %>%
  hc_legend(
    layout = "vertical", align = "right",
    floating = TRUE, valueDecimals = 0, valueSuffix = "%"
  )

0.16 下钻图

drilldown 数据结构

options(highcharter.theme = hc_theme_smpl())

df <- data.frame(
  name = c("Animals", "Fruits", "Cars"),
  y = c(5, 2, 4)
)

df$drilldown <- tolower(df$name)

df
##      name y drilldown
## 1 Animals 5   animals
## 2  Fruits 2    fruits
## 3    Cars 4      cars
dfan <- data.frame(
  name = c("Cats", "Dogs", "Cows", "Sheep", "Pigs"),
  value = c(4, 3, 1, 2, 1)
)

dffru <- data.frame(
  name = c("Apple", "Organes"),
  value = c(4, 2)
)

dfcar <- data.frame(
  name = c("Toyota", "Opel", "Volkswagen"),
  value = c(4, 2, 2)
)

# 3 个数据集如何合并在一起，作为一个 data.frame 被使用

下面绘图代码很不简洁

hc <- highchart() %>%
  hc_chart(type = "column") %>%
  hc_title(text = "学员基础画像") %>%
  hc_xAxis(type = "category") %>%
  hc_legend(enabled = FALSE) %>%
  hc_plotOptions(
    series = list(
      boderWidth = 0,
      dataLabels = list(enabled = TRUE)
    )
  ) %>%
  hc_add_series(
    data = df,
    name = "Things",
    colorByPoint = TRUE
  ) %>%
  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = list(
      list(
        id = "animals",
        data = list_parse2(dfan)
      ),
      list(
        id = "fruits",
        data = list_parse2(dffru)
      ),
      list(
        id = "cars",
        data = list_parse2(dfcar)
      )
    )
  )

hc

0.17 堆积图

Joshua Kunst 在他的博客里 https://jkunst.com/ 补充了很多数据可视化案例，另一个关键的参考资料是 highcharts API 文档，文档主要分两部分全局选项 Highcharts.setOptions 和绘图函数 Highcharts.chart。下面以 data_to_boxplot() 为例解析 R 中的数据结构是如何和 highcharts 的 JSON 以及绘图函数对应的。

library(highcharter)
highchart() %>%
  hc_xAxis(type = "category") %>%
  hc_add_series_list(x = data_to_boxplot(
    data = iris,
    variable = Sepal.Length,
    group_var = Species,
    add_outliers = TRUE,
    name = "iris"
  ))

两种从数据到图形的映射方式

除了箱线图 boxplot 还有折线图、条形图、密度图等一系列常用图形，共计 50 余种，详见表@ref(tab:hc-charts)，各类图形示例见 https://www.highcharts.com/demo。

图形种类
A B C D E
area columnrange item pyramid3d treemap
arearange cylinder line sankey variablepie
areaspline dependencywheel lollipop scatter variwide
areasplinerange dumbbell networkgraph scatter3d vector
bar errorbar organization solidgauge venn
bellcurve funnel packedbubble spline waterfall
boxplot funnel3d pareto streamgraph windbarb
bubble gauge pie sunburst wordcound
column heatmap polygon tilemap xrange
columnpyramid histogram pyramid timeline NA 
library(highcharter)
hchart(
  iris, "scatter",
  hcaes(x = Sepal.Length, y = Sepal.Width, group = Species)
)

有的图形种类包含多个变体，如 area 面积图，还有 arearange 、areaspline 和 areasplinerange，而 area 图其实是折线图，只是线与坐标轴围成的区域用颜色填充了。一个基本示例见基础面积图，数据结构如下：

Highcharts.chart('container', {
    chart: {
        type: 'area'
    },
    accessibility: {
        description: 'Image description: An area chart compares the nuclear stockpiles of the USA and the USSR/Russia between 1945 and 2017. The number of nuclear weapons is plotted on the Y-axis and the years on the X-axis. The chart is interactive, and the year-on-year stockpile levels can be traced for each country. The US has a stockpile of 6 nuclear weapons at the dawn of the nuclear age in 1945. This number has gradually increased to 369 by 1950 when the USSR enters the arms race with 6 weapons. At this point, the US starts to rapidly build its stockpile culminating in 32,040 warheads by 1966 compared to the USSR’s 7,089. From this peak in 1966, the US stockpile gradually decreases as the USSR’s stockpile expands. By 1978 the USSR has closed the nuclear gap at 25,393. The USSR stockpile continues to grow until it reaches a peak of 45,000 in 1986 compared to the US arsenal of 24,401. From 1986, the nuclear stockpiles of both countries start to fall. By 2000, the numbers have fallen to 10,577 and 21,000 for the US and Russia, respectively. The decreases continue until 2017 at which point the US holds 4,018 weapons compared to Russia’s 4,500.'
    },
    title: {
        text: 'US and USSR nuclear stockpiles'
    },
    subtitle: {
        text: 'Sources: <a href="https://thebulletin.org/2006/july/global-nuclear-stockpiles-1945-2006">' +
            'thebulletin.org</a> &amp; <a href="https://www.armscontrol.org/factsheets/Nuclearweaponswhohaswhat">' +
            'armscontrol.org</a>'
    },
    xAxis: {
        allowDecimals: false,
        labels: {
            formatter: function () {
                return this.value; // clean, unformatted number for year
            }
        },
        accessibility: {
            rangeDescription: 'Range: 1940 to 2017.'
        }
    },
    yAxis: {
        title: {
            text: 'Nuclear weapon states'
        },
        labels: {
            formatter: function () {
                return this.value / 1000 + 'k';
            }
        }
    },
    tooltip: {
        pointFormat: '{series.name} had stockpiled <b>{point.y:,.0f}</b><br/>warheads in {point.x}'
    },
    plotOptions: {
        area: {
            pointStart: 1940,
            marker: {
                enabled: false,
                symbol: 'circle',
                radius: 2,
                states: {
                    hover: {
                        enabled: true
                    }
                }
            }
        }
    },
    series: [{
        name: 'USA',
        data: [
            null, null, null, null, null, 6, 11, 32, 110, 235,
            369, 640, 1005, 1436, 2063, 3057, 4618, 6444, 9822, 15468,
            20434, 24126, 27387, 29459, 31056, 31982, 32040, 31233, 29224, 27342,
            26662, 26956, 27912, 28999, 28965, 27826, 25579, 25722, 24826, 24605,
            24304, 23464, 23708, 24099, 24357, 24237, 24401, 24344, 23586, 22380,
            21004, 17287, 14747, 13076, 12555, 12144, 11009, 10950, 10871, 10824,
            10577, 10527, 10475, 10421, 10358, 10295, 10104, 9914, 9620, 9326,
            5113, 5113, 4954, 4804, 4761, 4717, 4368, 4018
        ]
    }, {
        name: 'USSR/Russia',
        data: [null, null, null, null, null, null, null, null, null, null,
            5, 25, 50, 120, 150, 200, 426, 660, 869, 1060,
            1605, 2471, 3322, 4238, 5221, 6129, 7089, 8339, 9399, 10538,
            11643, 13092, 14478, 15915, 17385, 19055, 21205, 23044, 25393, 27935,
            30062, 32049, 33952, 35804, 37431, 39197, 45000, 43000, 41000, 39000,
            37000, 35000, 33000, 31000, 29000, 27000, 25000, 24000, 23000, 22000,
            21000, 20000, 19000, 18000, 18000, 17000, 16000, 15537, 14162, 12787,
            12600, 11400, 5500, 4512, 4502, 4502, 4500, 4500
        ]
    }]
});

对应到 R 包 highcharter 中，绘图代码如下：

library(highcharter)
options(highcharter.theme = hc_theme_hcrt(tooltip = list(valueDecimals = 2)))

usa <- ts(
  data = c(
    NA, NA, NA, NA, NA, 6, 11, 32, 110, 235,
    369, 640, 1005, 1436, 2063, 3057, 4618, 6444, 9822, 15468,
    20434, 24126, 27387, 29459, 31056, 31982, 32040, 31233, 29224, 27342,
    26662, 26956, 27912, 28999, 28965, 27826, 25579, 25722, 24826, 24605,
    24304, 23464, 23708, 24099, 24357, 24237, 24401, 24344, 23586, 22380,
    21004, 17287, 14747, 13076, 12555, 12144, 11009, 10950, 10871, 10824,
    10577, 10527, 10475, 10421, 10358, 10295, 10104, 9914, 9620, 9326,
    5113, 5113, 4954, 4804, 4761, 4717, 4368, 4018
  ),
  start = 1940, end = 2017
)

russia <- ts(
  data = c(
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
    5, 25, 50, 120, 150, 200, 426, 660, 869, 1060,
    1605, 2471, 3322, 4238, 5221, 6129, 7089, 8339, 9399, 10538,
    11643, 13092, 14478, 15915, 17385, 19055, 21205, 23044, 25393, 27935,
    30062, 32049, 33952, 35804, 37431, 39197, 45000, 43000, 41000, 39000,
    37000, 35000, 33000, 31000, 29000, 27000, 25000, 24000, 23000, 22000,
    21000, 20000, 19000, 18000, 18000, 17000, 16000, 15537, 14162, 12787,
    12600, 11400, 5500, 4512, 4502, 4502, 4500, 4500
  ),
  start = 1940, end = 2017
)

unit_format <- JS("function(){
  return this.value / 10000 + 'M';
}")

highchart() %>%
  hc_xAxis(type = "datetime") %>%
  hc_yAxis(
    title = list(text = "Nuclear weapon states"),
    labels = list(formatter = unit_format)
  ) %>%
  hc_title(text = "US and USSR nuclear stockpiles") %>%
  hc_subtitle(text = paste(
    'Sources: <a href="https://thebulletin.org/2006/july/global-nuclear-stockpiles-1945-2006">',
    'thebulletin.org</a> &amp; <a href="https://www.armscontrol.org/factsheets/Nuclearweaponswhohaswhat">',
    "armscontrol.org</a>"
  )) %>%
  hc_add_series(data = russia, type = "area", name = "USSR/Russia") %>%
  hc_add_series(data = usa, type = "area", name = "USA") %>%
  hc_exporting(
    enabled = TRUE,
    filename = paste(Sys.Date(), "nuclear", sep = "-")
  )

1940年至2017年美国和俄罗斯核武器数量变化

可以看出来，JS API 文档里 chart -> plotOptions 对应于 R 包 API 的 hc_plotOptions() 函数，hchart() 函数对应于 https://api.highcharts.com/highcharts/series ，为了绘图方便起见，作者还直接支持 R 中一些数据对象，比如数据框 data.frame 和时间序列 ts 等，完整的支持列表见：

library(highcharter)
methods(hchart)
##  [1] hchart.acf*        hchart.character*  hchart.data.frame* hchart.default*   
##  [5] hchart.density*    hchart.dist*       hchart.ets*        hchart.factor*    
##  [9] hchart.forecast*   hchart.histogram*  hchart.igraph*     hchart.list*      
## [13] hchart.matrix*     hchart.mforecast*  hchart.mts*        hchart.numeric*   
## [17] hchart.prcomp*     hchart.princomp*   hchart.stl*        hchart.survfit*   
## [21] hchart.tibble*     hchart.ts*         hchart.xts*       
## see '?methods' for accessing help and source code

更多 API 细节描述见 https://jkunst.com/highcharter/articles/modules.html。 桑基图描述能量的流动 1

library(jsonlite)
# 转化为 JSON 格式的字符串
dat <- toJSON(data.frame(
  from = c("AT", "DE", "CH", "DE"),
  to = c("DE", "CH", "DE", "FI"),
  weight = c(10, 5, 15, 5)
))

highchart() %>%
  hc_chart(type = "sankey") %>%
  hc_add_series(data = dat)

桑基图

此外，highcharter 提供 highchartOutput() 和 renderHighchart() 函数支持在 shiny 中使用 highcharts 图形。

library(shiny)
library(highcharter)

shinyApp(
  ui = fluidPage(
    highchartOutput("plot_hc")
  ),
  server = function(input, output) {
    output$plot_hc <- renderHighchart({
      hchart(PlantGrowth, "area", hcaes(y = weight, group = group))
    })
  }
)

借助 htmlwidgets 和 reactR 创建新的基于 JS 库的 R 包，这样就快速将可视化图形库赋能 R 环境，关于网页可视化，JS 一定是优于 R 的，毕竟人家是专业前端工具，我们做的就是快速套模板，让 R 数据操作和分析的结果以非常精美的方式展现出来。这里有一篇基于 reactR 框架引入 React.js 衍生 JS 库到 R 环境中的资料 https://github.com/react-R/nivocal，一读就懂，非常适合上手。

点击图例隐藏某一类别，可以看到图形纵轴会自适应展示区域的大小，这个特性对于所有图形都是支持的。

library(highcharter)
# 折线图
hchart(sleep, "line", hcaes(ID, extra, group = group))

折线图 

# 堆积区域图
# 堆积折线图

0.18 动画

highcharter 的依赖很重，数据接口比较原始，很难用

动态条形图

library(highcharter)
library(idbr)
library(purrr)
library(dplyr) # 未来替代一下

# the US Census Bureau International Data Base API
# 美国人口普查局国际数据库 API
idb_api_key("YOUR_DATA_KEY")
yrs <- seq(1980, 2030, by = 5)

df <- map_dfr(c("male", "female"), function(sex) {
  transform(get_idb("US", yrs, sex = sex), sex_label = sex)
})

df <- df %>%
  transform(population = pop * ifelse(sex_label == "male", -1, 1))

# 数据变换
series <- df %>%
  group_by(sex_label, age) %>%
  do(data = list(sequence = .$population)) %>%
  ungroup() %>%
  group_by(sex_label) %>%
  do(data = .$data) %>%
  mutate(name = sex_label) %>%
  list_parse()

maxpop <- max(abs(df$population))

xaxis <- list(
  categories = sort(unique(df$age)),
  reversed = FALSE, tickInterval = 5,
  labels = list(step = 5)
)

highchart() %>%
  hc_chart(type = "bar") %>%
  hc_motion(
    enabled = TRUE,
    labels = yrs,
    series = c(0, 1),
    autoplay = TRUE,
    updateInterval = 10,
    playIcon = "fa fa-play",
    pauseIcon = "fa fa-pause"
  ) %>%
  hc_add_series_list(series) %>%
  hc_plotOptions(
    series = list(stacking = "normal"),
    bar = list(groupPadding = 0, pointPadding = 0, borderWidth = 0)
  ) %>%
  hc_tooltip(
    shared = FALSE,
    formatter = JS("
      function() {
          return '<b>' + this.series.name +
              ', age ' + this.point.category +
              '</b><br/>' + 'Population: ' +
              Highcharts.numberFormat(Math.abs(this.point.y), 0);
      }
   ")
  ) %>%
  hc_yAxis(
    labels = list(
      formatter = JS("
        function() {
            return Math.abs(this.value) / 1000000 + 'M';
        }
      ")
    ),
    tickInterval = 0.5e6,
    min = -maxpop,
    max = maxpop
  ) %>%
  hc_xAxis(
    xaxis,
    rlist::list.merge(xaxis, list(opposite = TRUE, linkedTo = 0))
  )

  1. https://antv-2018.alipay.com/zh-cn/vis/chart/sankey.html↩︎