Shiny Map -sliderInput 仅显示来自 pickerInput 的用户选择答案

【问题标题】：Shiny Map - sliderInput that only displays user selections from pickerInputShiny Map -sliderInput 仅显示来自 pickerInput 的用户选择
【发布时间】：2020-02-05 02:18:46
【问题描述】：

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.

所以现在我正在寻找一个条件语句，当给定年份范围（滑块输入范围）内没有物种记录时，该条件语句允许应用程序继续运行，但不绘制任何点。

更新代码以反映 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)

我正在创建一个闪亮的应用程序，它显示物种列表的纬度/经度点。一个滑块输入允许用户按年份缩小数据集，一个选择器输入允许用户仅选择某些物种。 pickerInput 默认为 none selected - 如果您选择全部并移动年份滑块，则地图会显示来自滑块输入的年份范围内的所有物种。

问题： 目前，该应用程序不允许用户仅滚动在 pickerInput（物种）中选择的年份。我希望能够从pickerInput 中选择一些物种，使用sliderInput 来查看我的选择记录。目前，当在 pickerInput 中进行选择并移动 sliderInput 时，点默认返回显示所有记录，而不是仅显示选择的记录。

要查看问题，请运行代码并将滑块输入设置为仅显示最旧的年份。这将在选择器输入中产生一种可供选择的物种。选择该物种，然后移动滑块输入以显示更大的年份范围。点将开始从所选物种以外的物种中出现。

代码，包括虚拟数据集：

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)

【问题讨论】：

当input$range 改变时，leafletProxy 使用filteredData() 在地图上显示标记。 filteredData() 仅根据年份进行过滤，因此它会自动包含所有物种。您能否将filteredData 和filteredData2 组合成一个反应式数据过滤器，这样您就可以同时按年份和物种进行过滤？
感谢您的输入 Ben - 我已尝试包含您的解决方案，但收到以下错误：警告：总和错误：参数的无效“类型”（列表）我怀疑 pickerInput 函数输出与主数据框“解除关联”的列表？
感谢 Ben 的帮助，请查看您的解决方案的更新编辑，以及一个新问题；)
@Ben 你能帮忙stackoverflow.com/questions/59474422/…

标签： r shiny leaflet shiny-reactivity shinyapps

【解决方案1】：

博士。 Sans - 如果这更接近您的想法，请告诉我。

我认为您希望您的 filteredData() 函数在年份范围内进行过滤，并且 input$select 提供可以在地图中显示的数据子集。

此外，我认为您不需要同时使用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))
    }
  )
}

【讨论】：