Highcharter包绘制交互式图表

R语言Highcharter包绘制交互式图表

highcharter包是一个用于在R语言中创建交互式高级图表的包。它建立在highcharts.js库之上，允许用户使用R语言轻松地创建各种类型的图表，包括线图、柱状图、饼图、散点图等。highcharter提供了丰富的配置选项，使用户可以定制图表的外观和交互性，包括添加标签、工具提示、动画效果等。此外，highcharter还支持响应式设计，可以在不同设备上自动调整图表的大小和布局。通过highcharter包，用户可以创建具有专业外观和交互性的图表，用于数据可视化和展示。

基本配置

修改全局语言为中文

library(highcharter)
options(highcharter.lang = list(
  contextButtonTitle = "图表上下文菜单",
  decimalPoint = ".",
  downloadCSV = "下载CSV",
  downloadJPEG = "下载JPEG图片",
  downloadPDF = "下载PDF文档",
  downloadPNG = "下载PNG图片",
  downloadSVG = "下载SVG矢量图",
  downloadXLS = "下载XLS",
  drillUpText = "<U+25C1> 返回到 {series.name}",
  exitFullscreen = "退出全屏",
  exportData = list(
    annotationHeader = "注释",
    categoryDatetimeHeader = "日期时间",
    categoryHeader = "类别"
  ),
  hideData = "隐藏数据表",
  invalidDate = NULL,
  loading = "加载中...",
  months = c("一月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "十一月", "十二月"),
  noData = "无数据显示",
  numericSymbolMagnitude = 1000,
  numericSymbols = c("千", "百万", "十亿", "兆", "千兆", "艾克"),
  printChart = "打印图表",
  resetZoom = "重置缩放",
  resetZoomTitle = "重置缩放至原始比例",
  shortMonths = c("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月"),
  shortWeekdays = c("周六", "周日", "周一", "周二", "周三", "周四", "周五"),
  thousandsSep = " ",
  viewData = "查看数据表",
  viewFullscreen = "全屏查看",
  weekdays = c("星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六")
))

常用布局

dtemp <- data.frame(
  month = month.abb,
  tokyo = rnorm(12, 10, 2),
  new_york = rnorm(12, 10, 2),
  berlin = rnorm(12, 12, 3),
  london = rnorm(12, 11, 5)
)
highchart() %>%
  hc_title(text = "主标题") %>%
  hc_subtitle(text = "副标题") %>%
  hc_caption(text = "图表说明或描述,<b>可用html</b>语法") %>%
  hc_credits(
    text = "右下脚注", href = "https://notjustbi.rbind.io/",
    enabled = TRUE
  ) %>%
  hc_yAxis(title = list(text = "X轴标题")) %>%
  hc_xAxis(title = list(text = "Y轴标题")) %>%
  ### 自定义坐标轴标签
  hc_xAxis(categories = dtemp$month) %>%
  hc_add_series(name = "自定义系列名称", data = dtemp$tokyo) %>%
  hc_add_series(name = "London", data = dtemp$london) %>%
  hc_add_series(name = "Berlin", data = dtemp$berlin)

基本图表

散点图

library(tidyverse)

iris %>%
  hchart(
    "scatter",
    hcaes(x = Sepal.Length, y = Sepal.Width, group = Species)
  ) %>%
  hc_title(
    text = "Iris 数据集中花萼长度与花萼宽度的关系",
    margin = 20,
    align = "left",
    style = list(color = "#22A884", useHTML = TRUE)
  ) %>%
  hc_xAxis(
    title = list(text = "花萼长度"),
    alternateGridColor = "#FDFFD5",
    opposite = FALSE,
    plotLines = list(list(
      label = list(text = "辅助竖线"),
      color = "#FF0000",
      width = 2,
      value = 5.5
    ))
  ) %>%
  hc_yAxis(title = list(text = "花萼宽度")) %>%
  hc_exporting(enabled = TRUE) ## 添加工具栏

柱状图

水平柱状图

iris %>%
  group_by(Species) %>%
  summarise(Sepal.Length.Max = max(Sepal.Length)) %>%
  hchart("bar", hcaes(x = Species, y = Sepal.Length.Max), color = "#17b8b6")

垂直柱状图

iris %>%
  group_by(Species) %>%
  summarise(Sepal.Length.Max = max(Sepal.Length)) %>%
  hchart("column", hcaes(x = Species, y = Sepal.Length.Max), color = "#17b8b6")

时间序列

library(forecast)

airforecast <- forecast(auto.arima(AirPassengers), level = 95)

hchart(airforecast)

股票

library(quantmod)

x <- getSymbols("GOOG", auto.assign = FALSE)
y <- getSymbols("AMZN", auto.assign = FALSE)

highchart(type = "stock") %>%
  hc_add_series(x) %>%
  hc_add_series(y, type = "ohlc")

树图

library(dplyr)
data(pokemon)

lvl_opts <- list(
  list(
    level = 1,
    borderWidth = 0,
    borderColor = "transparent",
    dataLabels = list(
      enabled = TRUE,
      align = "left",
      verticalAlign = "top",
      style = list(
        fontSize = "12px",
        textOutline = FALSE,
        color = "white",
        fontWeight = "normal"
      )
    )
  ),
  list(
    level = 2,
    borderWidth = 0,
    borderColor = "transparent",
    colorVariation = list(key = "brightness", to = 0.250),
    dataLabels = list(enabled = FALSE),
    style = list(
      fontSize = "8px",
      textOutline = FALSE,
      color = "white",
      fontWeight = "normal"
    )
  )
)

pkmn_min <- pokemon %>%
  select(type_1, type_2, type_1_color) %>%
  mutate(type_1 = stringr::str_to_title(type_1)) %>%
  mutate(type_2 = ifelse(is.na(type_2), type_1, paste(type_1, "-", type_2))) %>%
  mutate(val = 1)

cols <- pkmn_min %>%
  count(type_1, type_2, type_1_color, sort = TRUE) %>%
  pull(type_1_color) %>%
  unique()

hchart(
  data_to_hierarchical(pkmn_min, c(type_1, type_2), val, colors = cols),
  type = "treemap",
  ## levelIsConstant = FALSE,
  allowDrillToNode = TRUE,
  levels = lvl_opts,
  tooltip = list(valueDecimals = FALSE)
) %>%
  hc_chart(
    style = list(fontFamily = "Gloria Hallelujah")
  ) %>%
  hc_title(
    text = "Gotta Catch 'Em All!",
    style = list(fontFamily = "Gloria Hallelujah")
  ) %>%
  hc_size(height = 700)

热图

data(vaccines)

fntltp <- JS("function(){
  return this.point.x + ' ' +  this.series.yAxis.categories[this.point.y] + ': ' +
  Highcharts.numberFormat(this.point.value, 2);
}")

plotline <- list(
  color = "#fde725", value = 1963, width = 2, zIndex = 5,
  label = list(
    text = "Vaccine Intoduced", verticalAlign = "top",
    style = list(color = "#606060"), textAlign = "left",
    rotation = 0, y = -5
  )
)

hchart(
  vaccines,
  "heatmap",
  hcaes(
    x = year,
    y = state,
    value = count
  )
) %>%
  hc_colorAxis(
    stops = color_stops(10, viridisLite::inferno(10, direction = -1)),
    type = "logarithmic"
  ) %>%
  hc_yAxis(
    title = list(text = ""),
    reversed = TRUE,
    offset = -20,
    tickLength = 0,
    gridLineWidth = 0,
    minorGridLineWidth = 0,
    labels = list(style = list(fontSize = "9px"))
  ) %>%
  hc_tooltip(
    formatter = fntltp
  ) %>%
  hc_xAxis(
    plotLines = list(plotline)
  ) %>%
  hc_title(
    text = "Infectious Diseases and Vaccines"
  ) %>%
  hc_subtitle(
    text = "Number of cases per 100,000 people"
  ) %>%
  hc_legend(
    layout = "horizontal",
    verticalAlign = "top",
    align = "left",
    valueDecimals = 0
  ) %>%
  hc_size(height = 900)

地图

data(GNI2014, package = "treemap")

hcmap(
  "custom/world-robinson-lowres",
  data = GNI2014,
  name = "Gross national income per capita",
  value = "GNI",
  borderWidth = 0,
  nullColor = "#d3d3d3",
  joinBy = c("iso-a3", "iso3")
) %>%
  hc_colorAxis(
    stops = color_stops(colors = viridisLite::inferno(10, begin = 0.1)),
    type = "logarithmic"
  )

高级功能

自定义工具提示

趋势图

data(gapminder, package = "gapminder")

gp <- gapminder %>%
  arrange(desc(year)) %>%
  distinct(country, .keep_all = TRUE)

gp2 <- gapminder %>%
  nest(-country) %>%
  mutate(
    data = map(data, mutate_mapping, hcaes(x = lifeExp, y = gdpPercap), drop = TRUE),
    data = map(data, list_parse)
  ) %>%
  rename(ttdata = data)

gptot <- left_join(gp, gp2)

hc <- hchart(
  gptot,
  "point",
  hcaes(
    lifeExp,
    gdpPercap,
    name = country,
    size = pop,
    group = continent
  )
) %>%
  hc_yAxis(type = "logarithmic")

hc %>%
  hc_tooltip(useHTML = TRUE, pointFormatter = tooltip_chart(accesor = "ttdata"))

多行工具提示

library(highcharter)
data(weather)

x <- c("Min", "Mean", "Max")
y <- sprintf("{point.%s}°", c("min_temperaturec", "mean_temperaturec", "max_temperaturec"))

tltip <- tooltip_table(x, y)

hchart(
  weather,
  type = "columnrange",
  hcaes(
    x = date,
    low = min_temperaturec,
    high = max_temperaturec,
    color = mean_temperaturec
  )
) %>%
  hc_chart(
    polar = TRUE
  ) %>%
  hc_yAxis(
    max = 30,
    min = -10,
    labels = list(format = "{value} C"),
    showFirstLabel = FALSE
  ) %>%
  hc_xAxis(
    title = list(text = ""),
    gridLineWidth = 0.5,
    labels = list(format = "{value: %b}")
  ) %>%
  hc_tooltip(
    useHTML = TRUE,
    pointFormat = tltip,
    headerFormat = as.character(tags$small("{point.x:%d %B, %Y}"))
  ) %>%
  hc_title(
    text = "Climatical characteristics of San Francisco"
  ) %>%
  hc_size(
    height = 600
  )

钻取

df <- tibble(
  name = c("Animals", "Fruits"),
  y = c(5, 2),
  drilldown = tolower(name)
)


hc <- highchart() %>%
  hc_title(text = "Basic drilldown") %>%
  hc_xAxis(type = "category") %>%
  hc_legend(enabled = FALSE) %>%
  hc_plotOptions(
    series = list(
      boderWidth = 0,
      dataLabels = list(enabled = TRUE)
    )
  ) %>%
  hc_add_series(
    data = df,
    type = "column",
    hcaes(name = name, y = y),
    name = "Things",
    colorByPoint = TRUE
  )

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


dsan <- list_parse2(dfan)

dsfru <- list_parse2(dffru)

hc <- hc %>%
  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = list(
      list(
        id = "animals",
        data = dsan
      ),
      list(
        id = "fruits",
        data = dsfru
      )
    )
  )

