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

Question

我对Shiny完全陌生，所以请原谅任何错误或误解。我正在 R 中使用 Leaflet 创建一个闪亮的应用程序基于此示例。该示例适用于点数据，而我的应用程序适用于多边形，这似乎是导致我出现问题的原因。

这里是我正在使用的形状文件，这是我的完整代码：

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
```
：在单击事件时打印位置名称字符串并且下拉选择
```
p$id
```
：在单击事件时打印位置名称字符串，打印
```
NULL
```
从下拉选择
```
!length(p$id)
```
：在单击事件时打印
```
FALSE
```
，从以下位置打印
```
TRUE
```
下拉选择

从我的代码中：

   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
```
：在单击事件时打印国家/地区名称字符串并且下拉选择
```
click$id
```
：在单击事件时打印国家/地区名称字符串，打印
```
NULL
```
从下拉选择
```
!length(click$id)
```
：在单击事件时打印
```
FALSE
```
，从以下位置打印
```
TRUE
```
下拉选择

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

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

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

问题描述投票：0回答：1

1个回答

最新问题

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

问题描述 投票：0回答：1

1个回答

最新问题

问题描述投票：0回答：1