0
votes

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?

1
Welcome to Stackoverflow :) . Please try to create a minimal reproducible example (stackoverflow.com/questions/5963269/…) so it would be easier and quicker for people to help you out.Deena

1 Answers

1
votes

Hi I think your first solution was closer but you should split the APIData in to two functions at least like this

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)}
    a
  })
  filteredData <- reactive({
    a <- APIdata()
    ## resrt of your code here
  })

at the moment you are collecting the data from the api everytime some input changes and that is quite redundant.

After that you can use something like this to set the selectInput

observeEvent({APIdata()},{
    updateSelectInput(session, "species_in",
                      choices = unique(APIdata()[["comName"]]), # fixed
                      selected = input$species_in
    ))})

hope this helps!