Shiny: Gibt es eine Möglichkeit, den Mausrad Zoom nur nach dem Klicken auf die Karte in glänzend zu aktivieren?

Question

Gibt es eine Möglichkeit, den Mausradzoom erst nach dem ersten Klick auf die Karte zu aktivieren?

Ich habe den folgenden Code, in dem ich die Karte nur nach einem Klick auf die Karte zoomen möchte. Gibt es eine Möglichkeit, das glänzend zu machen?

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) 

Answer 1

R Leaflet Paket zu deaktivieren zoomControl oder mouseWheelControl nicht die Möglichkeit haben, noch nach diesem https://github.com/rstudio/leaflet/issues/179, sondern durch Yihui Vorschlag aus dem Link inspiriert, hier eine Abhilfe, die die maxZoom Ebene je nach Mausklick Ereignis dynamisch ändert .

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) 

Answer 2

ich sehr ähnlich wie die Idee von warmoverflow, da es rein auf R-Seite ist und sehr leicht zu verstehen. Ich habe gerade erst gesehen, dass er deine Frage schon beantwortet hat. Aber da ich bereits an einer anderen Lösung gearbeitet habe, kann ich es hier auch posten. Es tut nicht weh, mehrere Optionen zu haben.

Ich produzierte eine JavaScript-Lösung, die das Merkblatt map Element findet und die scrollWheelZoom Eigenschaft ändert. Das wäre sehr geradlinig gewesen, da man einfach disable Scroll Zoom beim Start hochfahren kann und enable es sobald die Map das erste Mal angeklickt wurde. Aber die Flugblatt-Jungs haben die Dinge mit this fix to another issue schwieriger gemacht. Dort haben sie (neben anderen Dingen) einen Listener hinzugefügt, der bei jedem Mausklick (scroll zoom) enables scrollt (ziemlich nervig). Also, in meiner Lösung, fügen wir ein script zu dem Dokument hinzu, das auch einen Listener zu dem Mausbewegungsereignis zu disable hinzufügt (und dadurch die enable von) die scrollWheelZoom-Eigenschaft aufhebt. Wenn Sie zum ersten Mal auf map klicken, wird dieser Ereignis-Listener entfernt und Sie haben normale (Standard) Zoom-Optionen.

Code mit Script unter:

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)