There are a few different ways you could do this. You didn't provide a reproducible question, so I've used the data gapminder
.
The highest level is the average life expectancy by continent. The second level is the average by country. The third level is the life expectancy by country by year.
I used the highcharter
function colorize
to create color vectors. This is how I put it together:
The data
library(tidyverse)
library(highcharter)
data(gapminder, package = "gapminder")
avLE = gapminder %>%
group_by(continent) %>%
mutate(aLE = mean(lifeExp)) %>% # average by continent
ungroup() %>% group_by(country) %>%
mutate(caLE = mean(lifeExp)) %>% # average by year
ungroup() %>% arrange(desc(aLE)) %>% # order by life expectancy for continents
mutate_if(is.numeric, round, 2) # round to 2 decimals
summary(avLE) # check it; makes sense
gapCol = avLE %>% # set the continets in the validated avLE as ordered
group_by(continent) %>%
mutate(color = colorize(continent),
continent = ordered(continent,
levels = unique(avLE$continent)))
summary(gapCol) # check it; makes sense
The drill downs
# make the deepest level dropdown
gapDD2 = avLE %>%
arrange(year) %>%
group_nest(continent, country, caLE) %>% # keep these variables!
mutate(id = country,
type = "column",
data = map(data, mutate, name = year, y = lifeExp,
color = colorize(year)), # set the color (easier with #)
data = map(data, list_parse))
gapDD1 = avLE %>%
arrange(country) %>% # arrange by country, set as ordered, then find colors
mutate(country = ordered(country, levels = unique(country))) %>%
mutate(color = ordered(colorize(country), # colors/countries align
levels = unique(colorize(country)))) %>%
group_nest(continent) %>%
mutate(id = continent,
type = "column",
data = map(data, mutate, name = country, y = caLE,
color = color, # set the color (a few more steps than with #s)
drilldown = country),
data = map(data, list_parse))
The chart
# take a look:
hchart(gapCol, "column", name = "Continental Averages",
hcaes(x = continent, color = continent, y = aLE,
name = "continent", drilldown = "continent")) %>%
hc_drilldown(allowPointsDrillDown = T,
series = c(list_parse(gapDD1), list_parse(gapDD2)))



With Shiny
I've provided a really simple example of how to render this plot within a Shiny application. In this example, all of the code, except the call hchart
, is called before the ui
is set.
ui <- fluidPage(
fluidRow(highchartOutput("myHC"))
)
server <- function(input, output, session){
output$myHC <- renderHighchart({
hchart(gapCol, "column", name = "Continental Averages",
hcaes(x = continent, color = continent, y = aLE,
name = "continent", drilldown = "continent")) %>%
hc_drilldown(allowPointsDrillDown = T,
series = c(list_parse(gapDD1), list_parse(gapDD2)))
})
}
shinyApp(ui = ui, server = server)
Let me know if you have any questions.