Leaflet-Polygone ändern den Stil bei der Auswahl des Ortes aus einem Shiny Dropdown-Menü

Question

Ich bin komplett neu in Shiny, also bitte verzeihen Sie Fehler oder Missverständnisse. Ich erstelle eine Shiny-Anwendung mit Leaflet in R based off of this example. Das Beispiel arbeitet mit Punktdaten, während meine App mit Polygonen arbeitet, was mir Probleme bereitet.

Here ist die Shape-Datei Ich arbeite mit und hier ist mein vollständiger Code:

library(shiny) 
library(leaflet) 
library(sp) 
library(rgeos) 
library(rgdal) 
library(RColorBrewer) 
library(raster) 

#pull in full rock country shapefile, set WGS84 CRS 
countries <- readOGR("D:/NaturalEarth/HIF", layer = "ctry_hif", 
        stringsAsFactors = F, encoding = "UTF-8") 
countries <- spTransform(countries, CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")) 


#define color palettes for mapping 
darkpal <- brewer.pal(5, "Set3") 

#country level 
pal <- colorFactor(darkpal, countries@data$colors) 


shinyApp(
    ui = fluidPage(leafletOutput('myMap', width = "80%", height = 500), 
       br(), 
       leafletOutput('myMap2', width = "80%", height = 500), 
       absolutePanel(width = "20%", top = 10, right = 5, 
           selectInput(inputId = "location", 
              label = "Country", 
              choices = c("", countries@data$sovereignt), 
              selected = "") 
       ) 
), 


    #country-level Rock map 
    server <- function(input, output, session) { 

    output$myMap <- renderLeaflet({ 
     leaflet(countries) %>% 
     addTiles() %>% 
     addPolygons(fillColor = ~pal(countries@data$colors), 
        fillOpacity = 1, 
        weight = 1, 
        stroke = T, 
        color = "#000000", 
        label = ~as.character(sovereignt), 
        group = "Countries", 
        layerId = ~sovereignt) 
    }) 


    #change polygon style upon click event 
    observeEvent(input$myMap_shape_click, { 
     click <- input$myMap_shape_click 
     if(is.null(click)) 
     return() 

     #subset countries by click point 
     selected <- countries[countries@data$sovereignt == click$id,] 

     #define leaflet proxy for dynamic updating of map 
     proxy <- leafletProxy("myMap") 

     #change style upon click event 
     if(click$id == "Selected"){ 
     proxy %>% removeShape(layerId = "Selected") 
     } else { 
     proxy %>% 
      setView(lng = click$lng, lat = click$lat, zoom = input$myMap_zoom) %>% 
      addPolygons(data = selected, 
         fillColor = "yellow", 
         fillOpacity = .95, 
         color = "orange", 
         opacity = 1, 
         weight = 1, 
         stroke = T, 
         layerId = "Selected")} 
    }) #end observe event for highlighting polygons on click event 


    #update location bar when polygon is clicked 
    observeEvent(input$myMap_shape_click, { 
     click <- input$myMap_shape_click 
     if(!is.null(click$id)){ 
     if(is.null(input$location) || input$location!=click$id) updateSelectInput(session, "location", selected=click$id) 
     } 
    }) #end observe event for updating dropdown upon click event 


    #update the map markers and view on location selectInput changes 
    observeEvent(input$location, { 

     #set leaflet proxy for redrawing of map 
     proxy <- leafletProxy("myMap") 

     #define click point 
     click <- input$myMap_shape_click 

     #subset countries spdf by input location 
     ctrysub <- subset(countries, sovereignt == input$location) 

     #define click point as corresponding polygon 
     selected <- countries[countries@data$sovereignt == click$id,] 

     if(nrow(ctrysub) == 0){ 
     proxy %>% removeShape(layerId = "Selected") 
     } else if(length(click$id) && input$location != click$id){ 
     proxy %>% addPolygons(data = selected, 
           fillColor = "yellow", 
           fillOpacity = .95, 
           color = "orange", 
           opacity = 1, 
           weight = 1, 
           stroke = T, 
           layerId = "Selected") 
     } else if(!length(click$id)){ 
     proxy %>% addPolygons(data = selected, 
           fillColor = "yellow", 
           fillOpacity = .95, 
           color = "orange", 
           opacity = 1, 
           weight = 1, 
           stroke = T, 
           layerId = "Selected")} 
    }) #end observe event for drop down selection 

    }) #end server 

Ich mag meine app für beide Form Klicks und eine Auswahl aus dem Dropdown-Menü zu reagieren. Mit dem obigen Code ändert das Klicken auf Polygone den Polygonstil, um anzuzeigen, dass er ausgewählt wurde. Es aktualisiert auch das Dropdown-Menü mit dem entsprechenden Ländernamen, nachdem es angeklickt wurde. Wenn ich versuche, ein Land aus dem Dropdown-Menü auszuwählen, passiert jedoch nichts auf der Karte. Ich möchte, dass bei Dropdown-Auswahlmöglichkeiten das entsprechende Länder-Polygon im selben Stil hervorgehoben wird wie beim Klicken auf das Polygon.

Zugegeben, ich weiß nicht vollständig die dritte observeEvent verstehen, die angeblich dieses Ziel zu erreichen. Ich habe versucht, meine Polygondaten mit den verknüpften Markierungsdaten ohne Glück zusammenzubringen. Um zu versuchen, mein Problem zu lokalisieren, druckte ich alle relevanten Ausgaben/Objekte aus dem Beispiel und tat das gleiche für meinen Code. Wie es jetzt ist, passen sie perfekt zusammen, aber meine Shiny-App reagiert immer noch nicht so wie das Beispiel.SO, aus dem verknüpften Beispiel:

observeEvent(input$location, { # update the map markers and view on location selectInput changes 
    p <- input$Map_marker_click 
    p2 <- subset(locs, loc==input$location) 
    proxy <- leafletProxy("Map") 
    if(nrow(p2)==0){ 
     proxy %>% removeMarker(layerId="Selected") 
    } else if(length(p$id) && input$location!=p$id){ 
     proxy %>% setView(lng=p2$lon, lat=p2$lat, input$Map_zoom) %>% acm_defaults(p2$lon, p2$lat) 
    } else if(!length(p$id)){ 
     proxy %>% setView(lng=p2$lon, lat=p2$lat, input$Map_zoom) %>% acm_defaults(p2$lon, p2$lat) 
    } 
    }) 

• nrow(p2): prints 1 auf Click-Ereignis und Drop-Down-Auswahl
• length(p$id): prints 1 auf Click-Ereignis, druckt 0 auf Drop-Down-Auswahl
• input$location: druckt Ortsnamen Zeichenfolgen-nach-Klick-Ereignis UND Dropdown-Auswahl
• p$id: druckt den Namen des Standorts u pon klicken Ereignis, druckt NULL von Drop-Down-Auswahl
• !length(p$id): prints FALSE auf Click-Ereignis, druckt TRUE aus Drop-Down-Auswahl

Und von meinem Code:

observeEvent(input$location, { 

     #set leaflet proxy for redrawing of map 
     proxy <- leafletProxy("myMap") 

     #define click point 
     click <- input$myMap_shape_click 

     #subset countries spdf by input location 
     ctrysub <- subset(countries, sovereignt == input$location) 

     #define click point as corresponding polygon 
     selected <- countries[countries@data$sovereignt == click$id,] 

     if(nrow(ctrysub) == 0){ 
     proxy %>% removeShape(layerId = "Selected") 
     } else if(length(click$id) && input$location != click$id){ 
     proxy %>% addPolygons(data = selected, 
           fillColor = "yellow", 
           fillOpacity = .95, 
           color = "orange", 
           opacity = 1, 
           weight = 1, 
           stroke = T, 
           layerId = "Selected") 
     } else if(!length(click$id)){ 
     proxy %>% addPolygons(data = selected, 
           fillColor = "yellow", 
           fillOpacity = .95, 
           color = "orange", 
           opacity = 1, 
           weight = 1, 
           stroke = T, 
           layerId = "Selected")} 
    }) #end observe event for drop down selection 

• nrow(ctrysub): prints 1 nach Klick Ereignis UND Dropdown-Auswahl
• length(click$id): prints 1 auf Click-Ereignis, druckt 0 auf Drop-Down-Auswahl
• input$location: prints Zeichenfolge Ländernamen auf Click-Ereignis und Drop-Down-Auswahl
• click$id: prints Land name string auf Click-Ereignis, druckt NULL von Drop-Down-Auswahl
• !length(click$id): prints FALSE auf Click-Ereignis, druckt TRUE aus Drop-Down-Auswahl

Ich vermute, dass das Problem mit dem Format einer Markierung im Vergleich zu einem Polygon ist, aber wieder haben alle relevanten Objekte die gleiche Ausgabe für beide Code-Gruppen, so dass ich nicht sicher bin, wohin ich von hier gehen soll. Also, wie kann ich das so kodieren, dass meine Dropdown-Auswahl dazu führt, dass das Polygon auf die gleiche Weise hervorgehoben wird wie beim Anklicken?

Answer 1

Ich habe es herausgefunden! In meinem observeEvent habe ich mein ausgewähltes Polygon durch die click$id anstatt der input$location definiert, weshalb es nicht auf meine Dropdown-Menüauswahl reagierte. Also statt:

#define click point as corresponding polygon 
     selected <- countries[countries@data$sovereignt == click$id,] 

Ich brauchte zu verwenden:

#define dropdown selection as corresponding polygon 
     selected <- countries[countries@data$sovereignt == input$location,]