Блестящая карта - sliderInput, который отображает только выбор пользователя из pickerInput

Update2 Ответ, предоставленный Беном, решил проблему - Спасибо!

Обновление: благодаря предложению Бена, приведенному ниже, решение состоит в том, чтобы объединить фильтрацию данных по годам и видам. Однако это вызвало новую проблему. Теперь, когда вид выбран, а ползунок года помещен в диапазон, в котором нет записей для вида, приложение вылетает.

Итак, теперь я ищу условное выражение, которое позволяет приложению продолжать работу, но не отображает точек, когда нет записей о видах в пределах заданного диапазона лет (диапазон ввода ползунка).

Обновленный код, отражающий решение Бена

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)

Я создаю блестящее приложение, которое отображает широту и долготу для списка видов. Один sliderInput позволяет пользователю сузить набор данных по годам, а один pickerInput позволяет пользователю выбирать только определенные виды. По умолчанию для параметра pickerInput установлено значение none selected - если вы выберете все и переместите ползунок года, на карте отобразятся все виды в пределах годового диапазона из sliderInput.

Проблема: в настоящее время приложение не позволяет пользователю прокручивать годы только для того, что выбрано в 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)