Skip to content

R Web Apps - Shiny

  • Code from DataCamp's course Building Web Applications With Shiny in R. DataCamp

Parts of Shiny App

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
library(shiny)

ui <- fluidPage(
    "Hello World!"
)
server <- function(input,
                    output,
                    session) {

}

shinyApp(ui = ui, server = server)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
ui <- fluidPage(
    textInput("name", "Enter a name:"),
    textOutput("q")
)
server <- function(input, output) {
    output$q <- renderText({
        paste("Do you prefer dogs or cats,",
                input$name, "?")
    })
}

Baby Names

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
ui <- fluidPage(
    titlePanel("Baby Name Explorer"),
    sidebarLayout(
        sidebarPanel(
            textInput('name', 'Enter Name', 'David'),
        ),
        mainPanel(
            plotOutput('trend')
        )
    )
)

server <- function(input, output, session){
    output$trend <- renderPlot({
        data_name <- subset(
            babynames, name == input$name
        )
    ggplot(data_name) +
        geom_line(
            aes(x = year, y = prop, color = sex)
        )
    })

}

shinyApp(ui = ui, server = server)

Inputs

Input Functions

1
2
3
selectInput("inputID", "label", choices=c("A", "B", "C"))

sliderInput("inputID", "label", value = 1925, min = 1900, max = 2000)
  • Input IDs must be unique.

Outputs

Render Functions

  • DT data table output.
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
ui <- fluidPage(
    DT::DTOutput("babynames_table")
)

server <- function(input, output){
    output$babynames_table <- DT::renderDT({
        babynames %>%
            dplyr::sample_frac(.1)
    })
}

Layouts, Themes

Tabs

  • Tabset panel addition makes tabs possible:
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
ui <- fluidPage(
    titlePanel("Histogram"),

    shinythemes::themeSelector(), # Theme selector, top-right corner
    # Set theme
    theme = shinythemes::shinytheme('superhero')  # for example

    sidebarLayout(
        sidebarPanel(sliderInput('nb_bins', '# Bins',
                                 5, 10, 5)),
        mainPanel(
            tabsetPanel(
                tabPanel('Waiting',
                        plotOutput('hist_warning')),
                tabPanel('Eruptions',
                        plotOutput('hist_eruptions'))
            )
        )
    )
)

server <- function(input, output, session){
    output$hist_waiting <- renderPlot({
        hist(faithful$waiting,
             breaks = input$nb_bins,
             col = 'steelblue')
    })
    output$hist_eruptions <- renderPlot({
        hist(faithful$eruptions,
        breaks = input$nb_b)
    })
}

Steps

  1. Add inputs (UI)
  2. Add Outputs (UI/Server)
  3. Update layout (UI)
  4. Update Outputs (Server)

Reactivity

Reactive Source || Reactive Endpoint || Reactive Conductor

Reactive Expressions lazy and cached

Custom Error Messages

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
server <- function(input, output, session) {
    output$age <- renderTable({
        validate(
            need(input$age != "", "Be sure to select an age.")
        )

    mental_health_survey %>%
        summarize(avg_age = mean(Age))
    })
}