閃亮 - 控制小部件內部傳單地圖

Question

我有一個簡單的閃亮應用程序，只是一個下拉列表阿富汗地區和傳單地圖相同。

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) 

編輯：我其實是想添加一個動作用AFG_adm2.shp從http://www.gadm.org/download

這裏的應用程序代碼 -

形狀文件可以在這個link訪問按鈕，將縮放重置爲默認值（使用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

您可以通過在界面中使用閃亮的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文件。

Answer 2

您可以直接使用的addControl功能：

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