0

This is (once again) related to a previous post I made where I received an excellent answer to assist with syncing Highcharter charts in R Shiny. In my previous testing, I was utilizing the hc_plotOptions click within a series. However, I've decided that I want to give users the ability to unclick their selection. So I switched out click with select and unselect as shown in the reproducible example below, while setting allowPointSelect = TRUE:

##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
#SELECT
testJSsel <- JS("function() {
                       let currentY = this.name
                       charts = Highcharts.charts;
                       charts.forEach(function(chart, index) {
                       if (chart) { 
                       chart.series.forEach(function(series, seriesIndex) {
                       series.points.forEach(function(point, pointsIndex) {
                       if (point.name == currentY) {
                               point.update({color:'red'})
                       }
                       })
                       });
                       }
                       });
        }")

#UNSELECT
testJSunsel <- JS("function() {
                       let currentY = this.name
                       charts = Highcharts.charts;
                       charts.forEach(function(chart, index) {
                       if (chart) { 
                       chart.series.forEach(function(series, seriesIndex) {
                       series.points.forEach(function(point, pointsIndex) {
                       if (point.name == currentY) {
                               point.update({color: chart.colorAxis[1]})
                       }
                       })
                       });
                       }
                       });
        }")

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",
          allowPointSelect = TRUE,
          cursor           = "pointer",
          states           = list(
            hover = list(
              color = 'red'
            ),
            select = list(
              color = 'red'
            )
          ),
          borderColor = "#8d8d8d",
          nullColor = "#D3D3D3",
          download_map_data = FALSE
    ) %>%
      hc_plotOptions(series = list(
        point = list(
          events = list(
            select   = testJSsel,
            unselect = testJSunsel
          )
        )
      )
      )
  })
  
  #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,
        allowPointSelect = TRUE,
        cursor           = "pointer",
        states           = list(
          hover = list(
            color = 'red'
          ),
          select = list(
            color = 'red'
          )
        ),
        type = "bar",
        color = "blue",
        polar = FALSE
      ) %>%
      hc_plotOptions(series = list(
        point = list(
          events = list(
            select   = testJSsel,
            unselect = testJSunsel
          )
        )
      )
      )
  })
  
}

shinyApp(ui = ui, server = server)

This code is almost where I want it, where if a user clicks on chart 1 (map), this highlights the corresponding data in chart 2 (barchart) using the JS function within select in each Highcharter chart, and if the user clicks the same data point on chart 1 (map) again (so a 2nd click), the data point in chart 1 is unhighlighted in both chart 1 and chart 2 returning to its previous state. This also works in the opposite direction.

However, if the user clicks a data point in chart 1 (map), which highlights the corresponding data point in chart 2 (barchart), clicking the newly highlighted data point in chart 2 does not unhighlight the corresponding data point in chart 1. In other words, I would like to give the user the ability to unselect in either chart, regardless of which chart they used for their first click.

I thought perhaps setting the state of the point (point.select()) in the JS function would force updating the state of both charts to realizing a "first click" but this doesn't quite work as hoped.

Is this the right approach for what I'm trying to do by using allowPointSelect, select, and unselect, or is there an alternative? I feel like this code is 90% there, but it seems I'm missing something (obvious or not) in my JS function.

Thank you for any suggestions and solutions, and your time!

jcoder
  • 35
  • 6

0 Answers0