r - Highcharter map 点击事件在 Shiny 模块中不起作用

Question

下面是一个 Shiny 应用程序，其中显示了 Highcharter map 。当用户点击一个国家/地区时，该国家/地区的名称会显示在 map 下方。

下面的应用程序在不使用模块时可以正常工作。使用模块实现时，所选国家不再显示。

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)

编辑

如下将模块 ID 添加到 Shiny.onInputChange 函数中，并没有解决问题。

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

Answer 1

您必须将模块 ID 添加到回调函数中。我们可以通过在 JS() 调用中使用 paste0 中的模块 id 以编程方式执行此操作:

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)