Learning Goals

At the end of this exercise, you will be able to:
1. Run a shiny app from a stand alone script.
2. Configure a shiny app to automatically stop when closed.
3. Add a new input to the ui.
3. Use shinydashboard to improve ui aesthetics.

Load the Libraries

library(tidyverse)
library(shiny)
library(shinydashboard)
require(janitor)
library(palmerpenguins)

Load the Homerange Data

## Rows: 569 Columns: 24
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (16): taxon, common.name, class, order, family, genus, species, primarym...
## dbl  (8): mean.mass.g, log10.mass, mean.hra.m2, log10.hra, dimension, preyma...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Running A Shiny App from Script

Copy and pasting code into the console is okay for tiny example apps, but it’s not feasible for large apps, especially because advanced shiny apps can be hundreds of lines of code or more. The best way to work on apps is from a stand alone script. R Studio should automatically recognize the shiny app from the basic app building blocks/skeleton. All we have to do to run our app is click the “Run App” button at the top right of the editor window.
Run App button

Practice

  1. Open and save your finished homerange app from question 2 in part 1 as a stand alone .R script. What libraries are required for the app to run? Set the run method in the Run App drop down to “Run External”.
    Run External
## Rows: 569 Columns: 24
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (16): taxon, common.name, class, order, family, genus, species, primarym...
## dbl  (8): mean.mass.g, log10.mass, mean.hra.m2, log10.hra, dimension, preyma...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
ui <- fluidPage(titlePanel("Homerange App"),
                radioButtons("x", 
                             "Select Fill Variable", 
                             choices=c("trophic.guild", "thermoregulation"), 
                             selected="trophic.guild"),
                plotOutput("plot", width="500px", height="400px")
)

server <- function(input, output, session) {
  
  output$plot <- renderPlot({
    
    ggplot(data=homerange, 
           aes_string(x="locomotion", fill=input$x)) +
      geom_bar(position="dodge", alpha=0.8, color="black") +
      theme_light(base_size=14) +
      labs(x=NULL, y=NULL, fill="Fill Variable")
  })
  
}

shinyApp(ui, server)

Aesthetics

There are many ways to adjust shiny apps for better visual appeal. Let’s start with some more practice and then add details.

Let’s build an app using the homerange data that will produce a density plot of log10.hra with reactivity assigned to taxon.

library(shiny)

ui <- fluidPage(titlePanel("Log 10 Homerange by Taxon"),
                selectInput("x", 
                            "Select Taxon", 
                            choices = unique(homerange$taxon), #instead of typing all options, we can use unique()
                            selected="birds"),
                plotOutput("plot", width="500px", height="400px")
)

server <- function(input, output, session) {
  output$plot <- renderPlot({
    homerange %>% 
      filter(taxon==input$x) %>% #we add the reactivity as part of select
      ggplot(aes(x=log10.hra))+
      geom_density(fill="steelblue", color="black", alpha=0.6)
  })
}

shinyApp(ui, server)

Adding Numeric Input

Let’s try adding a new numeric input so the user can change the size of the points on the plot with a slider. We can do this with the sliderInput() function. The sliderInput() function takes a label that the server function will use to access the value, the label that the ui will display to the user, a minimum and maximum value, a starting value, and a step size. Edit the script to include the slider input in the ui and for the server to access the input value.

ui <- fluidPage(
    selectInput("x", 
                "Select X Variable", 
                choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"),
                selected = "bill_length_mm"),
    
    selectInput("y", 
                "Select Y Variable", 
                choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"),
                selected = "bill_depth_mm"),
    
    sliderInput("pointsize", "Select the Point Size", min = 0.5, max = 3, value = 1, step = 0.5),
    
    plotOutput("plot", width = "500px", height = "400px")
)

server <- function(input, output, session) {
  
  session$onSessionEnded(stopApp) #this makes sure that the app stops when closed
  
  output$plot <- renderPlot({
  
    ggplot(data=penguins, 
           aes_string(x = input$x, y = input$y, color="species")) + 
      geom_point(size=input$pointsize) + 
      theme_light(base_size=14)
    })
}

shinyApp(ui, server)

ui Layout with shinydashboard

We now have a functional app, but the layout doesn’t look very nice. We can change that with many different methods (and specialized libraries), but shiny dashboards are simple to use and offer a lot of functionality for making apps look professional quickly.

We won’t use fluidPage() with shinydashboard but rather dashboardPage(). A shiny dashboard contains a minimum of a header, a sidebar, and a body.

ui <- dashboardPage(
  dashboardHeader(title = "This is the Header"),
  dashboardSidebar(title = "This is the Sidebar"),
  dashboardBody() # this is where the output will go
)

