Related to a previous post I made, I would like to update points in one Highcharter plot to change color when invoking a click event on a separate, but synchronized, Highcharter plot in R Shiny, in both directions. I am able to synchronize two Highcharter plots in R Shiny, but when the user toggles an input in the UI, the JavaScript for the click event no longer works (both in synchronization and in the actual click event for either chart). See this reproducible example:
##PACKAGES
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(dplyr)
library(tidyverse)
library(albersusa) ## remotes::install_github("hrbrmstr/albersusa")
library(highcharter)
library(usdata)
library(data.table)
states <- data.frame(
name = rep(state.abb,4),
state = rep(state.name,4),
metric = c(rep("YES",100),rep("NO",100)),
value = sample(100:5000,200)
)
#for synchronizing Highcharts 1 and 2
testJS <- JS("function() {
let currentY = this.name
charts = Highcharts.charts;
charts.forEach(function(chart, index) {
chart.series.forEach(function(series, seriesIndex) {
series.points.forEach(function(point, pointsIndex) {
if (point.name == currentY) {
point.setState('hover');
point.update({color:'red'})
}
})
});
});
}")
ui <- fluidPage(
tags$script(src = "https://code.highcharts.com/mapdata/countries/us/us-all.js"),
fluidRow(
radioButtons(inputId = "toggle",label="toggle it",
choices = c("YES","NO")),
column(width=5,highchartOutput("map1")),
column(width=5,highchartOutput("bar1"))
)
)
server <- function(input, output, session) {
#create rate change
df1_num<- reactive({
states %>%
filter(metric == input$toggle) %>%
group_by(name) %>%
mutate(
first = dplyr::first(value),
last = dplyr::last(value)
) %>%
distinct(metric,state,first,last) %>%
mutate(
#increase/decrease rate change
rate = round(((last-first)/first)*100,1),
)
})
#HIGHCHART 1 (map)
output$map1 <- renderHighchart({
#US map of percent change in population trends
hcmap("countries/us/us-all",
data = df1_num(),
joinBy = c("hc-a2","name"),
value = "rate",
borderColor = "#8d8d8d",
nullColor = "#D3D3D3",
download_map_data = FALSE
) %>%
hc_plotOptions(series = list(
point = list(
events = list(
click = testJS
)
)
)
)
})
#HIGHCHART 2 (barchart)
output$bar1 <- renderHighchart({
test <- df1_num() %>%
arrange(rate) %>%
rowid_to_column("orderrate")
setDT(test)[,testit:=.GRP,by=orderrate]
highchart() %>%
hc_add_series(
data = test,
hcaes(
x = state,
y = rate,
group = orderrate),
showInLegend = FALSE,
type = "bar",
color = "blue",
polar = FALSE
) %>%
hc_plotOptions(series = list(
point = list(
events = list(
click = testJS
)
)
)
)
})
}
shinyApp(ui = ui, server = server)
In my previous post, I received an excellent answer that fixes the R Shiny user input change by retaining the click event functionality, however this solution does not synchronize the charts (replace the value testJS with):
JS("function(){
this.update({color:'red'})
}")
I realize my main struggle here is creating harmony between the amazing Highcharter wrapper and raw Highcharts JS, so any ideas (or clear direction I'm simply unaware of) would be so helpful!
Thanks!
