Shiny - Lab Meeting S25

Author

J. Elias

Shiny

Shiny is an R package meant to create an easy web interface to interact with background code: https://shiny.rstudio.com/tutorial/

User Interface (ui)
Server
Run app

The UI is what we see and interact with:

(Point and click actions)

Titles, panels, text boxes, sliders, buttons, etc.
Our goal is to design how the app looks and acts with the UI.
The Server gives meaning to the UI - If we call something “submit_button” in the UI, it needs to be called that in the server too

# create a ui with no server output

# install "shiny" and probably "bslib" (a couple options to make apps pretty)

library(shiny)

ui <- fluidPage(
  titlePanel('Hello Generator'), 
  
  sidebarLayout(
    sidebarPanel(
      actionButton('submit_button', 'Push'),
      textInput(inputId = "name", label="Name", value='Joe')
    ), 
    mainPanel(
      textOutput('text')
    )
  )
)

The server defines what is being produced by the app based on how we defined our UI

‘textOutput’ in the above UI will need be rendered using the server
Server works as a function in R : function (input, output, session)
- input = stores the input elements (text boxes, slider, buttons). Any input referenced in the server will be input$____
- output = used to send results back to the UI, e.g., renderText to match textOutput(text)
- session = modifying the UI mid-session. Otherwise, we’d run and re-run complex apps from code with every interaction.

server<-function(input, output, session){
  observeEvent(input$submit_button, {
    output$text<-rendertext({
      paste("Hello", input$name)
    })
  })
}

All together

ui <- fluidPage(
  titlePanel('Hello Generator'), 
  
  sidebarLayout(
    sidebarPanel(
      actionButton('submit_button', 'Push'),
      textInput(inputId = "name", label="Name", value='Joe')
    ), 
    mainPanel(
      textOutput('text')
    )
  )
)

server<-function(input, output, session){
  observeEvent(input$submit_button, {
    output$text<-renderText({
      paste("Hello", input$name, '!!!!')
    })
  })
}

shinyApp(ui = ui, server = server)

We can also modify it as needed with ‘real’ inside the function

Geographic buffer app

This is a smaller piece of a larger app I would like to make that will define a sampling area, take into consideration geodata for that area (elevation, ppt, temp, etc.), and plot sites that are evenly distributed across the data distribution.
So far I have only figured out how to plot a buffer (sample extent) around a single location. Once we start working with different geodata layers it gets messy with CRS projection and alignment.

library(shiny)
library(bslib)


Attaching package: 'bslib'

The following object is masked from 'package:utils':

    page

library(sf)

Linking to GEOS 3.13.0, GDAL 3.10.1, PROJ 9.5.1; sf_use_s2() is TRUE

library(leaflet)
library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.0.4

── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

sf_use_s2(F) # makes sf more compatible

Spherical geometry (s2) switched off

ui<-fluidPage(
  titlePanel('Where Should I Sample?'), 
  sidebarLayout(
    sidebarPanel(
      numericInput('y', 'Longitude', value=-75.9180), 
      numericInput('x', 'Latitude', value=42.0987), 
      numericInput('extent', 'Sampling Extent (meters)', value = 10000), 
      actionButton('run', 'Enhance')
    ), 
    mainPanel(
      card(
        leafletOutput('map'),
        plotOutput('final')
      )
    )
  )
)


server<-function(input, output, session){
  observeEvent(input$run, {
    # define our starting point as a geographic object 
    start_pnt<-st_as_sf(
      data.frame(lat=input$x, long=input$y), 
      coords=c('long', 'lat'), crs=4326)
    
    # define our circle around our point to a given distance (input$extent)
    sample_extent<-start_pnt %>% 
      st_transform(3857) %>% # to define a circle we need to work in Mercater projection then revert back to WGS 84 (lat/lon projection)
      
      st_buffer(input$extent) %>% 
      st_transform(4326)
    
    # plot the extent and starting location in a leaflet map (open source version of google maps)
    output$map<-renderLeaflet({
      leaflet() %>% 
        addTiles() %>% 
        setView(lng=input$y, lat=input$x, zoom=8) %>% 
        addMarkers(lng=input$y, lat=input$x, popup = 'You are here') %>% 
        addPolygons(data=sample_extent, color='red', fillOpacity = 0.4)
    })
  })
}

shinyApp(ui=ui, server = server)

Ortho ID - a crazy specific insect ID guide

Nocturnal Orthoptera of Central to Eastern Texas
I need to know my calls to identify them in acoustic recordings & quizzing myself will be quicker than repeatedly scrolling through databases. There are apps like this for birds (Larkwire) but not insects. But there should be! They vocalize too…

The main goal is acoustic identification - I’ve collected all possible species within my study area from this website https://orthsoc.org and compiled them into this doc https://docs.google.com/document/d/1nGSx1fzFKhtAffZEXPSRklKu429bKcj1rMMUd3CpDWY/edit?usp=sharing

Design:

Input: If I have a list of audio and images of species - (1) a button randomly generating an acoustic recording (2) input text to guess the species.

Output: Based on the guess either (1) say incorrect & show the right answer or (2) say the correct answer and show an image of the species.

Session: Be able to keep regenerating random quizzes in one website session.

Base for the app: I have a directory path for a folder “audio” that contains the mp3 files & a .csv file with the species/file names listed. The folder needs to be embedded within the app project (this should be fine already)

edited: I made a git hub folder which will make operating a lot easy for myself and others: https://github.com/joe-elias/OrthoID

library(shiny)
library(dplyr)

metadata <- read.csv("https://raw.githubusercontent.com/joe-elias/OrthoID/main/audio/audio.csv") # csv containing file name, species, and common name 

ui<-fluidPage(
  titlePanel('Ortho ID - An Acoustic Guide to Orthoptera of E. Texas'), 
  
  sidebarLayout(
    sidebarPanel(
      actionButton('new_test', 'Orthopterate!'), 
      textInput('answer', 'Answer:', value='Gryllus rubens; Southeastern field cricket'), 
      actionButton('submit', 'Submit Answer'), 
      textOutput('feedback')
    ), 
    mainPanel(
      uiOutput('audio_player')
    )
  )
)

server <- function(input, output, session) {
  quiz_data <- reactiveValues(file = NULL, species = NULL, common = NULL)
  
  # Select a random file & info:
  observeEvent(input$new_test, {
    selected <- metadata[sample(nrow(metadata), 1), ]
    quiz_data$file <- selected$filename
    quiz_data$species <- selected$species
    quiz_data$common <- selected$common
    
    # Clear previous feedback when starting a new test
    output$feedback <- renderText(NULL)
  })
  
  # Display an audio player in the app - called in main panel in the UI
  output$audio_player <- renderUI({
    req(quiz_data$file)
    tags$audio(src = paste0(
      'https://raw.githubusercontent.com/joe-elias/OrthoID/main/audio/', 
      quiz_data$file), type = 'audio/mp3', controls = NA)
  })
  
  # Check answer and provide feedback only on submit
  observeEvent(input$submit, {
    req(input$answer, quiz_data$species)
    
    # Provide feedback based on the answer
    if (tolower(input$answer) == tolower(quiz_data$species)) {
      output$feedback <- renderText(paste("Correct!", quiz_data$species, ";", quiz_data$common))
    } else {
      output$feedback <- renderText(paste("Wrong! The correct answer is:", quiz_data$species, ";", quiz_data$common))
    }
  })
}

shinyApp(ui=ui, server=server)

Future Considerations

Images that pop up after answer.
Multiple choice rather than typing in an answer - this is a little difficult to randomly select and place different choices each round.