server <- function(input, output) { }

shinyApp(ui, server)

Let’s add our ui and server elements to make a functional dashboard. We will put our ui elements in the dashboardBody(). Edit your app script to use the dashboard format. We won’t do anything with the sidebar in this tutorial, but see the R Studio tutorial for more information.

Let’s go back to our original app that produced a scatterplot for the penguins data.

ui <- dashboardPage(
  
  dashboardHeader(title = "Penguins"), #adds a title
  
  dashboardSidebar(disable=T), #turns off the sidebar
  
  dashboardBody(
  
    selectInput("x", 
                "Select X Variable", 
                choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                selected = "bill_length_mm"),
    
    selectInput("y", 
                "Select Y Variable", 
                choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                selected = "bill_depth_mm"),
  
  plotOutput("plot", width = "500px", height = "400px"))
)

server <- function(input, output, session) {
  
}

shinyApp(ui, server)

Now let’s add our server functions…

ui <- dashboardPage(
  
  dashboardHeader(title = "Penguins"),
  
  dashboardSidebar(disable=T),
  
  dashboardBody(
  
    selectInput("x", 
                "Select X Variable", 
                choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                selected = "bill_length_mm"),
    
    selectInput("y", 
                "Select Y Variable", 
                choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                selected = "bill_depth_mm"),
  
  plotOutput("plot", width = "500px", height = "400px"))
)

server <- function(input, output, session) {
  
  session$onSessionEnded(stopApp) #stop the app when we close it
  
  output$plot <- renderPlot({
  ggplot(data=penguins, 
         aes_string(x = input$x, y = input$y, color="species")) + 
      geom_point() + 
      theme_light()
    })
}

shinyApp(ui, server)

Boxes are a nice way to group inputs and display outputs in shinydashboard. We can display our inputs and outputs in a box with box(). Boxes need to be contained in a fluidRow(). We will use just one row. Let’s edit our app to contain boxes in the ui.

ui <- dashboardPage(
  
  dashboardHeader(title = "Penguins"),
  
  dashboardSidebar(disable=T),
  
  dashboardBody(
  
    fluidRow(
      box(
        
        selectInput("x", 
                    "Select X Variable", 
                    choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                    selected = "bill_length_mm"),
        
        selectInput("y", 
                    "Select Y Variable", 
                    choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                    selected = "bill_depth_mm"),

), # close the first box    

box(plotOutput("plot", width = "500px", height = "400px")
) # close the second box
) # close the row
) # close the dashboard body
) # close the ui

server <- function(input, output, session) {
  
  session$onSessionEnded(stopApp) # stop the app when we close it
  
  output$plot <- renderPlot({
  
    ggplot(data=penguins, 
           aes_string(x = input$x, y = input$y, color="species")) + 
      geom_point() + 
      theme_light()
    })
}

shinyApp(ui, server)

Let’s make the boxes narrower and add a title. Change your script to match the one below.

ui <- dashboardPage(
  
  dashboardHeader(title = "Penguins"),
  
  dashboardSidebar(disable=T),
  
  dashboardBody(
  
    fluidRow(
      box(title = "Plot Options", 
          width = 3, #adjust the column width
        
        selectInput("x", 
                    "Select X Variable", 
                    choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                    selected = "bill_length_mm"),
        
        selectInput("y", 
                    "Select Y Variable", 
                    choices = c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g"), 
                    selected = "bill_depth_mm"),

), # close the first box    

box(title = "Plot of Penguins Data", width = 6, #adjust the column width and add title
  plotOutput("plot", width = "500px", height = "400px")
) # close the second box
) # close the row
) # close the dashboard body
) # close the ui

server <- function(input, output, session) {
  
  session$onSessionEnded(stopApp) # stop the app when we close it
  
  output$plot <- renderPlot({
  
    ggplot(data=penguins, 
           aes_string(x = input$x, y = input$y, color="species")) + 
      geom_point() + 
      theme_light()
    })
}

shinyApp(ui, server)

Whew! We made it! We created a nice looking app with shinydashboard. And now we can easily see how even a basic shiny app can become messy and why it’s always helpful to include lots of annotations.

Practice

Let’s try to build an app that allows users to explore sex composition of wolf packs by pop. These data are from: Brandell, Ellen E (2021), Serological dataset and R code for: Patterns and processes of pathogen exposure in gray wolves across North America, Dryad, Dataset

  1. Start by loading and exploring the data.
