R Highcharter: Select category from a single point - r

Question

Using a highchart in R (using the highcharter package) I'm trying to select all the points for a single category when selecting any single point. The code below allows selecting a single slice of a stack in a stacked bar chart. I want the entire stacked bar to be selected/deselected by clicking on any of the stacked bar slices.
library("shiny")
library("highcharter")
ui <- shinyUI(
fluidPage(
column(width = 8, highchartOutput("hcontainer", height = "500px")),
column(width = 4, textOutput("text"))
)
)
server <- function(input, output) {
a <- data.frame(b = LETTERS[1:10], b_alt = LETTERS[11:20], c = 11:20, d = 21:30, e = 31:40)
output$hcontainer <- renderHighchart({
canvasClickFunction <- JS("function(event) {Shiny.onInputChange('canvasClicked', [this.name, event.point.series.chart.series[0].options.additionalInfo[event.point.index]]);}")
legendClickFunction <- JS("function(event) {Shiny.onInputChange('legendClicked', this.name);}")
highchart() %>%
hc_xAxis(categories = a$b) %>%
hc_add_series(name = "c", additionalInfo = a$b_alt, data = a$c, color = "red") %>%
hc_add_series(name = "d", data = a$d) %>%
hc_add_series(name = "e", data = a$e) %>%
hc_plotOptions(series = list(stacking = TRUE, allowPointSelect = TRUE, events = list(click = canvasClickFunction, legendItemClick = legendClickFunction))) %>%
hc_chart(type = "column")
})
makeReactiveBinding("outputText")
observeEvent(input$canvasClicked, {
outputText <<- paste0("You clicked on series ", input$canvasClicked[1], " and the bar you clicked was from category ", input$canvasClicked[2], ".")
})
observeEvent(input$legendClicked, {
outputText <<- paste0("You clicked into the legend and selected series ", input$legendClicked, ".")
})
output$text <- renderText({
outputText
})
}
shinyApp(ui, server)

Answer 1

You can fire the event on point click (let's call that clicked point clickedPoint) loop through all series and then through all points, check if the point has the same category as our clickedPoint and if yes, select it using point.select() method.
Here is the main code:
hc_plotOptions(series = list(stacking = TRUE, events = list(click = canvasClickFunction, legendItemClick = legendClickFunction), point = list(events = list(click = JS(
"function() {
var clickedPoint = this;
clickedPoint.series.chart.series.forEach(function(series) {
series.points.forEach(function(point) {
if (point.category === clickedPoint.category) {
if (point.selected) {
point.select(false, true)
} else {
point.select(true, true)
}
}
})
})
}"
))))) %>%
And here is the whole code:
library("shiny")
library("highcharter")
ui <- shinyUI(
fluidPage(
column(width = 8, highchartOutput("hcontainer", height = "500px")),
column(width = 4, textOutput("text"))
)
)
server <- function(input, output) {
a <- data.frame(b = LETTERS[1:10], b_alt = LETTERS[11:20], c = 11:20, d = 21:30, e = 31:40)
output$hcontainer <- renderHighchart({
canvasClickFunction <- JS("function(event) {Shiny.onInputChange('canvasClicked', [this.name, event.point.series.chart.series[0].options.additionalInfo[event.point.index]]);}")
legendClickFunction <- JS("function(event) {Shiny.onInputChange('legendClicked', this.name);}")
highchart() %>%
hc_xAxis(categories = a$b) %>%
hc_add_series(name = "c", additionalInfo = a$b_alt, data = a$c, color = "red") %>%
hc_add_series(name = "d", data = a$d) %>%
hc_add_series(name = "e", data = a$e) %>%
hc_plotOptions(series = list(stacking = TRUE, events = list(click = canvasClickFunction, legendItemClick = legendClickFunction), point = list(events = list(click = JS(
"function() {
var clickedPoint = this;
clickedPoint.series.chart.series.forEach(function(series) {
series.points.forEach(function(point) {
if (point.category === clickedPoint.category) {
if (point.selected) {
point.select(false, true)
} else {
point.select(true, true)
}
}
})
})
}"
))))) %>%
hc_chart(type = "column")
})
makeReactiveBinding("outputText")
observeEvent(input$canvasClicked, {
outputText <<- paste0("You clicked on series ", input$canvasClicked[1], " and the bar you clicked was from category ", input$canvasClicked[2], ".")
})
observeEvent(input$legendClicked, {
outputText <<- paste0("You clicked into the legend and selected series ", input$legendClicked, ".")
})
output$text <- renderText({
outputText
})
}
shinyApp(ui, server)
API: https://api.highcharts.com/class-reference/Highcharts.Point#select
https://api.highcharts.com/highcharts/plotOptions.column.point.events.click
jsFiddle with a pure JS implementation: https://jsfiddle.net/BlackLabel/p135s4vm/