Question

我有一个简单的闪亮应用程序，只有一个下拉列表列出阿富汗地区和相同的传单地图。

可以使用link

中的AFG_adm2.shp在此http://www.gadm.org/download访问形状文件

这是应用代码：

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），我想将此按钮放在地图的右上角而不是它在地图上方。

我可以使用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的地图图块或addControl的缩放重置按钮。有什么想法可能会发生这种情况吗？

Answer 1

您可以直接使用addControl功能：

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

Answer 2

您可以通过在UI中使用闪亮的absolutePanel（）函数来实现此目的，例如

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

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

ui <- fluidPage(
tags$head(
    tags$style(
        HTML(
            '
            .outer {
                position: fixed;
                top: 80px;
                left: 0;
                right: 0;
                bottom: 0;
                overflow: hidden;
                padding: 0;
            }

            #controls-filters {
                background-color: white;
                border:none;
                padding: 10px 10px 10px 10px;
                z-index:150;
            }
            '
        )
    )
), 
titlePanel("Test App"),
absolutePanel(
    id = "controls-filters",
    class = "panel panel-default",
    fixed = TRUE,
    draggable = TRUE,
    top = 100,
    left = "auto",
    right = 20,
    bottom = "auto",
    width = 330,
    height = "auto",
    selectInput("yours", choices = c("", afg$NAME_2), label = "Select Country:"),
    actionButton("zoomer", "reset zoom")
),
div(class = "outer", 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)

这应该可以帮助您入门，但我建议您构建应用程序，使其具有独立的CSS文件。

闪亮 - 控制小部件内部传单地图

2 个答案: