ejemplos - shiny examples r

Los polígonos de folletos cambian de estilo al elegir la ubicación desde un menú desplegable Brillante

Question

Soy completamente nuevo en Shiny, así que por favor perdona cualquier error o malentendido. Estoy creando una aplicación Brillante con Leaflet en R basado en este ejemplo . El ejemplo funciona a partir de datos de puntos mientras que mi aplicación funciona con polígonos, que parece ser lo que me está causando problemas.

Aquí está el shapefile con el que estoy trabajando y aquí está mi código completo:

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

Quiero que mi aplicación reaccione tanto a los clics de forma como a las selecciones del menú desplegable. Con el código anterior, al hacer clic en polígonos cambia el estilo del polígono para mostrar que se ha seleccionado. También actualiza el menú desplegable con el nombre del país apropiado una vez que se ha hecho clic. Sin embargo, cuando intento seleccionar un país del menú desplegable, no ocurre nada en el mapa. Deseo que las selecciones desplegables den como resultado que el polígono de país apropiado se resalte con el mismo estilo que cuando se hace clic en el polígono.

Es cierto que no entiendo completamente el tercer observeEvent que se supone que observeEvent este objetivo. Intenté hacer coincidir los datos de mi polígono con los datos del marcador vinculado sin suerte. Para tratar de identificar mi problema, imprimí todas las salidas / objetos relevantes del ejemplo e hice lo mismo con mi código. Como está ahora, coinciden perfectamente, pero mi aplicación Shiny todavía no reacciona de la manera que lo hace el ejemplo. ASÍ, del ejemplo vinculado:

  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) : imprime 1 al hacer clic en evento Y selección desplegable
• length(p$id) : imprime 1 al hacer clic en evento, imprime 0 en la selección desplegable
• input$location : imprime cadena de nombre de ubicación al hacer clic en evento Y selección desplegable
• p$id : imprime cadena de nombre de ubicación al hacer clic en evento, imprime NULL desde la selección desplegable
• !length(p$id) : imprime FALSE al hacer clic en evento, imprime TRUE desde la selección desplegable

Y de mi código:

   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) : imprime 1 al hacer clic en evento Y selección desplegable
• length(click$id) : imprime 1 al hacer clic en evento, imprime 0 en la selección desplegable
• input$location : imprime la cadena del nombre del país al hacer clic en el evento Y la selección desplegable
• click$id : imprime cadena de nombre de país al hacer clic en evento, imprime NULL en la selección desplegable
• !length(click$id) : imprime FALSE al hacer clic en evento, imprime TRUE desde la selección desplegable

Sospecho que el problema es con el formato de un marcador versus un polígono, pero de nuevo, todos los objetos relevantes tienen el mismo resultado para ambos conjuntos de códigos, por lo que no estoy seguro de a dónde ir desde aquí. Entonces, ¿cómo puedo codificar esto para que mi selección desplegable resulte en que el polígono se resalte de la misma manera que cuando se hace clic en él?

Answer 1

¡Lo averigué! En mi observeEvent , observeEvent mi polígono seleccionado mediante el click$id lugar de la input$location , razón por la cual no reaccionó a mi selección del menú desplegable. Entonces, en lugar de:

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

Necesitaba usar:

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