library(highcharter) options(highcharter.theme = hc_theme_hcrt(tooltip = list(valueDecimals = 2)))
Drilldown is the concept of inspecting increasingly high resolution data through clicking on chart items like columns, points or pie slices.
library(dplyr) library(forcats) library(purrr) library(stringr) data(gapminder, package = "gapminder") gapminder2007 <- gapminder |> filter(year == max(year)) |> select(-year) |> mutate(pop = pop/1e6) |> arrange(desc(pop)) gapminder_column <- gapminder2007 |> group_by(continent) |> summarise( lifeExp = weighted.mean(lifeExp, pop), gdpPercap = weighted.mean(gdpPercap, pop), pop = sum(pop) ) |> mutate_if(is.numeric, round) |> arrange(desc(pop)) |> mutate(continent = fct_inorder(continent)) gapminder_column gapminder_drilldown <- gapminder2007 |> group_nest(continent) |> mutate( id = continent, type = "column", # in the drilldown we'll give the mapping via creating the columns data = map(data, mutate, name = country, y = pop), data = map(data, list_parse) ) gapminder_drilldown
The data is ready. Now, in this example due the continents and countries have
the sames values (pop, lifeExp, ...) we can use the same pointFormat
for
the tooltips:
x <- c("Population (MM)", "Life expectancy at birth", "GDP per capita (US$)") y <- c("{point.pop}", "{point.lifeExp}", "$ {point.gdpPercap}") tt <- tooltip_table(x, y) hchart( gapminder_column, "column", hcaes(x = continent, y = pop, name = continent, drilldown = continent), name = "Population", colorByPoint = TRUE ) |> hc_drilldown( allowPointDrilldown = TRUE, series = list_parse(gapminder_drilldown) ) |> hc_tooltip( pointFormat = tt, # "{point.name} {point.pop}" useHTML = TRUE, valueDecimals = 0 ) |> hc_yAxis( title = list(text = "Population in millions (log scale)"), type = "logarithmic", minorTickInterval = 'auto' ) |> hc_xAxis( title = "" )
Same recipe, different data. Just copy & pasting code:
pkmn_min <- pokemon |> count(type_1, color = type_1_color) |> mutate(type_1 = fct_reorder(type_1, .x = n)) |> arrange(desc(type_1)) pkmn_ddn <- pokemon |> count(type_1, type_2, color = type_mix_color) |> arrange(type_1, desc(n)) |> mutate(type_2 = ifelse(is.na(type_2), str_c("only ", type_1), type_2)) |> group_nest(type_1) |> mutate( id = type_1, type = "column", # in the drilldown we'll give the mapping via creating the columns data = map(data, mutate, name = type_2, y = n), data = map(data, list_parse) ) hchart( pkmn_min, type = "column", hcaes(x = type_1, y = n, color = color, drilldown = type_1), name = "Pokémons" ) |> hc_drilldown( activeAxisLabelStyle = list(textDecoration = "none"), allowPointDrilldown = TRUE, series = list_parse(pkmn_ddn) ) |> hc_yAxis( title = list(text = ""), endOnTick = FALSE, opposite = TRUE ) |> hc_xAxis( title = list(text = ""), endOnTick = FALSE, gridLineWidth = 0, tickWidth = 0 ) |> hc_chart( style = list(fontFamily = "Gloria Hallelujah") )
(Example thanks to Claire).
dtrees <- tibble( tree = c("A", "B"), apples = c(5, 7), species = c("Fuji", "Gala"), trunk_size = c(30, 40) ) |> # rowise is used to avoid vectorization in tags$td, ie, do it row by row rowwise() |> mutate( tooltip_text = list( tags$table( tags$tr(tags$th("Tree"), tags$td(tree)), tags$tr(tags$th("# Apples"), tags$td(apples)) ) ) ) |> ungroup() |> mutate( tooltip_text = map_chr(tooltip_text, as.character), # clean text tooltip_text = str_trim(str_squish(tooltip_text)) ) dflowers <- tibble( tree = c(rep("A", 3), rep("B", 4)), rose = c("R1", "R2", "R3", "R4", "R5", "R6", "R7"), petals = c(10, 13, 15, 20, 24, 26, 27), color = c( "gray", "#FFB6C1", "#8B0000", "purple", "#FF10F0", "#ffffbf", "red" ), price = c(3, 2, 4, 3.5, 5, 2.5, 4.5) ) |> rowwise() |> mutate( tooltip_text = list( tags$table( tags$tr(tags$th("Flower"), tags$td(rose)), tags$tr(tags$th("# Petals"), tags$td(petals)), tags$tr(tags$th("Price"), tags$td(str_c("$ ", price))) ) ) ) |> ungroup() |> mutate( tooltip_text = map_chr(tooltip_text, as.character), # clean text tooltip_text = str_trim(str_squish(tooltip_text)) ) dflowers_dd <- dflowers |> group_nest(id = tree) |> mutate( type = "column", data = map(data, mutate, name = rose, y = petals), data = map(data, list_parse), name = "Petals" ) hchart( dtrees, "column", hcaes(tree, apples, drilldown = tree), name = "Apples", colorByPoint = TRUE ) |> hc_drilldown( breadcrumbs = list( format = 'back to {level.name} series', # enabled = FALSE, showFullPath = FALSE ), allowPointDrilldown = TRUE, series = list_parse(dflowers_dd) ) |> hc_yAxis(title = list(text = "")) |> hc_xAxis(title = list(text = "")) |> hc_tooltip( headerFormat = "", # remove header pointFormat = "{point.tooltip_text}", useHTML = TRUE )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.