Question

Update2 Ben提供的答案解决了问题-谢谢！

更新：感谢Ben在下面的建议，解决方案是将年份和物种的数据过滤结合起来。但是，这带来了新的问题。现在，当选择一个物种并将年份滑块置于没有该物种记录的范围内时，该应用程序将崩溃。

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

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

我正在创建一个闪亮的应用程序，该应用程序显示某个物种列表的经纬度。一个sliderInput允许用户按年份缩小数据集，而一个pickerInput则允许用户仅选择某些物种。 pickerInput默认为未选中状态-如果您全选并移动Year滑块，则地图会显示sliderInput所在年份范围内的所有物种。

问题：当前，该应用程序不允许用户仅滚动选择器输入（物种）中选定的年份。我希望能够从pickerInput中选择一些种类，使用slideInput可以按年份查看我的选择记录。当前，当在pickerInput中进行选择并且移动了liderInput时，这些点默认返回显示所有记录，而不是仅显示选择的记录。

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

代码，包括虚拟数据集：

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()函数可以对年份范围进行过滤，而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))
    }
  )
}

闪亮的地图-仅显示来自pickerInput的用户选择的sliderInput

1 个答案: