Shiny Map - 僅顯示來自pickerInput的用戶選擇的滑塊輸入

Question

Update2 Ben提供的答案解決了這個問題-謝謝！

更新：感謝 Ben 在下面的建議，解決方案是結合年份和物種的數據過濾。 然而這帶來了一個新的問題。 Now, when a species is selected, and the year slider is put into a range where there are no records for the species, the app crashes.

所以現在我正在尋找一個允許應用程序繼續運行的條件語句，但是 plot 沒有積分，當在給定年份范圍內沒有物種記錄時（滑塊輸入范圍）。

更新代碼以反映 Ben 的解決方案

library(shiny)
library(leaflet)
library(leaflet.providers)
library(RColorBrewer)
library(shinyWidgets)
library(dplyr)

binomial = c("Mya arenaria", "Laternula gracilis", "Carcinus maenas", "Polydora cornuta", "Sphaeroma quoianum", "Mya arenaria", 
             "Monocorophium acherusicum", "Barentsia benedeni","Monocorophium insidiosum","Sargassum muticum")
year = c(1999, 2000, 1995, 1975, 2002, 2002, 1965, 2018, 2018, 1999)
latitude = c(40.64150, 40.69515, 40.72200, 40.72000, 41.76798, 40.74250, 40.72325, 40.69515, 40.72937, 40.73250)
longitude = c(-124.3123, -124.2494, -124.2362, -124.2269, -124.2269, -124.2218, -124.2199, -124.2198, -124.2095, -124.2083)
misp = data.frame(binomial,year,latitude,longitude)
misp$binomial = as.character(misp$binomial)
color = grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
pal <- colorFactor(
  palette = color,
  domain = misp$binomial)


ui <- bootstrapPage(
            tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
                    leafletOutput("map", width = "100%", height = "100%"),

                    absolutePanel(top = 10, right = 10,
                      sliderInput("range","Year", min(misp$year),max(misp$year),
                                  value = range(misp$year), step=1, sep = ""),
                      pickerInput("select","Species", choices = unique(sort(misp$binomial)), options = list(`actions-box` = TRUE),
                                  multiple = T, selected = unique(sort(misp$binomial)))

  )
)

server <- function(input, output, session){

  filteredData <- reactive({
     misp[misp$year >= input$range[1] & misp$year <= input$range[2] & misp$binomial %in% input$select,]})

  filteredDataYr <- reactive({
    misp[misp$year >= input$range[1] & misp$year <= input$range[2],]})

  output$map <- renderLeaflet({
    leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
      fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})

  observeEvent(input$range,{
    updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredDataYr()$binomial)), selected = filteredData()$binomial)
        leafletProxy("map", data = filteredData()) %>%
          clearMarkers() %>%
          addCircleMarkers(popup = ~as.character(binomial),
                       label = ~as.character(binomial), radius = 5,
                       stroke = FALSE, fillOpacity = 2, color = ~pal(binomial))
 })

  observe(
    if (nrow(filteredData()) == 0) {leafletProxy("map") %>% clearMarkers()}
    else
      leafletProxy("map", data = filteredData()) %>%
      clearMarkers() %>%
      addCircleMarkers(popup = ~as.character(binomial),
                       label = ~as.character(binomial), radius = 5,
                       stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))

   )
}

shinyApp(ui, server)

我正在創建一個 shiny 應用程序，它顯示物種列表的緯度/經度點。 一個 sliderInput 允許用戶按年份縮小數據集，一個 pickerInput 允許用戶 select 僅某些物種。 選擇器輸入默認為未選擇 - 如果您將 select 全部移動並移動年份 slider，則 map 顯示來自滑塊輸入的年份范圍內的所有物種。

問題：目前，該應用程序不允許用戶僅滾動在pickerInput（物種）中選擇的年份。 我希望能夠從pickerInput 中輸入select 多個品種，使用sliderInput 可以看到我選擇的年份記錄。 目前，當在 pickerInput 中進行選擇並移動 sliderInput 時，這些點默認返回顯示所有記錄，而不是僅顯示選擇的記錄。

