rr-highcharter

Multiple highcharter graphics with common legend


Based on my previous question (Multiple series radar plot with highcharter), I am trying now to create a frame of n graphics, all having the same legends. Here is a repex :

library(highcharter)
library(dplyr)

df <- data.frame(Series = c(rep(paste0("Serie", 1:4), 2), rep(paste0("Serie", 5:8), 2)),
                Product = rep(c(rep("Product1", 4), rep("Product2", 4)), 2),
                Value = c(5.8, 6.3, 8.1, 2.3, 4.4, 4.6, 7.7, 6.6,
                          6.8, 2.4, 4.2, 2.5, 7.3, 3.2, 5.5, 4.5),
                Graph = c(rep("Graph1", 8), rep("Graph2", 8)))

df %>%
  group_by(Graph) %>%
  group_map( ~ {
    .x %>%
      hchart(type = "line", hcaes(y = Value, group = Product)) |>
      hc_chart(polar = TRUE) |>
      hc_xAxis(categories = .x %>% pull(Series) %>% unique(), lineWidth = 0, tickmarkPlacement = "on") |>
      hc_yAxis(gridLineInterpolation = "polygon",min = 0, title = list(text = NULL)) |>
      hc_plotOptions(line = list(pointPlacement = "on")) %>% hc_legend(enabled = T, layout = 'proximate', align = 'left', floating = FALSE)
    
  }) %>% hw_grid(ncol = 2, browsable = TRUE)

It is working almost as expected, except that I will have a lot of graphics in my true scenario, and I would like to have only one common legends for all the graphics (they will all have Product1, Product2, ...).

I found this from Highcharts (https://api.highcharts.com/highcharts/plotOptions.series.linkedTo) and it seems to do what I have in mind but I am struggling to adapt it to R syntax.


Solution

  • Using the approach outlined here I was able to create the following code. Using linkedTo works only if you want to link series within one chart but not across multiple charts.

    1. Add legend only to the first high chart
    2. if this legend is clicked, retrieve the series index with this.index and
    3. hide this series within all other charts.
    4. use unique group length for the for loop.
    library(highcharter)
    library(dplyr)
    
    dd <- data.frame(Series = c(rep(paste0("Serie", 1:4), 2), rep(paste0("Serie", 5:8), 2), rep(paste0("Serie", 8:11), 2)),
                     Product = rep(c(rep("Apple", 4), rep("Banana", 4)), 3),
                     Value = c(5.8, 6.3, 8.1, 2.3, 4.4, 4.6, 7.7, 6.6, 6.8, 2.4, 4.2, 2.5, 7.3, 3.2, 5.5, 4.5, 6.8, 2.4, 4.2, 2.5, 7.3, 3.2, 5.5, 4.5),
                     Graph = c(rep("Graph1", 8), rep("Graph2", 8), rep("Graph3", 8)))
    
    groups <- length(unique(dd$Graph))
    dd %>%
      group_by(Graph) %>%
      group_map(~ {
        is_legend_chart <- .y$Graph == "Graph1"
        categories <- unique(.x$Series)
        .x %>%
          hchart("line", hcaes(y = Value, group = Product)) |>
          hc_chart(polar = TRUE) |>
          hc_xAxis(categories = categories, lineWidth = 0, tickmarkPlacement = "on") |>
          hc_yAxis(gridLineInterpolation = "polygon", min = 0, title = list(text = NULL)) |>
          hc_plotOptions(
            line = list(pointPlacement = "on"),
            series = if (is_legend_chart) list(
              events = list(
                legendItemClick = JS(glue::glue("
                  function(event) {{
                    var i = this.index;
                    var n = {groups};
                    if (this.visible) {{
                      this.hide();
                      for (let j = 1; j < n; j++) Highcharts.charts[j].series[i].hide();
                    }} else {{
                      this.show();
                      for (let j = 1; j < n; j++) Highcharts.charts[j].series[i].show();
                    }}
                    return false;
                  }}
                "))
              )
            ) else list()
          ) |>
          hc_legend(enabled = is_legend_chart, layout = 'proximate', align = 'left', floating = FALSE)
      }) %>%
      hw_grid(ncol = groups, browsable = TRUE)
    

    one legend controlls all other charts