从Light下拉菜单中选择位置后，单张多边形会更改样式 [英] Leaflet polygons change style upon choosing location from a Shiny dropdown menu

查看：146
本文介绍了从Light下拉菜单中选择位置后，单张多边形会更改样式的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我完全是新来的，所以请原谅任何错误或误会。我正在R 基于此示例创建一个闪亮的应用程序。该示例从点数据中工作，而我的应用程序使用多边形，这似乎是导致我问题的原因。



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

 库（闪亮）
库
库（sp）
库（rgeos）
库（rgdal）
库（RColorBrewer）
库（栅格）
 
 #pull in full rock country shapefile，set WGS84 CRS 
 countries<  -  readOGR（D：/ NaturalEarth / HIF，layer =ctry_hif，
 stringsAsFactors = F，encoding =UTF-8 ）
国家<  -  spTransform（countries，CRS（+ proj = longlat + ellps = WGS84 + datum = WGS84 + no_defs））
 
 
 #define调色板用于映射
 darkpal<  -  brewer.pal（5，Set3）
 
 #country级
 pal<  -  colorFactor（darkpal，countries @ data $ colors）
 
 
 shinyApp（
 ui = fluidPage（leafletOutput（'myMap'，width =80％，height = 500），
 br（），
 lea fletOutput（'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 = 
 weight = 1，
 stroke = T，
 color =＃000000，
 label =〜as.character（sovereignt），
 group = 国家，
 layerId =〜sovereignt）
}）
 
 
＃change点击事件的多边形样式
 observeEvent（输入$ myMap_shape_click，{
点击<  - 输入$ myMap_shape_click 
 if（is.null（click））
 return（）
 
 #subset countries by click point 
 selected< ;  - 国家[国家@数据$主权==单击$ id，] 
 
 #define传递代理动态更新地图
代理<  -  leafletProxy（myMap）$ b $ 
 
如果（点击$ 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观察事件突出显示点击事件上的多边形
 
 
点击多边形时的#update位置栏
 observeEvent（输入$ myMap_shape_click，{
 click<  - 输入$ myMap_shape_click 
 if（！is.null点击$ id））{
 if（is.null（input $ location）||输入$ location！= click $ id）updateSelectInput（session，location，selected = click $ id）
} 
}）点击事件更新下拉菜单的#end观察事件
 
 
 #update地图标记并查看位置selectInput更改
 observeEvent（输入$ location，{
 
 #set传真代理重新绘制地图
代理< ;  -  leafletProxy（myMap）
 
 #define点击
点击<  - 输入$ myMap_shape_click 
 
 #subset country spdf by input location 
 ctrysub<  -  subset（countries，sovereignt == input $ location）
 
＃定义点对应的多边形
选择<  -  countries [countries @ data $ sovereignt == click $ id ，] 
 
 if（nrow（ctrysub）== 0）{
 proxy％>％removeShape（layerId =Selected）
} else if（length 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 = 选择）} 
}）#end观察事件下拉选择
 
}）#end服务器

我想让我的应用程序对下拉菜单中的形状点击和选择做出反应ENU。使用上述代码，单击多边形将更改多边形样式以显示已选择。一旦点击，它还会更新具有相应国家名称的下拉菜单。但是，当我尝试从下拉菜单中选择一个国家/地区时，地图上没有任何事情发生。 我想要下拉选择，导致适当的国家多边形以与点击多边形时相同的样式突出显示。



