如何用R的Highcharts优雅创建高质量小提琴图？

问题概述 #

使用Highcharts（通过R的highcharter包）制作小提琴图时，当前实现将箱线组件拆分为多个独立系列，导致悬停Tooltip无法正常显示系列信息；同时需要将图表优化至出版级质量，包括数值保留两位小数，并希望了解其他实现方式。

一、优化现有代码 #

核心修改点 #

1. 统一系列关联与Tooltip配置：将箱线、须线等组件关联到对应小提琴的主系列，启用鼠标跟踪，自定义Tooltip模板显示分位数信息。
2. 数值格式化：对分位数、密度数据统一保留两位小数，确保图表精度。
3. 修复代码缺陷：补充缺失的颜色定义，修正循环逻辑错误，简化冗余代码。

修改后的完整代码 #

library(tidyverse)
library(highcharter)

# 创建测试数据（设置随机种子保证结果可复现）
set.seed(123)
input <- tibble(type = rep(c(1, 2, 3), 5),
                value = rnorm(15, 0.1))

# 定义出版级配色
primary_colours <- list("#7cb5ec")

# 预处理小提琴图数据
prepare_violin <- function(data) {
  lapply(names(data), function(name) {
    series <- data[[name]]
    index <- match(name, names(data)) - 1
    density <- density(series)
    multiplier <- 1 / (2.5 * max(density$y))
    # 保留两位小数
    cbind(round(density$x, 2), 
          round(-multiplier * density$y + index, 4), 
          round(multiplier * density$y + index, 4))
  }) %>% setNames(names(data))
}

# 生成优化后的小提琴图
plot_violin <- function(data) {
  hc <- highchart() %>%
    hc_chart(inverted = TRUE) %>%
    hc_plotOptions(
      areasplinerange = list(linecap = 'square'),
      tooltip = list(
        formatter = JS("function() {
          let seriesName = this.series.options.originalName || 'Series';
          let tooltipText = `<b>${seriesName}</b><br/>`;
          if (this.point.options.values) {
            this.point.options.values.forEach(v => {
              tooltipText += `${v.label}: ${v.value.toFixed(2)}<br/>`;
            });
          } else if (this.low !== undefined) {
            tooltipText += `Density Range: ${this.low.toFixed(2)} - ${this.high.toFixed(2)}`;
          }
          return tooltipText;
        }")
      )
    ) %>%
    hc_yAxis(
      type = 'category',
      min = 0,
      max = length(data) - 1,
      tickLength = 0,
      categories = names(data),
      labels = list(useHTML = TRUE, align = 'left', reserveSpace = TRUE),
      lineWidth = 0,
      lineColor = 'transparent'
    ) %>%
    hc_legend(enabled = FALSE)
  
  densities <- prepare_violin(data)
  delta <- 0.1
  
  for (name in names(data)) {
    i <- match(name, names(data))
    series_data <- data[[name]]
    quantiles <- quantile(series_data, c(0.05, 0.25, 0.5, 0.75, 0.95)) %>% 
      round(2) %>% as.numeric()
    
    # 添加小提琴曲线（主系列）
    hc <- hc %>% hc_add_series(
      data = densities[[name]],
      type = 'areasplinerange',
      name = paste("Type", name),
      originalName = paste("Type", name),
      color = primary_colours[[1]],
      lineColor = 'black',
      lineWidth = 1
    )
    
    # 添加须线（关联主系列）
    whisker_data <- cbind(c(quantiles[1], quantiles[5]), rep(i-1, 2)) %>% round(2)
    hc <- hc %>% hc_add_series(
      data = whisker_data,
      type = 'line',
      marker = list(enabled = FALSE),
      color = 'black',
      lineWidth = 2,
      linkedTo = i-1, # 关联到对应小提琴主系列
      originalName = paste("Type", name),
      pointOptions = list(
        values = list(
          list(label = "5th Percentile", value = quantiles[1]),
          list(label = "95th Percentile", value = quantiles[5])
        )
      )
    )
    
    # 添加箱线矩形（关联主系列）
    box_left <- cbind(c(quantiles[2], quantiles[3]), 
                      c(i-1 - delta, i-1 - delta), 
                      c(i-1 + delta, i-1 + delta)) %>% round(2)
    box_left <- rbind(c(quantiles[2], i-1, i-1), box_left, c(quantiles[3], i-1, i-1))
    
    box_right <- cbind(c(quantiles[3], quantiles[4]), 
                       c(i-1 - delta, i-1 - delta), 
                       c(i-1 + delta, i-1 + delta)) %>% round(2)
    box_right <- rbind(c(quantiles[3], i-1, i-1), box_right, c(quantiles[4], i-1, i-1))
    
    hc <- hc %>% 
      hc_add_series(
        data = box_left,
        type = 'areasplinerange',
        color = "white",
        fillOpacity = 1,
        lineColor = 'black',
        lineWidth = 1,
        zIndex = 5,
        linkedTo = i-1,
        originalName = paste("Type", name),
        pointOptions = list(
          values = list(
            list(label = "25th Percentile", value = quantiles[2]),
            list(label = "Median", value = quantiles[3])
          )
        )
      ) %>%
      hc_add_series(
        data = box_right,
        type = 'areasplinerange',
        color = "white",
        fillOpacity = 1,
        lineColor = 'black',
        lineWidth = 1,
        zIndex = 5,
        linkedTo = i-1,
        originalName = paste("Type", name),
        pointOptions = list(
          values = list(
            list(label = "Median", value = quantiles[3]),
            list(label = "75th Percentile", value = quantiles[4])
          )
        )
      )
  }
  
  hc
}