hc

组合

data(favorite_bars)
data(favorite_pies)

highchart() %>%
  ## Data
  hc_add_series(
    favorite_pies,
    "column",
    hcaes(
      x = pie,
      y = percent
    ),
    name = "Pie"
  ) %>%
  hc_add_series(
    favorite_bars,
    "pie",
    hcaes(
      name = bar,
      y = percent
    ),
    name = "Bars"
  ) %>%
  ## Options for each type of series
  hc_plotOptions(
    series = list(
      showInLegend = FALSE,
      pointFormat = "{point.y}%",
      colorByPoint = TRUE
    ),
    pie = list(
      center = c("30%", "10%"),
      size = 120,
      dataLabels = list(enabled = FALSE)
    )
  ) %>%
  ## Axis
  hc_yAxis(
    title = list(text = "percentage of tastiness"),
    labels = list(format = "{value}%"),
    max = 100
  ) %>%
  hc_xAxis(
    categories = favorite_pies$pie
  ) %>%
  ## Titles, subtitle, caption and credits
  hc_title(
    text = "How I Met Your Mother: Pie Chart Bar Graph"
  ) %>%
  hc_subtitle(
    text = "This is a bar graph describing my favorite pies
    including a pie chart describing my favorite bars"
  ) %>%
  hc_caption(
    text = "The values represented are in percentage of tastiness and awesomeness."
  ) %>%
  hc_credits(
    enabled = TRUE, text = "Source: HIMYM",
    href = "https://www.youtube.com/watch?v=f_J8QU1m0Ng",
    style = list(fontSize = "12px")
  ) %>%
  hc_size(
    height = 600
  )

