开发者问题收集

Shiny：有没有办法仅在 Shiny 中单击地图后才启用鼠标滚轮缩放？

2016-06-17
1861
r shiny leaflet

有没有办法只在第一次点击地图后启用鼠标滚轮缩放？

我有以下代码，其中我想只在点击地图后缩放地图。有没有办法在 Shiny 中做到这一点？ 

library(shiny)
library(leaflet)
library(maps)

ui <- fluidPage(
 leafletOutput("CountryMap", width = 1000, height = 500)
)

server <- function(input, output){
   Country = map("world", fill = TRUE, plot = FALSE, regions="USA", exact=TRUE)
   output$CountryMap <- renderLeaflet({
   leaflet(Country) %>% addTiles() %>%
   fitBounds(Country$range[1], Country$range[3], Country$range[2], Country$range[4])%>%
   addPolygons(fillOpacity = 0.6,  smoothFactor = 0.5, stroke = TRUE, weight = 1)
})
}

shinyApp(ui =ui, server = server)
2个回答

我非常喜欢 warmoverflow 的想法，因为它纯粹是在 R 方面，并且非常容易理解。我刚刚才看到他已经回答了你的问题。但由于我已经研究了另一种解决方案，所以我也可以在这里发布它。有多个选项并没有什么坏处。

我制作了一个 JavaScript 解决方案，它可以找到传单 map 元素并更改 scrollWheelZoom 属性。这本来会非常简单，因为您只需在启动时 禁用 滚动缩放，并在第一次单击地图后立即 启用 它即可。但是 leaflet 的家伙们通过 此修复程序 使事情变得更加困难。在那里，他们（除了其他事情之外）添加了一个侦听器，只要鼠标移动（非常烦人），它就会 启用 滚动缩放。因此，在我的修复中，我们向文档添加了一个 脚本 ，该脚本还会向鼠标移动事件添加一个侦听器，以 禁用 （从而取消 启用 ） scrollWheelZoom 属性。首次单击 地图 时，将删除此事件侦听器，因此您拥有正常（默认）的缩放选项。

以下脚本代码： 

library(shiny)
library(leaflet)
library(maps)

ui <- fluidPage(
  leafletOutput("CountryMap", width = 1000, height = 500),
  tags$script("
    $(document).ready(function() {    
      setTimeout(function() {

        var map = $('#CountryMap').data('leaflet-map');            
        function disableZoom(e) {map.scrollWheelZoom.disable();}

        $(document).on('mousemove', '*', disableZoom);

        map.on('click', function() {
          $(document).off('mousemove', '*', disableZoom);
          map.scrollWheelZoom.enable();
        });
      }, 100);
    })
  ")
)

server <- function(input, output, session){

  Country = map("world", fill = TRUE, plot = FALSE, regions="USA", exact=TRUE)
  output$CountryMap <- renderLeaflet({
     leaflet(Country) %>% addTiles() %>%
     fitBounds(Country$range[1], Country$range[3], Country$range[2], Country$range[4])%>%
     addPolygons(fillOpacity = 0.6,  smoothFactor = 0.5, stroke = TRUE, weight = 1)
  })
}

shinyApp(ui =ui, server = server)
K. Rohde
2016-06-17

根据此 https://github.com/rstudio/leaflet/issues/179 ，R Leaflet 包没有禁用 zoomControl 或 mouseWheelControl 的选项，但受到链接中 Yihui 建议的启发，这里有一个解决方法，可根据鼠标单击事件动态更改 maxZoom 级别。 

library(shiny)
library(leaflet)
library(maps)

ui <- fluidPage(
    leafletOutput("CountryMap", width = 1000, height = 500)
)

server <- function(input, output){

    Country = map("world", fill = TRUE, plot = FALSE, regions="USA", exact=TRUE)

    # Add a default minZoom and maxZoom of the same value so that the map does not zoom
    output$CountryMap <- renderLeaflet({
        leaflet(Country) %>% addTiles(options=tileOptions(minZoom=4, maxZoom=4)) %>%
            fitBounds(Country$range[1], Country$range[3], Country$range[2], Country$range[4]) %>%
            addPolygons(fillOpacity = 0.6,  smoothFactor = 0.5, stroke = TRUE, weight = 1)               
    })

    # Change a reactive value depending on mouse click
    zoom <- reactiveValues(level=4)

    # This records mouse clicks outside polygons
    observeEvent(input$CountryMap_click, {
        zoom$level = 20
    })

    # This records mouse clicks inside polygons
    observeEvent(input$CountryMap_shape_click, {
        zoom$level = 20
    })

    # Change zoom level of the map
    observe({
        if (zoom$level == 20) {
            leafletProxy("CountryMap") %>% clearTiles() %>%
                addTiles(options=tileOptions(minZoom=4, maxZoom=20))
        }
    })

}

shinyApp(ui =ui, server = server)
Xiongbing Jin
2016-06-17