闪亮的子集数据反应式更新选择输入

时间:2018-06-22 10:29:25

标签: shiny

我有一个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)

})
}

0 个答案:

没有答案