# 生成图表
input %>% 
  group_by(type) %>%
  group_map(~ setNames(list(.x$value), as.character(.y$type))) %>%
  unlist(recursive = FALSE) %>%
  plot_violin()

优化说明 #

• Tooltip修复：通过linkedTo参数将所有子系列（须线、箱线）关联到主小提琴系列，自定义Tooltip模板显示分位数名称和格式化后的数值。
• 数值格式化：所有计算数据（密度、分位数）均通过round()保留两位小数，Tooltip中也强制格式化显示两位小数。
• 出版级细节：统一线条颜色、宽度，设置白色箱线填充，调整z-index保证箱线覆盖在小提琴曲线上方。

二、其他Highcharts小提琴图实现方法 #

1. 使用Highcharts官方小提琴扩展 #

Highcharts提供了官方的violin系列类型，highcharter可直接调用，无需手动构建密度曲线和箱线：

highchart() %>%
  hc_add_series(
    data = input %>% group_by(type) %>% summarise(data = list(value)),
    type = "violin",
    name = "Value",
    tooltip = list(valueDecimals = 2)
  ) %>%
  hc_yAxis(categories = unique(input$type)) %>%
  hc_chart(inverted = TRUE)

注：需确保highcharter版本支持该系列类型，若不支持可手动加载Highcharts扩展脚本。

2. 结合箱线图与密度曲线 #

利用Highcharts的boxplot系列展示分位数，叠加areaspline系列展示密度曲线，实现简化版小提琴图：

# 预处理箱线数据
box_data <- input %>%
  group_by(type) %>%
  summarise(
    q0 = quantile(value, 0),
    q5 = quantile(value, 0.05),
    q25 = quantile(value, 0.25),
    q50 = quantile(value, 0.5),
    q75 = quantile(value, 0.75),
    q95 = quantile(value, 0.95),
    q100 = quantile(value, 1)
  ) %>%
  mutate(type = as.character(type))

# 预处理密度曲线数据
density_data <- input %>%
  group_by(type) %>%
  group_map(function(df, g) {
    dens <- density(df$value)
    multiplier <- 0.1 / max(dens$y)
    data.frame(
      x = dens$x,
      y = as.numeric(g) - 1 + multiplier * dens$y,
      y2 = as.numeric(g) - 1 - multiplier * dens$y,
      type = as.character(g)
    )
  }) %>% bind_rows()

# 生成图表
highchart() %>%
  hc_add_series(data = box_data, type = "boxplot", name = "Boxplot", tooltip = list(valueDecimals = 2)) %>%
  hc_add_series(data = density_data, type = "areasplinerange", name = "Density", color = primary_colours[[1]], fillOpacity = 0.5) %>%
  hc_yAxis(categories = unique(input$type)) %>%
  hc_chart(inverted = TRUE) %>%
  hc_tooltip(shared = TRUE)

3. 使用highcharter的封装函数 #

部分社区扩展或新版本highcharter提供了hc_violin快捷函数，可直接传入分组数据生成小提琴图，大幅简化代码量。

内容的提问来源于stack exchange，提问作者Paru at R