从闪亮下拉菜单中选择位置时传单多边形更改样式

Question

我是 Shiny 的新手，所以请原谅任何错误或误解。我正在用 R based off of this example 中的 Leaflet 创建一个闪亮的应用程序。该示例使用点数据，而我的应用程序使用多边形，这似乎是导致我出现问题的原因。

Here 是我正在使用的 shapefile，这是我的完整代码：

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

我希望我的应用对形状点击和下拉菜单中的选择做出反应。使用上面的代码，单击多边形会更改多边形样式以显示它已被选中。一旦单击它，它还会使用适当的国家名称更新下拉菜单。但是，当我尝试从下拉菜单中选择一个国家/地区时，地图上什么也没有发生。 我希望下拉选择能够以与单击多边形时相同的样式突出显示相应的国家多边形。

诚然，我完全理解第三个observeEvent 应该实现这个目标。我试图将我的多边形数据与链接的标记数据进行匹配，但没有成功。为了找出我的问题，我打印了示例中的所有相关输出/对象，并对我的代码做了同样的事情。就像现在一样，它们完美匹配，但我的 Shiny 应用程序仍然没有像示例那样做出反应。所以，从链接的例子：

  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)：在点击事件和下拉选择时打印1
• length(p$id)：在点击事件时打印1，在下拉选择时打印0
• input$location：在点击事件时打印位置名称字符串 AND 下拉选择
• p$id：在点击事件时打印位置名称字符串，打印NULL 从下拉选择中
• !length(p$id):prints FALSE 在点击事件时，打印TRUE from 下拉选择

从我的代码中：

   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)：在点击事件和下拉选择时打印1
• length(click$id)：在点击事件时打印1，在下拉选择时打印0
• input$location：在点击事件时打印国家名称字符串 AND 下拉选择
• click$id：在点击事件时打印国家名称字符串，打印NULL 从下拉选择中
• !length(click$id):prints FALSE on click event, prints TRUE from 下拉选择

我怀疑问题出在标记与多边形的格式上，但同样，所有相关对象对于两组代码都有相同的输出，所以我不知道从哪里开始。那么，我该如何编写代码，以便我的下拉选择导致多边形以与单击时相同的方式突出显示？

Answer 1

想通了！在我的observeEvent 中，我用click$id 而不是input$location 定义了我选择的多边形，这就是它对我的下拉菜单选择没有反应的原因。所以而不是：

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

我需要使用：

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