3

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);}")
6PO0222
  • 131
  • 7
  • Adding `console.log(event.point.name)` in the `click_js` function allows to see the name of the clicked country in the console though. – 6PO0222 Aug 16 '21 at 13:16

1 Answers1

2

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)
TimTeaFan
  • 17,549
  • 4
  • 18
  • 39
  • 1
    I had to add the `ns <- NS(id)` in both module parts for making it work. Otherwise, it works perfectly. Thanks ! – 6PO0222 Aug 19 '21 at 10:37
  • Interesting, the example above is running fine here without `ns <- NS(id)` (that was the reason I deleted those lines, sorry!). BTW I'm on shiny 1.6.0. – TimTeaFan Aug 19 '21 at 10:40
  • Not the same shiny version , that's why. – 6PO0222 Aug 19 '21 at 14:20