html - Shiny - 传单 map 内的控制小部件

标签 html r leaflet shiny

我有一个简单的 Shiny 应用程序,只有一个列出阿富汗地区的下拉列表和一个相同的传单 map 。 enter image description here

可以通过 link 访问形状文件- 使用 http://www.gadm.org/download 中的 AFG_adm2.shp

这是应用程序代码:

library(shiny)
library(leaflet)
library(rgdal)
library(sp)

afg <- readOGR(dsn = "data", layer ="AFG_adm2", verbose = FALSE, stringsAsFactors = FALSE)

ui <- fluidPage(
    titlePanel("Test App"),
    selectInput("yours", choices = c("",afg$NAME_2), label = "Select Country:"),
    actionButton("zoomer","reset zoom"),
    leafletOutput("mymap")

)

server <- function(input, output){
  initial_lat = 33.93
  initial_lng = 67.71
  initial_zoom = 5

  output$mymap <- renderLeaflet({
    leaflet(afg) %>% #addTiles() %>%
       addPolylines(stroke=TRUE, color = "#00000", weight = 1) 
  })

  proxy <- leafletProxy("mymap")

  observe({
    if(input$yours!=""){
      #get the selected polygon and extract the label point 
      selected_polygon <- subset(afg,afg$NAME_2==input$yours)
      polygon_labelPt <- selected_polygon@polygons[[1]]@labpt

      #remove any previously highlighted polygon
      proxy %>% removeShape("highlighted_polygon")

      #center the view on the polygon 
      proxy %>% setView(lng=polygon_labelPt[1],lat=polygon_labelPt[2],zoom=7)

      #add a slightly thicker red polygon on top of the selected one
      proxy %>% addPolylines(stroke=TRUE, weight = 2,color="red",data=selected_polygon,layerId="highlighted_polygon")
    }
  })

  observeEvent(input$zoomer, {
    leafletProxy("mymap") %>% setView(lat = initial_lat, lng = initial_lng, zoom = initial_zoom) %>% removeShape("highlighted_polygon") 
  })


}


# Run the application 
shinyApp(ui = ui, server = server)

编辑:我实际上是在尝试添加一个将缩放重置为默认值的操作按钮(使用 Leafletproxy 和 setview),我想将此按钮放在 map 的右上角而不是它位于 map 上方。

我可以使用 addLayersControl 来执行此操作吗?

EDIT2:

完整应用中的代码:

# Create the map
    output$mymap <- renderLeaflet({
      leaflet(afg) %>% addTiles() %>%
        addPolygons(fill = TRUE,
                    fillColor = ~factpal(acdf$WP_2012), #which color for which attribute
                    stroke = TRUE, 
                    fillOpacity = 1, #how dark/saturation the fill color should be
                    color = "black", #color of attribute boundaries
                    weight = 1, #weight of attribute boundaies
                    smoothFactor = 1,
                    layerId = aid
                    #popup = ac_popup
        ) %>% addPolylines(stroke=TRUE, color = "#000000", weight = 1) %>%
        addLegend("bottomleft", pal = factpal, values = ~WP_2012,
                  title = "Party",
                  opacity = 1
        ) %>% setView(lng = initial_lng, lat = initial_lat, zoom = initial_zoom) %>%
        addControl(html = actionButton("zoomer1","Reset", icon = icon("arrows-alt")), position = "topright")
    })

我看不到 addTiles 中的 map 图 block 或 addControl 中的缩放重置按钮。任何想法为什么会发生这种情况?

最佳答案

你可以直接使用addControl函数:

output$mymap <- renderLeaflet({
    leaflet(afg) %>% #addTiles() %>%
        addPolylines(stroke=TRUE, color = "#00000", weight = 1) %>%
        addControl(actionButton("zoomer","Reset"),position="topright")
})

关于html - Shiny - 传单 map 内的控制小部件,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/42290919/

相关文章:

html - 在 html 中,如何让表中表在视觉上看起来与没有内表一样

r - 是否有一个R函数来获取n个对象的排列数目取k P(n,k)?

删除 data.table 的分组变量

r - terra 管理数字精度 : decimal raster values are modified when writing files

javascript - L.geoJSON - 如何使用更多 L.geoJSON 坐标处理多个引用文件?

javascript - event.latLng 在 Leaflet 中未定义

Angular 2/传单 map ,如何从标记弹出窗口链接到组件? ...路由器链接?

php - drupal 6 内容中的图像链接

html - 渐进式 Web 应用程序 - 它可以使用离线 Mapsforge .map 文件显示 map 吗?

jquery - 如何使用 jquery 交替显示父子关系?