Search code examples
rshinyr-highcharter

Highcharter map click event not working in Shiny module


Below is a Shiny app in which a Highcharter map is displayed. When a user clicks a country, the name of the country is displayed below the map.

The app below works when it does not use modules. When implemented using a module, the country selected does not display anymore.

library(shiny)
library(highcharter)
library(dplyr)


# MODULE UI
module_ui <- function(id){
    
    ns <- NS(id)
    
    div(
        highchartOutput(ns("hcmap")),
        verbatimTextOutput(ns("country"))
    )
}

# SERVER UI
module_server <- function(id){
    
    ns <- NS(id)
    
    moduleServer(id, function(input, output, session){
        
        # Data
        data_4_map <- download_map_data("custom/world-robinson-highres") %>%
            get_data_from_map() %>% 
            select(`hc-key`) %>%
            mutate(value = round(100 * runif(nrow(.)), 2))
        
        # Map
        click_js <- JS("function(event) {Shiny.onInputChange('hcmapclick',event.point.name);}")
        
        output$hcmap <- renderHighchart({
            hcmap(map = "custom/world-robinson-highres",
                  data =  data_4_map,
                  value = "value",
                  joinBy = "hc-key",
                  name = "Pop",
                  download_map_data = F) %>%
                hc_colorAxis(stops = color_stops()) %>%
                hc_plotOptions(series = list(events = list(click = click_js)))
        })
        
        # Clicked country
        output$country <- renderPrint({
            print(input$hcmapclick)
        })
    })
}

# APP UI
ui <- fluidPage(
    tags$script(src = "https://code.highcharts.com/mapdata/custom/world-robinson-highres.js"),
    fluidRow(
        module_ui(id = "moduleID")
    )
)

# APP SERVER
server <- function(input, output, session) {
    module_server(id = "moduleID")
}    

shinyApp(ui, server)

EDIT

Adding the module ID to the Shiny.onInputChange function as follows, does not solve the problem.

click_js <- JS("function(event) {console.log(event.point.name); Shiny.onInputChange('moduleID-hcmapclick', event.point.name);}")

Solution

  • You have to add the module ID to your call back function. We can do this programmatically by using the module id in paste0 inside the JS() call:

    library(shiny)
    library(highcharter)
    library(dplyr)
    
    
    # MODULE UI
    module_ui <- function(id){
      
      div(
        highchartOutput(ns("hcmap")),
        verbatimTextOutput(ns("country"))
      )
    }
    
    # SERVER UI
    module_server <- function(id){
      
      moduleServer(id, function(input, output, session){
        
        # Data
        data_4_map <- download_map_data("custom/world-robinson-highres") %>%
          get_data_from_map() %>% 
          select(`hc-key`) %>%
          mutate(value = round(100 * runif(nrow(.)), 2))
        
        # Map
        click_js <- JS(paste0("function(event) {Shiny.onInputChange('",id,"-hcmapclick',event.point.name);}"))
        
        output$hcmap <- renderHighchart({
          hcmap(map = "custom/world-robinson-highres",
                data =  data_4_map,
                value = "value",
                joinBy = "hc-key",
                name = "Pop",
                download_map_data = F) %>%
            hc_colorAxis(stops = color_stops()) %>%
            hc_plotOptions(series = list(events = list(click = click_js)))
        })
        
        # Clicked country
        output$country <- renderPrint({
          print(input$hcmapclick)
        })
      })
    }
    
    # APP UI
    ui <- fluidPage(
      tags$script(src = "https://code.highcharts.com/mapdata/custom/world-robinson-highres.js"),
      fluidRow(
        module_ui(id = "moduleID")
      )
    )
    
    # APP SERVER
    server <- function(input, output, session) {
      module_server(id = "moduleID")
    }    
    
    shinyApp(ui, server)