title: How to set up drilldown feature for multiple boxplot series in highcharter?
body: <h3>Solution Below</h3>
  <p><em>Original Question:</em><br />
  I'm attempting to create a drilldown plot in highcharter that uses boxplots.<br />
  The goal here is to start with boxplots on a monthly timescale. The process is as follows:</p>
  <ol>
  <li>Initial view - Boxplot with months as x-axis</li>
  <li>Clicking on a specific month drills down into a new series of boxplots where the x-axis is the weeks that make up the month selected</li>
  <li>Lastly, clicking on a week within the month selected then drills down into a new series of boxplots where the x-axis is the days that are specific to that week.</li>
  </ol>
  <p>A couple things to note, I've modified the <code>data_to_boxplot</code> function in two ways. First by adding the ability to show no. of observations in <code>get_box_values</code>. Second, I've added a drilldown field in <code>data_to_boxplot</code> that corresponds to the name of the series. Which is used in <code>hc_drilldown</code></p>
  <h2>The Code:</h2>
  <pre><code>library(purrr)
  library(dplyr)
  library(tidyr)
  library(lubridate)
  library(highcharter)
  library(data.table)
  
  # Helper functions
  group_by_timescale = function(x,unit=&quot;day&quot;) {
    if (unit==&quot;month&quot;) {
      lubridate::rollback(x, roll_to_first = TRUE)
    } else if (unit==&quot;week&quot;) {
      floor_date(x, &quot;week&quot;, week_start = 1)+6
    } else if (unit==&quot;day&quot;) {
      x
    }
  }
  get_box_values &lt;- function(x) {
    boxplot.stats(x)$stats %&gt;% 
      t() %&gt;% 
      cbind(boxplot.stats(x)$n) %&gt;% 
      as.data.frame() %&gt;%
      setNames(c(&quot;low&quot;, &quot;q1&quot;, &quot;median&quot;, &quot;q3&quot;, &quot;high&quot;, &quot;obs&quot;))
  }
  get_outliers_values &lt;- function(x) {
    boxplot.stats(x)$out
  }
  
  # Modified highcharter function
  data_to_boxplot_2 = function (data, variable, group_var = NULL, group_var2 = NULL, add_outliers = FALSE, ...) {
    stopifnot(is.data.frame(data), !missing(variable))
    # browser()
    dx &lt;- data %&gt;% 
      transmute(`:=`(x, {
        {
          variable
        }
      }))
    if (!missing(group_var)) {
      dg &lt;- data %&gt;% select({
        {
          group_var
        }
      })
    }
    else {
      dg &lt;- data.frame(rep(0, nrow(dx)))
    }
    if (!missing(group_var2)) {
      dg2 &lt;- data %&gt;% select({
        {
          group_var2
        }
      })
    }
    else {
      dg2 &lt;- data.frame(rep(NA, nrow(dx)))
    }
    dg &lt;- dg %&gt;% setNames(&quot;name&quot;)
    dg2 &lt;- dg2 %&gt;% setNames(&quot;series&quot;)
    dat &lt;- bind_cols(dx, dg, dg2)
    dat1 &lt;- dat %&gt;% 
      group_by(series, name) %&gt;% 
      summarise(data = list(get_box_values(x)),.groups = &quot;drop&quot;) %&gt;% 
      unnest(cols = data) %&gt;%
      mutate(drilldown = name) %&gt;% # add drilldown name to series
      group_nest(series) %&gt;% 
      mutate(data = map(data, list_parse)) %&gt;% 
      rename(name = series) %&gt;% 
      mutate(id = name) %&gt;% 
      mutate(type = &quot;boxplot&quot;, ...)
    
    if (add_outliers) {
      dat2 &lt;- dat %&gt;% 
        mutate(name = as.numeric(factor(name)) - 1) %&gt;% 
        group_by(series, name) %&gt;% 
        summarise(y = list(get_outliers_values(x)),.groups = &quot;drop&quot;) %&gt;% 
        unnest(cols = y) %&gt;% 
        rename(x = name) %&gt;% 
        group_nest(series) %&gt;% 
        mutate(data = map(data, list_parse)) %&gt;% 
        rename(linkedTo = series) %&gt;% 
        mutate(type = &quot;scatter&quot;, showInLegend = FALSE, ...)
      
      dout &lt;- bind_rows(dat1, dat2)
    }
    else {
      dout &lt;- dat1
    }
    dout
  }
  
  # Sample data
  dates = sort(rep(seq.Date(from = as_date(&quot;2021-01-01&quot;), to = as_date(&quot;2021-12-31&quot;), by = &quot;day&quot;),15))
  data = data.table(
    day = dates,
    values = floor(runif(length(dates), 0, 1000))
  )
  
  data[, `:=` (
    weeks = group_by_timescale(day, &quot;week&quot;),
    months = group_by_timescale(day, &quot;month&quot;)
  )]
  
  # Create Boxplot series
  month_dt = data_to_boxplot_2(data, variable = values, group_var = months, name = &quot;month&quot;)
  week_dt = data_to_boxplot_2(data, variable = values, group_var = weeks, group_var2 = months, name = &quot;week&quot;)
  day_dt = data_to_boxplot_2(data, variable = values, group_var = day, group_var2 = weeks, name = &quot;day&quot;)
  
  # Drilldown HC plot
  hc &lt;- highchart() %&gt;%
    hc_title(text = &quot;Basic drilldown&quot;) %&gt;%
    hc_xAxis(type = &quot;category&quot;) %&gt;%
    hc_legend(enabled = FALSE) %&gt;%
    hc_plotOptions(series = list(borderWidth = 0,dataLabels = list(enabled = TRUE))) %&gt;%
    hc_add_series_list(month_dt) %&gt;%
    hc_drilldown(allowPointDrilldown = TRUE,
                 series = list(week_dt, day_dt))
  </code></pre>
  <p>Below is an image of the plot output. The x-axis values, when clicked, should result in a new boxplot but nothing happens. I'm suspect that it has to do with how my data is grouped but not sure. Any help on this would be great! Thanks
  <a href="https://i.stack.imgur.com/a5dF5.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/a5dF5.png" alt="drill down plot" /></a></p>
  <h2>EDIT: Solution</h2>
  <p>I'm still a bit new to R so my explanation may unintentionally omit details. After tinkering around, I've discovered that <code>hc_drilldown(series)</code> expects an array of series configurations that are in the highcharts series option. When using the <code>data_to_boxplot</code> function the output is a tibble with a nested list. So in order to add the drill down series to hc_drilldown. The tibble needs to be parsed to a list. Using <code>highcharter::list_parse2</code> removes all names and I need to keep the name values in the series like &quot;name&quot;, &quot;id&quot; etc.</p>
  <p>I created a function to output a hc drilldown box plot for n number of drilldown series. In my example I ended up using <code>rlist::list.parse(series) %&gt;% setNames(NULL)</code> since that only removes the top level names in the list, but pretty sure <code>highcharter::list_parse</code> will work as well now that I think about it (thanks @Kat). Then, all I needed to do was append the lists using <code>c()</code> in hc_drilldown. One thing to note, the values in the drilldown columns used need to be unique i.e. have unique &quot;ids&quot; otherwise it's possible that clicking on the first series drilldown can bypass the middle levels and go directly to the most granular series. In my example below, clicking on Monthly &quot;2021-08-01&quot; will bypass the weeks in August and go to the day drilldown series.</p>
  <h3>New Working Code</h3>
  <pre><code>library(purrr)
  library(dplyr)
  library(tidyr)
  library(lubridate)
  library(highcharter)
  library(data.table)
  
  # Helper functions
  group_by_timescale = function(x,unit=&quot;day&quot;) {
    if (unit==&quot;month&quot;) {
      lubridate::rollback(x, roll_to_first = TRUE)
    } else if (unit==&quot;week&quot;) {
      floor_date(x, &quot;week&quot;, week_start = 1)+6
    } else if (unit==&quot;day&quot;) {
      x
    }
  }
  get_box_values &lt;- function(x) {
    boxplot.stats(x)$stats %&gt;% 
      t() %&gt;% 
      cbind(boxplot.stats(x)$n) %&gt;% 
      as.data.frame() %&gt;%
      setNames(c(&quot;low&quot;, &quot;q1&quot;, &quot;median&quot;, &quot;q3&quot;, &quot;high&quot;, &quot;obs&quot;))
  }
  get_outliers_values &lt;- function(x) {
    boxplot.stats(x)$out
  }
  
  # Modified HC function
  data_to_boxplot_2 = function (data, variable, group_var = NULL, group_var2 = NULL, 
  drilldown = FALSE, add_outliers = FALSE, ...) {
    stopifnot(is.data.frame(data), !missing(variable))
    # browser()
    dx &lt;- data %&gt;% 
      transmute(`:=`(x, {
        {
          variable
        }
      }))
    if (!missing(group_var)) {
      dg &lt;- data %&gt;% select({
        {
          group_var
        }
      })
    }
    else {
      dg &lt;- data.frame(rep(0, nrow(dx)))
    }
    if (!missing(group_var2)) {
      dg2 &lt;- data %&gt;% select({
        {
          group_var2
        }
      })
    }
    else {
      dg2 &lt;- data.frame(rep(NA, nrow(dx)))
    }
    dg &lt;- dg %&gt;% setNames(&quot;name&quot;)
    dg2 &lt;- dg2 %&gt;% setNames(&quot;series&quot;)
    dat &lt;- bind_cols(dx, dg, dg2)
    dat1 &lt;- dat %&gt;% 
      group_by(series, name) %&gt;% 
      summarise(data = list(get_box_values(x)),.groups = &quot;drop&quot;) %&gt;% 
      unnest(cols = data)
    
    if(drilldown) {
      dat1 &lt;- dat1 %&gt;%
        mutate(drilldown = name)
    }
    
    dat1 &lt;- dat1 %&gt;%
      group_nest(series) %&gt;% 
      mutate(data = map(data, list_parse)) %&gt;% 
      rename(name = series) %&gt;% 
      mutate(id = name) %&gt;% 
      mutate(type = &quot;boxplot&quot;, ...)
    
    if (add_outliers) {
      dat2 &lt;- dat %&gt;% 
        mutate(name = as.numeric(factor(name)) - 1) %&gt;% 
        group_by(series, name) %&gt;% 
        summarise(y = list(get_outliers_values(x)),.groups = &quot;drop&quot;) %&gt;% 
        unnest(cols = y) %&gt;% 
        rename(x = name) %&gt;% 
        group_nest(series) %&gt;% 
        mutate(data = map(data, list_parse)) %&gt;% 
        rename(linkedTo = series) %&gt;% 
        mutate(type = &quot;scatter&quot;, showInLegend = FALSE, ...)
      
      dout &lt;- bind_rows(dat1, dat2)
    }
    else {
      dout &lt;- dat1
    }
    dout
  }
  
  # Sample data
  dates = sort(rep(seq.Date(from = as_date(&quot;2021-01-01&quot;), to = as_date(&quot;2021-12-31&quot;), by = &quot;day&quot;),15))
  data = data.table(
    day = dates,
    values = floor(runif(length(dates), 0, 1000))
  )
  
  data[, `:=` (
    weeks = group_by_timescale(day, &quot;week&quot;),
    months = group_by_timescale(day, &quot;month&quot;)
  )]
  
  # vector indicating the relationship between each drilldown series
  # the first position is the top level
  groups = c(&quot;months&quot;, &quot;weeks&quot;, &quot;day&quot;)
  
  # create hc drilldown boxplot
  drilldown_boxplot = function(dt, var, dd_groups, parent_name = &quot;Monthly&quot;) {
    dd_size = length(dd_groups)
    all_dd = list()
    
    # create boxplot series lists
    for (idx in 1:dd_size) {
      if (idx == 1) {
        all_dd[[idx]] = data_to_boxplot_2(dt, variable = get(var), group_var = dd_groups[idx], 
                                           drilldown = TRUE, name = parent_name)
      } else if (idx == length(dd_groups)) {
        all_dd[[idx]] = data_to_boxplot_2(dt, variable = get(var), group_var = dd_groups[idx], 
                                           group_var2 = dd_groups[idx-1])
      } else {
        all_dd[[idx]] = data_to_boxplot_2(dt, variable = get(var), group_var = dd_groups[idx], 
                                           group_var2 = dd_groups[idx-1], drilldown = TRUE)
      }
    }
    
    parent_series = all_dd[[1]]
    child_series = tail(all_dd, dd_size-1)
    child_series_exp = c()
    
    # parse lists to be readable in hc_drilldown
    for (i in 1:length(child_series)) {
      s = rlist::list.parse(child_series[[i]]) %&gt;% setNames(NULL)
      child_series_exp = c(child_series_exp, s)
    }
    
    # create hc drilldown boxplot
    hc = highchart() %&gt;%
      hc_xAxis(type = &quot;category&quot;) %&gt;%
      hc_legend(enabled = FALSE) %&gt;%
      hc_plotOptions(series = list(borderWidth = 0, dataLabels = list(enabled = TRUE))) %&gt;%
      hc_add_series_list(parent_series) %&gt;%
      hc_drilldown(allowPointDrilldown = TRUE,
                   series = child_series_exp)
    
    return(hc)
  }
  
  drilldown_boxplot(data, &quot;values&quot;, groups)
  </code></pre>