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);}")
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)