Also see update at bottom of this post
I have a shiny app that pulls data from an API and plots the data. The pull request is dependent on two user inputs: a location (region code) and days back. The API returns recent bird sightings from eBird.org
After the inputs are passed through the app, the user can then type in a species name, which filters the data to only show recent sightings of those species.
Currently, this species input is done through textInput()
in the ui, and the leaflet map defaults to show no species select if the user's input does not match a species in the data frame pulled from the API.
I would like, instead, for the species input in the ui to be a selectInput()
, where the choices =
is a result of a reactive in the server, showing only those species names that are pulled from the user-specified API request. These species names can be created from {{data}}$comName
Following along to some threads posted on this site and others, I tried to do this a few different ways. These are commented out in MY CODE. This code also uses a SOURCE SCRIPT for functions. The areas of interest are headed by: ### --- ### --- ### --- ###
etc.
Primarily, I tried to use a combination of something like this on the server:
output$spChoices <- renderUI({
tagList(
sliderInput(selectInput("species_in", "Species", choices = 'tester',
selected = "Test", multiple = F, width = 170)))
})
And this in the ui:
uiOutput("spChoices")
Here is my code, in case it's easier to view here than at the link:
### GLOBAL SPACE ### ---------------------------------------------------------------------
library(shiny)
library(shinydashboard)
library(shinythemes)
library(leaflet)
library(leaflet.extras)
library(jsonlite)
# Opening connection to pull functions from external file
source('./Functions.R')
# Pulling region code choices from external file
choices = as.character(read.csv("./data/choices.csv")$x)
# Fetching custom map tiles and adding citation
# Making my location icon
uloc = makeIcon(iconUrl = "./uloc.png", iconHeight = 25, iconWidth = 25)
### USER INTERFACE ### -------------------------------------------------------------------
ui <- bootstrapPage(
# TODO: build a smaller title with these:
# h3('test test test test'),
# Adding dynamically updating USER LOC
tags$script(geoloc()),
# Add Google Analytics data
tags$head(HTML(gtag())),
# Setting THEME
theme = shinytheme("superhero"),
# Setting map to FULL-SCREEN
tags$style(type="text/css", "html, body {width:100%;height:100%}"),
# Initializing LEAFLET output
leafletOutput("myMap", width="100%", height="100%"),
# Adding TITLE overlayed on leaflet map
absolutePanel(top = 1, left = 50, draggable = F,
titlePanel("eBird Rarity Viewer")),
# Adding SLIDER input overlayed on leaflet map
absolutePanel(bottom = 1, left = 45, draggable = F,
sliderInput("slider_in", "Days Back",
min = 1, max = 30, value = 3, round = T)),
# Adding REGION INPUT overlayed on leaflet map
absolutePanel(top = 1, right = 45, draggable = F,
selectInput("region_in", "Region Code", choices = choices,
selected = "US-MA", multiple = F, width = 130)),
# Adding SELECT SPECIES INPUT overlayed on leaflet map
absolutePanel(bottom = 105, left = 45, width = 170, draggable = T,
selectInput("species_in", "Species", choices = "",
selected = "", multiple = F, width = 170))
)
### SERVER ### ---------------------------------------------------------------------------
server <- function(input, output, session) {
## -------------------------------------------------------------------------------------
# Rendering data frame from API with slider input
APIdata <- reactive({
# Initial fetch of data from eBird API, with conditionals to reject errant input
a <- try(api2(regionCode = as.character(input$region_in),
back = as.numeric(input$slider_in)))
if(class(a) == "try-error" ||length(a) == 0){return(NULL)}
return(a)
})
## -------------------------------------------------------------------------------------
# Doing more to the data frame
APIdata2 <- reactive({
a <- APIdata()
# Jittering lat/lon points to fix point overlap
a$lat = jitter(a$lat, factor = 3)
# Changing review status from logical to numeric
cols <- sapply(a, is.logical)
a[,cols] <- lapply(a[,cols], as.numeric)
# Initializing new date column
a["date"] <- format(strptime(a$obsDt, format = "%Y-%m-%d"), "%b %d")
# Initializing new color grouping column
a["group"] <- NA
# Assigning colors by review status
idx<- (a$obsReviewed == 0) # Not reviewed
a$group[idx] <- "white"
idx<- (a$obsReviewed == 1) & (a$obsValid == 1) # Reviewed and accepted
a$group[idx] <- "green"
# Adding url for list popups
a["url"] <- NA
a$url = sapply(a$subId, subIDurl)
# Species search filtering
if(input$species_in %in% a$comName){
#a = subset(a, a$comName == as.character(input$species_in))
a = a[a$comName == as.character(input$species_in),]
return(a)
}else{return(a)}
return(a)
})
## -------------------------------------------------------------------------------------
# Updating species input selection
observeEvent({APIdata()},{
updateSelectInput(session, "species_in", choices = unique(APIdata()[["comName"]], selected = ""))
})
## -------------------------------------------------------------------------------------
# Dynamically updating user location
observe({
if(!is.null(input$lat)){
ulat <- input$lat
ulng <- input$long
acc <- input$accuracy
time <- input$time
proxy <- leafletProxy("myMap")
proxy %>%
clearGroup(group="pos") %>%
addMarkers(icon = uloc,lng=ulng, lat=ulat, label = "My Location",
popup=paste("My location is:","<br>",
ulng,"Longitude","<br>", ulat,"Latitude",
"<br>", "My accuracy is:", "<br>", acc, "meters"),
group="pos") %>%
addCircles(lng=ulng, lat=ulat, radius=acc, group="pos") %>%
addEasyButton(easyButton(icon="fa-crosshairs", title="Locate Me",
onClick=JS("function(btn, map){ map.locate({setView: true}); }")))
}
})
## -------------------------------------------------------------------------------------
# Leaflet map
output$myMap = renderLeaflet({
if(is.null(APIdata()))
{
# Rendering leaflet map
return(leaflet() %>% addTiles()) %>%
addSearchOSM(options = searchOSMOptions(zoom = 8)) %>%
setView(-19.451108, 30.479968, 2)
}
else
{
# Splitting up by review status in order to show reviewed on top
notReviewed = APIdata2()[APIdata2()$group == "white",]
accepted = APIdata2()[APIdata2()$group == "green",]
# Rendering leaflet map
leaflet() %>% addTiles() %>%
addCircleMarkers(group = "Not reviewed", data = notReviewed,
color = "#f5f5dc", opacity = 0.7, popup = notReviewed$url,
label = paste(notReviewed$comName,", ",notReviewed$date, ", ",
notReviewed$locName,sep = "")) %>%
addCircleMarkers(group = "Accepted", data = accepted,
color = "#00FF33", opacity = 0.7, popup = accepted$url,
label = paste(accepted$comName,", ",accepted$date, ", ",
accepted$locName, sep = "")) %>%
addLegend(position = "bottomright",
colors = c("#f5f5dc", "#00FF33"),
labels = c("Not reviewed", "Accepted"),
title = "Legend: review status", opacity = 1) %>%
addLayersControl(overlayGroups = c("Not reviewed", "Accepted"), position = "bottomright") %>%
addEasyButton(easyButton(icon="fa-crosshairs", title="Locate Me",
onClick=JS("function(btn, map){ map.locate({setView: true}); }")))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm also open to any suggested edits to my code for improvement!
UPDATE:
I added this line to my code at line 119 (just after rendering APIdata()
) and it almost works, but it only shows the first species from the list. I tried to play with this by selecting a random row and it seemed to throw it into an infinite loop. Am I close?
observe({
updateSelectInput(session, "species_in",
choices = unique(APIdata()$comName)
)})
On further thought, though, I don't think this exact method will work, because once a user selects an input it would be impossible to go back to all species.
UPDATE 2:
I have moved the updateSelectInput()
call to further up in the code, line 82, and that looks more promising. The issue now is that it automatically selects the first species on that list, whereas I want it to default to all species (no selection). I made an initial workaround by adding selected = ""
to the function, which looks great at first, but once you make a selection it works for a split second and then snaps away from it and goes back to all species (= ""
). I'm trying resolve with if statements, any idea?
observe({
updateSelectInput(session, "species_in",
choices = unique(a$comName), selected = ""
)})
UPDATE 3:
Thanks to Bertil Baron for his suggestion, it's much closer to what I want. At this point, though, the map automatically jumps to one of the species in the selectInput()
. As I mentioned in the comment, it doesn't have to do with selectInput(...selected = ""...)
, because I played around with that and it didn't change anything. I think it might have to do with this part:
# Species search filtering
if(input$species_in %in% a$comName){
#a = subset(a, a$comName == as.character(input$species_in))
a = a[a$comName == as.character(input$species_in),]
return(a)
}else{return(a)}
Any idea where I should be putting this in order for the app to work as described above?