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

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

我希望我的应用对下拉菜单中的形状点击和 select离子做出反应。使用上面的代码，单击多边形会更改多边形样式以显示它已被 selected。单击后，它还会使用适当的国家/地区名称更新下拉菜单。然而，当我尝试从下拉菜单中 select 一个国家时，地图上没有任何反应。 我希望下拉菜单 selections 以与单击多边形时相同的样式突出显示相应的国家/地区多边形。

诚然，我完全理解应该实现此目标的第三个 observeEvent。我试图将我的多边形数据与链接的标记数据匹配，但没有成功。为了找出我的问题，我打印了示例中的所有相关 outputs/objects 并对我的代码执行了相同的操作。就像现在一样，它们完美匹配，但我的 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)：在单击事件和下拉菜单 selection

1

length(p$id)：在单击事件时打印 1，在下拉菜单 selection

0

input$location：在单击事件时打印位置名称字符串并且下拉 selection
p$id：点击事件时打印位置名称字符串，打印NULL 来自下拉列表 selection
!length(p$id)：点击事件时打印 FALSE，打印 TRUE 来自下拉 selection

从我的代码中：

   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)：在单击事件和下拉菜单 selection

1

length(click$id)：在单击事件时打印 1，在下拉菜单 selection

0

input$location：在点击事件时打印国家名称字符串并且下拉 selection
click$id：点击事件时打印国家名称字符串，打印NULL 来自下拉列表 selection
!length(click$id)：点击事件时打印 FALSE，打印 TRUE 来自下拉 selection

我怀疑问题出在标记与多边形的格式上，但同样，所有相关对象对两组代码都有相同的输出，所以我不确定从这里该何去何从.那么，我该如何编写代码才能使我的下拉菜单 selection 导致多边形以与单击时相同的方式突出显示？

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,]

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

Leaflet polygons change style upon choosing location from a Shiny dropdown menu

r

leaflet

drop-down-menu

shiny

dropdown