wolves <- read_csv("data/wolves_data/wolves_dataset.csv")
## Rows: 1986 Columns: 23
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (4): pop, age.cat, sex, color
## dbl (19): year, lat, long, habitat, human, pop.density, pack.size, standard....
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
  1. For the app, here is a faceted version of what we are looking for. We want the reactive part to be pop and you should use shinydashboard.
wolves %>% 
  filter(sex!="NA") %>% 
  ggplot(aes(x=sex, fill=sex))+
  geom_bar()+
  facet_wrap(~pop)

ui <- dashboardPage(
  
  dashboardHeader(title = "Sex Composition by Wolf Population"),
  
  dashboardSidebar(disable=T),
  
  dashboardBody(
  fluidRow(
  box(width = 3,
    
    selectInput("x", "Select Population", 
                choices=unique(wolves$pop)), 
    hr(), # add a horizontal line
    
    ), # close the first box    

box(width = 7,
  plotOutput("plot", width = "600px", height = "400px")
) # close the second box
) # close the row
) # close the dashboard body
) # close the ui

server <- function(input, output, session) { 

  session$onSessionEnded(stopApp) # stop the app when we close it
  
  output$plot <- renderPlot({
      wolves %>% 
      filter(sex!="NA") %>%
      filter(pop==input$x) %>%
      ggplot(aes(x = sex, fill = sex)) +
      geom_bar()
    })
}
  
shinyApp(ui, server)
#install.packages("shinythemes")
library(shinythemes)

Wrap-up

Please review the learning goals and be sure to use the code here as a reference when completing the homework.

–>Home

Other Examples…

ui <- fluidPage(    
  
  #shinythemes::themeSelector(),  # <--- Add this somewhere in the UI
  theme = shinytheme("cerulean"),
  
  titlePanel("Log 10 Homerange by Taxon"), # give the page a title
  
  # generate a row with a sidebar
  sidebarLayout(      
    
  # define the sidebar with one input
  sidebarPanel(
  selectInput("taxon", " Select Taxon of Interest:", 
              choices=unique(homerange$taxon)), 
  hr(),
  helpText("Reference: Tamburello N, Cote IM, Dulvy NK (2015) Energy and the scaling of animal space use. The American Naturalist 186(2):196-211.")),
    
  # create a spot for the barplot
  mainPanel(
  plotOutput("taxonPlot"))
  )
  )

  # define a server for the Shiny app
  server <- function(input, output, session) {
  
  # this stops the app upon closing
  session$onSessionEnded(stopApp)
  
  # fill in the spot we created for a plot
  output$taxonPlot <- renderPlot({
    
    homerange %>% 
    filter(taxon == input$taxon) %>% 
    ggplot(aes(x=log10.hra)) + 
    geom_density(color="black", fill="steelblue", alpha=0.6)
  })
  }

shinyApp(ui, server)

Here is an example with multiple tabs…

library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Homerange Dashboard"),
  
  ## Sidebar content
  dashboardSidebar(
    sidebarMenu(
      
      menuItem("Log10 HRA", 
               tabName = "dashboard", 
               icon = icon("dashboard")),
      
      menuItem("Counts", 
               tabName = "widgets", 
               icon = icon("th"))
    )
    ),
  
  ## Body content
  dashboardBody(
    
    tabItems(
  
      ## First tab content    
      tabItem(tabName = "dashboard",
        fluidRow(
          box(plotOutput("plot1", height = 250)), # box is a container for the plot
          box(title = "Controls", # box is a container for the controls
              selectInput("taxon", 
                          "Select Taxon of Interest:", 
                          choices=unique(homerange$taxon))
          )
          )
          ),

      ## Second tab item 
      tabItem(tabName = "widgets",
        fluidRow(
          box(plotOutput("plot2", height = 250)), # box is a container for the plot
          box(title = "Controls", # box is a container for the controls
              radioButtons("x", 
               "Select Fill Variable", 
               choices=c("trophic.guild", "thermoregulation"),
               selected="trophic.guild")
          )
          )
          )
          )
          )
          )

server <- function(input, output, session) {

  output$plot1 <- renderPlot({

    homerange %>%
      filter(taxon == input$taxon) %>%
      ggplot(aes(x = log10.hra)) + 
      geom_density(color = "black", fill = "steelblue", alpha = 0.6)
  })
  
    output$plot2 <- renderPlot({
    
    homerange %>% 
      ggplot(aes_string(x="locomotion", fill=input$x))+
      geom_bar(position="dodge", alpha=0.8, color="black")+
      labs(x=NULL, y=NULL, fill="Fill Variable")
    
  })
    
}

shinyApp(ui, server)