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)
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))
}
)
}