如何关闭Shiny应用中Leaflet地图的双击缩放功能？

问题概述 #

开发包含Leaflet地图的Shiny应用时遇到以下问题：

• 单击地图仅显示工具提示，无法触发数据过滤与表格展示
• 双击地图时功能生效，但地图会自动放大
• 需要先单击显示工具提示，再点击一次才能展示过滤后的表格

解决方案 #

1. 禁用地图的单击工具提示 #

工具提示由tmap的tm_fill参数id = "sector"自动生成，移除该参数即可关闭默认工具提示：

tmap_object <- tm_shape(sectors) +
  tm_borders() +
  tm_fill(col = "number_of_clients",
          title = "number of clients",
          style = "jenks", 
          palette = cividis(6),
          alpha = .6) + # 移除id参数关闭默认tooltip
  tm_view(bbox = st_bbox(district))

2. 阻止双击地图放大行为 #

通过leafletOptions禁用Leaflet的双击缩放功能，在tmap转Leaflet对象后添加配置：

tmap_leaflet(tmap_object) %>%
  leaflet::setOptions(doubleClickZoom = FALSE)

3. 优化点击响应逻辑 #

使用req()简化响应式依赖判断，确保单次点击立即触发表格更新，避免延迟：

pt <- shiny::reactive({
  req(input$map_click) # 确保点击事件存在才执行
  sf::st_point(c(input$map_click$lng, input$map_click$lat)) %>%
    sf::st_sfc(crs = 4326) %>%
    sf::st_as_sf() %>%
    sf::st_transform(st_crs(district))
})

完整修改后的代码 #

整合所有修改后的完整应用代码：

# install required packages in they are not already installed
if(!"remotes" %in% installed.packages()){
  install.packages("remotes")
}
# list my required packages
required_pkgs = c("magrittr", "dplyr", "shiny", "bslib", "leaflet", "sf", "tmap", "viridis")

# Get the missing required packages and install them
missing_pkgs <- setdiff(required_pkgs, installed.packages()[, "Package"])
if(length(missing_pkgs) != 0){
  remotes::install_cran(missing_pkgs)
}

# load the libraries of my required packages
lapply(required_pkgs, require, character.only = T)

# Load data
district <- readRDS("district.RDS")
sectors <- readRDS("sectors.RDS")
locations <- readRDS("locations.RDS")

# Create the map with shiny
#=========================
ui <- fluidPage(
  titlePanel("My test map title"),
  fluidRow(
    column(4,
           card(
             id = "detailsCard",
             style = "height: 60vh;",
             full_screen = FALSE,
             card_header("Details at click point"),
             card_body(
               tableOutput("details")
             )
           )
    ),
    column(8,
           card(
             id = "mapCard",
             style = "height: 100vh;",
             full_screen = TRUE,
             card_header("Map"),
             card_body(
               leafletOutput("map")
             )
           )
    )
  )
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    # create the tmap object
    tmap_object <- tm_shape(sectors) +
      tm_borders() +
      tm_fill(col = "number_of_clients",
              title = "number of clients",
              style = "jenks", 
              palette = cividis(6),
              alpha = .6) + # 移除id参数关闭tooltip
      tm_view(bbox = st_bbox(district))  # Set the initial extent to fit the AoI layer
    
    # convert the tmap object to a leaflet map 并禁用双击缩放
    tmap_leaflet(tmap_object) %>%
      leaflet::setOptions(doubleClickZoom = FALSE)
  })
  
  
  # Map click logic
  observe({
    # clear previous click
    leaflet::leafletProxy("map") %>%
      leaflet::clearMarkers()
    
    # get new click
    click <- input$map_click
    
    # add click to map
    leaflet::leafletProxy("map") %>%
      leaflet::addMarkers(lng = click$lng, lat = click$lat)
  }, priority = 100) %>%
    shiny::bindEvent(input$map_click)
  
  # pt
  pt <- shiny::reactive({
    req(input$map_click) # 确保点击事件存在
    sf::st_point(
      c(
        input$map_click$lng,
        input$map_click$lat
      )
    ) %>%
      sf::st_sfc(crs = 4326) %>%
      sf::st_as_sf() %>%
      sf::st_transform(st_crs(district))
  })
  
  # intersects
  intersects <- shiny::reactive({
    req(pt())
    sectors %>% st_filter(pt(), .predicate = st_intersects) 
  })
  
  # table
  output$details <- shiny::renderTable({
    req(intersects())
    if (nrow(intersects()) > 0) {
      locations %>% st_filter(intersects(), .predicate = st_intersects) %>% st_drop_geometry()
    } else {
      NULL
    }
  })
  
}

shinyApp(ui, server)

效果说明 #

• 移除id参数后，单击地图直接触发点击事件处理，不再显示工具提示
• 禁用doubleClickZoom后，双击地图仅执行数据过滤逻辑，不会放大地图
• 使用req()简化代码，确保点击事件触发后立即更新表格，无需二次点击

内容的提问来源于stack exchange，提问作者Faustin Gashakamba