Shiny Map - sliderInput that only displays user selections from pickerInput

2
votes

Update2 The answer provided by Ben solved the issue -Thanks!

Update: Thanks to Ben's suggestion below, the solution is to combine the data filtering of year and species. This has brought about a new problem however. 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.

So now I'm looking for a conditional statement that allows the app to continue running, but plot no points, when there are no species records within a given year range (slider input range).

Updated Code to reflect Ben's Solution

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)

I am creating a shiny app that displays lat/long points for a list of species. One sliderInput allows the user to narrow the dataset by year, and one pickerInput allows the user to select only certain species. The pickerInput defaults to none selected - if you select all and move the year slider, the map displays all species within the year range from the sliderInput.

Problem: Currently the app does not allow the user to scroll through years for only what is selected in the pickerInput (species). I want to be able to select a number of species from the pickerInput, the use the sliderInput to see records of my selection by year. Currently, when a selection is made in the pickerInput, and the sliderInput is moved, the points default back to displaying all records instead of only what is selected.

To view the problem, run the code and set the slider input to display only the oldest year. This will yield one available species to choose in the picker input. Select that species and then move the slider input to display a larger year range. Points will begin to appear from species other than the one which is selected.

Code, including dummy data set:

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)
1
rshinyleafletshiny-reactivityshinyapps
When input$range changes, leafletProxy uses filteredData() to show the markers on the map. filteredData() only filters based on year, so it automatically includes all the species. Can you combine filteredData and filteredData2 into one reactive data filter, so you filter both by year and species at the same time? – Ben
Thanks for your input Ben - I have tried to include your solution, but receive the following error: Warning: Error in sum: invalid 'type' (list) of argument I suspect that the pickerInput function outputs a list that is 'disassociated' from the main data frame? – Dr. sans
Thanks for the help Ben, see the updated edit for your solution, and a new question ;) – Dr. sans
@Ben could you help with stackoverflow.com/questions/59474422/… – David Adams

1 Answers

0
votes

Dr. Sans - let me know if this is closer to what you had in mind.

I think you want your filteredData() function to filter on year range and input$select to provide a subset of data that can be shown in the map.

In addition, I don't think you need both observeEvent and observe to draw the markers. Just observe will update the markers with changes by either input through reactive 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))
    }
  )
}