我有一个Shiny应用,可在地图上显示数据点。
添加了一个绝对面板,可以从数据中进行选择。
这是我的初始地图:
map <- read.csv(text = getURL("https://raw.githubusercontent.com/ThamesEstuaryPartnership/shiny/master/data.csv"), header = T)
ui <- bootstrapPage(tags$style("html, body {width:100%;height:100%}",
tags$head(includeCSS("style.css"),
leafletOutput("mymap", width = "100%", height = "100%"),
absolutePanel(id = "controls", top = 245, left = 15, width = 200, fixed = F, draggable = T,
style = "border-radius: 8px;",
selectizeInput("Feature", "Barriers",
label = h4("Choose a barrier:"),
choices = c("All", levels(map$Feature))),
selectizeInput("Catchment", "Catchment",
label = h4("Choose a catchment:"),
choices = c("All", levels(map$Catchment)))))))
server <- function(input, output, session) {selectedFeature <- reactive({
data <- map
if (input$Feature != "All") {
data <- subset(data, Feature == input$Feature)
}
if (input$Catchment != "All") {
data <- subset(data, Catchment == input$Catchment)
}
data
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles(
urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>', group = "Mapbox") %>%
addScaleBar(position = "bottomleft") %>%
addFullscreenControl() %>%
addEasyButton(easyButton(
icon = "fa-globe", title = "Home",
onClick = JS("function(btn, map){ map.setZoom(9);}"))) %>%
addEasyButton(easyButton(
icon = "fa-crosshairs", title = "Locate Me",
onClick = JS("function(btn, map){ map.locate({setView: true}); }")))
})
observe({
p <- paste0("<strong>Barrier: </strong>",
selectedFeature()$Feature,
"<br><strong>Latitude: </strong>",
selectedFeature()$Latitude,
"<br><strong>Longitude: </strong>",
selectedFeature()$Longitude)
maxLong = max(selectedFeature()$Longitude)
maxLat = max(selectedFeature()$Latitude)
minLong = min(selectedFeature()$Longitude)
minLat = min(selectedFeature()$Latitude)
leafletProxy("mymap", data = selectedFeature()) %>%
clearMarkerClusters() %>%
addMarkers(clusterOptions = markerClusterOptions(), lat = ~Latitude, lng = ~Longitude, popup = p) %>%
fitBounds(minLong, minLat, maxLong, maxLat)
})
}
shinyApp(ui = ui, server = server)
在这里,我可以选择障碍和流域数据,但我希望根据第一个下拉菜单(功能)显示第二个下拉菜单(“流域”),反之亦然。
我尝试使用updateSelectizeInput
,但没有得到正确的地图:
server <- function(input, output, session) {selectedFeature <- reactive({
data <- map
if (input$Feature != "All") {
data <- subset(data, Feature == input$Feature)
}
if (input$Catchment != "All") {
data <- subset(data, Catchment == input$Catchment)
}
data
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles(
urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>', group = "Mapbox") %>%
addScaleBar(position = "bottomleft") %>%
addFullscreenControl() %>%
addEasyButton(easyButton(
icon = "fa-globe", title = "Home",
onClick = JS("function(btn, map){ map.setZoom(9);}"))) %>%
addEasyButton(easyButton(
icon = "fa-crosshairs", title = "Locate Me",
onClick = JS("function(btn, map){ map.locate({setView: true}); }")))
})
observe({
updateSelectizeInput(session, "Catchment", choices = unique(map$Catchment[map$Feature %in% input$Feature]), server = T)
p <- paste0("<strong>Barrier: </strong>",
selectedFeature()$Feature,
"<br><strong>Latitude: </strong>",
selectedFeature()$Latitude,
"<br><strong>Longitude: </strong>",
selectedFeature()$Longitude)
maxLong = max(selectedFeature()$Longitude)
maxLat = max(selectedFeature()$Latitude)
minLong = min(selectedFeature()$Longitude)
minLat = min(selectedFeature()$Latitude)
leafletProxy("mymap", data = selectedFeature()) %>%
clearMarkerClusters() %>%
addMarkers(clusterOptions = markerClusterOptions(), lat = ~Latitude, lng = ~Longitude, popup = p) %>%
fitBounds(minLong, minLat, maxLong, maxLat)
})
}