诚然，我不完全了解应该实现这个目标的第三个 observeEvent 。我试图将我的多边形数据与链接的标记数据匹配，没有运气。为了找出我的问题，我打印了示例中的所有相关输出/对象，并为我的代码做了相同的操作。现在，它们完美匹配，但是我的Shiny应用程序仍然没有反映该示例的方式。 SO，从链接的例子中：

  observeEvent（输入$ location，{＃更新地图标记并查看位置selectInput更改
p<  - 输入$ Map_marker_click 
 p2<  - 子集（locs，loc == input $ location）
代理<  -  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 下拉选择

  • 输入$ location ：点击事件打印位置名称字符和
    下拉列表选择

  • p $ id 在点击事件中打印位置名称字符串，从下拉列表选择
    • 打印 NULL

  • ！length p $ id）：打印 FALSE 点击事件后，从$ b $打印 TRUE b下拉列表选择



从我的代码：

 code> observeEvent（输入$ location，{
 
 #set传真代理重新绘制地图
代理<  -  leafletProxy（myMap）
 
 #define click point 
 click<  -  input $ myMap_shape_click 
 
 #subset countries spdf by input location 
 ctrysub<  -  subset（countries，sovereignt == input $ location）
 
＃定义点对点多边形
选择<  -  countries [countries @ data $ sovereignt == click $ id，] 
 
 if（nrow（ctrysub） == 0）{
代理％>％removeShape （layerId =Selected）
} else if（length（click $ id）&&输入$ location！= click $ id）{
 proxy％>％addPolygons（data = selected，
 fillColor =yellow，
 fillOpacity = .95，
 color = 橙色，
 opacity = 1，
 weight = 1，
 stroke = T，
 layerId =Selected）
} else if（！length $ id））{
代理％>％addPolygons（data = selected，
 fillColor =yellow，
 fillOpacity = .95，
 color =orange，
 opacity = 1，
 weight = 1，
 stroke = T，
 layerId =Selected）} 
}）#end观察事件下拉选择




  • nrow（ctrysub）：打印 1 点击事件和下拉列表选择

  • 长度（点击$ id）：点击事件打印 1 打印 0 下拉选择

  • 输入$ location ：打印点击事件后的国家/地区名称字符串AND
    下拉式选择

  • 点击$ id ：点击事件打印国家/地区名称字符串，打印 NULL
    从下拉列表选择

  • ！length（click $ id）：prints $ b

    我怀疑问题是与标记与多边形的格式，但是同样的，所有相关对象对于两组代码都具有相同的输出，所以我不知道在哪里从这里走。那么，我如何编写这个代码，这样我的下拉列表选择会以与点击的方式相同的方式突出显示多边形？

    解决方案

    想出来！在我的 observeEvent 中，我通过点击$ id 而不是输入定义了我选定的多边形$ location ，这就是为什么它对我的下拉菜单选择没有反应。所以，而不是：

     ＃定义点对点为对应的多边形
    选择<  - 国家[countries @ data $ == click $ id，]

    我需要使用：

      #define下拉列表选择为对应的多边形
    已选择< -  countries [countries @ data $ sovereignt == input $ location，]


    I'm completely new to Shiny, so please forgive any mistakes or misunderstandings. I'm creating a Shiny application with Leaflet in R based off of this example. The example works from point data whereas my app works with polygons, which appears to be what is causing me problems.

    Here is the shapefile I'm working with and here is my full 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

    I want my app to react to both shape clicks AND selections from the dropdown menu. With the above code, clicking on polygons changes the polygon style to show that it has been selected. It also updates the dropdown menu with the appropriate country name once it has been clicked. When I try to select a country from the dropdown menu, however, nothing happens on the map. I want for dropdown selections to result in the appropriate country polygon being highlighted in the same style as when the polygon is clicked on.

    Admittedly, I don't fully understand the third observeEvent that is supposed to accomplish this goal. I have attempted to match my polygon data to the linked marker data with no luck. To try to pinpoint my issue, I printed all relevant outputs/objects from the example and did the same for my code. As it is now, they match up perfectly, but my Shiny app still doesn't react the way that the example does. SO, from the linked example: 

      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 upon click event AND dropdown selection
    • length(p$id): prints 1 upon click event, prints 0 on dropdown selection
    • input$location: prints location name string upon click event AND dropdown selection
    • p$id: prints location name string upon click event, prints NULL from dropdown selection
    • !length(p$id):prints FALSE upon click event, prints TRUE from dropdown selection

    And from my 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 upon click event AND dropdown selection
    • length(click$id): prints 1 upon click event, prints 0 on dropdown selection
    • input$location: prints country name string upon click event AND dropdown selection
    • click$id: prints country name string upon click event, prints NULL from dropdown selection
    • !length(click$id):prints FALSE upon click event, prints TRUE from dropdown selection

    I suspect that the issue is with the format of a marker versus a polygon, but again, all of the relevant objects have the same output for both sets of code, so I'm not sure where to go from here. So, how can I code this so that my dropdown selection results in the polygon being highlighted in the same way as when it is clicked on?

    解决方案

    Figured it out! In my observeEvent, I defined my selected polygon by the click$id rather than the input$location, which is why it didn't react to my drop-down menu selection. So instead of:

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

    I needed to use: 

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

    这篇关于从Light下拉菜单中选择位置后，单张多边形会更改样式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
JavaScript最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