轴分组

mpgg <- mpg %>%
  filter(!manufacturer %in% c("volkswagen", "chevrolet")) %>%
  filter(class %in% c("compact", "midsize", "subcompact")) %>%
  group_by(class, manufacturer) %>%
  summarize(count = n()) %>%
  ungroup()

categories_grouped <- mpgg %>%
  select(class, manufacturer) %>%
  group_by(name = class) %>%
  summarise(categories = list(manufacturer)) %>%
  list_parse()

hchart(
  mpgg,
  "column",
  name = "Cars",
  hcaes(y = count)
) %>%
  hc_xAxis(
    ## specify the grouped categories
    categories = categories_grouped,
    ## styling a little bit
    labels = list(style = list(fontSize = "10px"))
  ) %>%
  hc_add_dependency("plugins/grouped-categories.js")

拖动点

set.seed(123)

df <- tibble(x = runif(10), y = runif(10), z = runif(10), name = paste("cat", 1:10))

hchart(
  df,
  "bubble",
  hcaes(x = x, y = y),
  ## showInLegend = TRUE,
  name = "You can move the points",
  cursor = "move",
  dragDrop = list(
    draggableX = TRUE,
    draggableY = TRUE
  )
) %>%
  hc_add_dependency("modules/draggable-points.js")

回归线

data(penguins, package = "palmerpenguins")
penguins <- penguins[complete.cases(penguins), ]
hchart(
  penguins,
  "scatter",
  hcaes(x = flipper_length_mm, y = bill_length_mm, group = species),
  regression = TRUE
) %>%
  hc_colors(c("#d35400", "#2980b9", "#2ecc71")) %>%
  hc_add_dependency("plugins/highcharts-regression.js")

分区颜色

library(dplyr)

set.seed(123)

n <- 200

colors <- sample(viridisLite::cividis(5, end = .9))

df <- tibble(
  x = 1:n,
  y = abs(arima.sim(n = n, model = list(ar = c(0.9)))) + 2,
  y2 = 10 + y,
  col = rep(colors, each = n / 10, length.out = n)
)

hchart(df, "coloredarea", hcaes(x, y, segmentColor = col)) %>%
  hc_add_series(df, "coloredline", hcaes(x, y2, segmentColor = col)) %>%
  hc_add_dependency("plugins/multicolor_series.js")