要查看問題，請運行代碼並將 slider 輸入設置為僅顯示最舊的年份。 這將在選擇器輸入中產生一種可供選擇的物種。 Select那個品種再移動slider輸入顯示更大的年份范圍。 點將開始從所選物種以外的物種中出現。

代碼，包括虛擬數據集：

library(shiny)
library(leaflet)
library(leaflet.providers)
library(RColorBrewer)
library(shinyWidgets)
library(dplyr)

binomial = c("Mya arenaria", "Laternula gracilis", "Carcinus maenas", "Polydora cornuta", "Sphaeroma quoianum", "Mya arenaria", 
             "Monocorophium acherusicum", "Barentsia benedeni","Monocorophium insidiosum","Sargassum muticum")
year = c(1999, 2000, 1995, 1975, 2002, 2002, 1965, 2018, 2018, 1999)
latitude = c(40.64150, 40.69515, 40.72200, 40.72000, 41.76798, 40.74250, 40.72325, 40.69515, 40.72937, 40.73250)
longitude = c(-124.3123, -124.2494, -124.2362, -124.2269, -124.2269, -124.2218, -124.2199, -124.2198, -124.2095, -124.2083)
misp = data.frame(binomial,year,latitude,longitude)
misp$binomial = as.character(misp$binomial)

color = grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
pal <- colorFactor(
  palette = color,
  domain = misp$binomial)


ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),

  absolutePanel(top = 10, right = 10,
                sliderInput("range","Year", min(misp$year),max(misp$year),
                            value = range(misp$year), step=1, sep = ""),
                pickerInput("select","Species", choices = unique(sort(misp$binomial)), options = list(`actions-box` = TRUE),
                            multiple = T, selected = NULL)
  )
)

server <- function(input, output, session){

  filteredData <- reactive({
    misp[misp$year >= input$range[1] & misp$year <= input$range[2],]})

  filteredData2 <- reactive({
    misp[misp$binomial %in% input$select,]})

  output$map <- renderLeaflet({
    leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
      fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})

  observeEvent(input$range,{
    updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredData()$binomial)), selected =filteredData2()$binomial)
    leafletProxy("map", data = filteredData()) %>%
      clearMarkers() %>%
      addCircleMarkers(popup = ~as.character(binomial),
                       label = ~as.character(binomial), radius = 5,
                       stroke = FALSE, fillOpacity = 2, color = ~pal(binomial))
  })

  observe(
    if (nrow(filteredData2()) == 0) {leafletProxy("map") %>% clearMarkers()}
    else
      leafletProxy("map", data = filteredData2()) %>%
      clearMarkers() %>%
      addCircleMarkers(popup = ~as.character(binomial),
                       label = ~as.character(binomial), radius = 5,
                       stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))

  )
}

shinyApp(ui, server)

Answer 1

Sans 博士 - 讓我知道這是否更接近您的想法。

我認為您希望您的filteredData() function 過濾年份范圍並input$select以提供可以在 map 中顯示的數據子集。

另外，我認為您不需要同時使用observeEvent和observe來繪制標記。 只需observe將通過反應性filteredData()的任一輸入更新標記。

server <- function(input, output, session){

  filteredData <- reactive({
    misp %>%
      filter(year >= input$range[1] & year <= input$range[2]) %>%
      filter(binomial %in% input$select)
  })

  filteredChoices <- reactive({
    misp %>%
      filter(year >= input$range[1] & year <= input$range[2])
  })

  output$map <- renderLeaflet({
    leaflet(misp) %>% addProviderTiles(providers$CartoDB.Positron) %>%
      fitBounds(min(misp$longitude), min(misp$latitude), max(misp$longitude), max(misp$latitude))})

  observeEvent(input$range, {
    updatePickerInput(session=session, inputId="select", choices = unique(sort(filteredChoices()$binomial)), selected = filteredData()$binomial)
  })

  observe(
    if (nrow(filteredData()) == 0) {
      leafletProxy("map") %>%
        clearMarkers()
    }
    else {
      leafletProxy("map", data = filteredData()) %>%
      clearMarkers() %>%
      addCircleMarkers(popup = ~as.character(binomial),
                       label = ~as.character(binomial), radius = 5,
                       stroke = FALSE, fillOpacity = 2,color = ~pal(binomial))
    }
  )
}