Shiny:有没有办法在点击闪亮的地图后启用鼠标滚轮变焦?

时间:2016-06-17 12:02:38

标签: r shiny leaflet

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

我有以下代码,我只想在点击地图后缩放地图。有没有办法在闪亮的地方做到这一点?

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 个答案:

答案 0 :(得分:4)

我非常喜欢 warmoverflow 的想法,因为它纯粹是在R方面而且非常容易理解。我只是看到他已经回答了你的问题。但是因为我已经开始研究另一个解决方案,所以我也会在这里发布。有多种选择并不会有什么坏处。

我制作了一个JavaScript解决方案,用于查找传单map元素并更改scrollWheelZoom属性。这可能非常简单,因为您可以在启动时disable滚动缩放,并在第一次点击地图后立即enable。但传单人员用this fix to another issue使事情变得更加困难。在那里,他们(除了其他东西)添加了一个监听器,只要鼠标移动enables滚动缩放(非常讨厌)。因此,在我的修复程序中,我们向文档中添加script,该文档还将鼠标移动事件的监听器添加到disable(从而取消enable scrollWheelZoom map属性。第一次单击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) 时,将删除此事件侦听器,因此您可以使用普通(默认)缩放选项。

以下脚本代码:

.side-panel {
  padding: 30px 0;
  position: absolute;
    Z-INDEX: 30;
}
.b > ul {
    position: absolute;
    left: -110px;
    transform: translate(0) translateZ(0);
    width: 150px;
    transition: transform .3s .1s ease-in-out;
}

答案 1 :(得分:1)

R Leaflet包没有根据此https://github.com/rstudio/leaflet/issues/179禁用zoomControlmouseWheelControl的选项,但受到了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)