1 Input and output controls

In this task, the following app is to be adapted. First, run the app in an R console and take a close look at it. Then work on the following tasks one after the other.

library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  sliderInput(inputId = "n", 
              label   = "Number of samples", 
              min = 1, max = 100, value = 10),
  plotOutput(outputId = "hist")
) 

# Server function connecting input and output
server <- function(input, output){
  output$hist <- renderPlot({
    x <- rnorm(input$n) # draw n random values
    hist(x, main = "Histogram")
  })
}

shinyApp(ui = ui, server = server)
  1. Add the heading “Histogram of random values” to the app using titlePanel() inside the fluidPage()function.
library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  #######################################################
  titlePanel("Histogram of random values"),
  # Alternatively, an HTML tag can be used. 
  # Note: in this case, however, no title tag is set in the header 
  # (i.e. the title is not displayed in the browser tab).  
  # titlePanel() does this automatically.
  # tags$h2("Histogram of random values"),
  #######################################################
  sliderInput(inputId = "n", 
              label   = "Number of samples", 
              min = 1, max = 100, value = 10),
  plotOutput(outputId = "hist")
) 

# Server function connecting input and output
server <- function(input, output){
  output$hist <- renderPlot({
    x <- rnorm(input$n) # draw n random values
    hist(x, main = "Histogram")
  })
}

shinyApp(ui = ui, server = server)
  1. Adjust the app so that the slider "n" can only move between 50 and 1000 in increments of 50. See ?sliderInput for help.
library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  titlePanel("Histogram of random values"),
  #######################################################
  sliderInput(inputId = "n", 
              label   = "Number of samples", 
              min = 50, max = 1000, value = 50, step = 50),
  #######################################################
  plotOutput(outputId = "hist")
) 

# Server function connecting input and output
server <- function(input, output){
  output$hist <- renderPlot({
    x <- rnorm(input$n) # draw n random values
    hist(x, main = "Histogram")
  })
}

shinyApp(ui = ui, server = server)
  1. Add another input (selectInput() or radioButtons()) and let the user choose among drawing samples from three distributions: normal, uniform (runif()), or exponential (rexp()). Use switch() to adjust the logic in the server function. See ?switch for help.
library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  titlePanel("Histogram of random values"),
  sliderInput(inputId = "n", 
              label   = "Number of samples", 
              min = 50, max = 1000, value = 50, step = 50),
  #######################################################
  #selectInput(inputId = "distribution", 
  #            label = "Distribution", 
  #            choices = c("normal", "uniform", "exponential")),
  radioButtons(inputId = "distribution", 
              label = "Distribution", 
              choices = c("normal", "uniform", "exponential")),
  #######################################################
  plotOutput(outputId = "hist")
) 

# Server function connecting input and output
server <- function(input, output){
  output$hist <- renderPlot({
    #######################################################
    x <- switch(input$distribution,
                normal = rnorm(input$n),
                uniform = runif(input$n),
                exponential = rexp(input$n)
                ) 
    # draw n random values from the chosen distribution
    #######################################################
    hist(x, main = "Histogram")
  })
}

shinyApp(ui = ui, server = server)
  1. Add a checkboxInput() to the UI. When the box is ticked, the distribution from which random values are drawn should be drawn into the histogram using curve().

The y-axis of the histogram must represent the density (argument freq = FALSE). To draw the curve into the histogram, the argument add = TRUE must be set for curve().

library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  titlePanel("Histogram of random values"),
  sliderInput(inputId = "n", 
              label   = "Number of samples", 
              min = 50, max = 1000, value = 50, step = 50),
  radioButtons(inputId = "distribution", 
              label = "Distribution", 
              choices = c("normal", "uniform", "exponential")),
  #######################################################
  # Add  checkbox UI
  checkboxInput("show_distribution", "Show distribution in histogram"),
  #######################################################
  plotOutput(outputId = "hist")
) 

# Server function connecting input and output
server <- function(input, output){
  output$hist <- renderPlot({
    x <- switch(input$distribution,
                normal = rnorm(input$n),
                uniform = runif(input$n),
                exponential = rexp(input$n)
    ) 
    
    #######################################################
    # freq = FALSE -> plot density on y-axis
    hist(x, main = "Histogram", freq  = FALSE)
    
    #######################################################
    # Add  server logic: if input$show_distribution is TRUE
    # the selected distribution (input$distribution) is added to the hist()
    if(input$show_distribution){
      switch(input$distribution,
        normal = curve(dnorm, from = -6, to = 6, 
                       add = TRUE, col = "red", lty = 2),
        uniform = curve(dunif, from = 0, to = 1, 
                          add = TRUE, col = "red", lty = 2),
        exponential = curve(dexp, from = 0, to = 10, 
                              add = TRUE, col = "red", lty = 2))
    }
    #######################################################
    
  })
}

shinyApp(ui = ui, server = server)
  1. Depending on how you solved the task before, an undesirable behaviour may have occurred: Each time the checkboxInput() is clicked, new values are drawn.
    Try to find a solution so that this does not happen, i.e. when the box is clicked, the distribution is added to or removed from the histogram without drawing new random values.

Move the part where the values are drawn into a reactive expression using reactive({}).

library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  titlePanel("Histogram of random values"),
  sliderInput(inputId = "n", 
              label   = "Number of samples", 
              min = 50, max = 1000, value = 50, step = 50),
  radioButtons(inputId = "distribution", 
              label = "Distribution", 
              choices = c("normal", "uniform", "exponential")),
  checkboxInput("show_distribution", "Show distribution in histogram"),
  plotOutput(outputId = "hist")
) 

# Server function connecting input and output
server <- function(input, output){
  
  #######################################################
  # Move drawing proces into reactive expression
  get_data <- reactive({
    switch(input$distribution,
           normal = rnorm(input$n),
           uniform = runif(input$n),
           exponential = rexp(input$n)
    ) 
    
  })
  #######################################################
  
  output$hist <- renderPlot({
    
    #######################################################
    # refer back to reactive expression get_data()
    # add xlab (not necessary, but nicer)
    hist(get_data(), main = "Histogram", freq  = FALSE, xlab = "x")
    #######################################################
    
    if(input$show_distribution){
      switch(input$distribution,
             normal = curve(dnorm, from = -6, to = 6, 
                            add = TRUE, col = "red", lty = 2),
             uniform = curve(dunif, from = 0, to = 1, 
                             add = TRUE, col = "red", lty = 2),
             exponential = curve(dexp, from = 0, to = 10, 
                                 add = TRUE, col = "red", lty = 2))
    }
    
    
  })
}

shinyApp(ui = ui, server = server)
  1. Add a layout: Try both, (1) an automatic layout using sidebarLayout(), sidebarPanel(), and mainPanel(); (2) a custom layout using fluidRow() and column().
library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  titlePanel("Histogram of random values"),
  #######################################################
  # Add  sidebarLayout
  sidebarLayout(
    sidebarPanel(
      sliderInput(inputId = "n", 
                  label   = "Number of samples", 
                  min = 50, max = 1000, value = 50, step = 50),
      radioButtons(inputId = "distribution", 
                   label = "Distribution", 
                   choices = c("normal", "uniform", "exponential")),
      checkboxInput("show_distribution", "Show distribution in histogram")
    ),
    mainPanel(
      plotOutput(outputId = "hist")
    )
  )
  #######################################################
) 

# Server function connecting input and output
server <- function(input, output){
  
  get_data <- reactive({
    switch(input$distribution,
           normal = rnorm(input$n),
           uniform = runif(input$n),
           exponential = rexp(input$n)
    ) 
    
  })

  output$hist <- renderPlot({

    hist(get_data(), main = "Histogram", freq  = FALSE, xlab = "x")

    if(input$show_distribution){
      switch(input$distribution,
             normal = curve(dnorm, from = -6, to = 6, 
                            add = TRUE, col = "red", lty = 2),
             uniform = curve(dunif, from = 0, to = 1, 
                             add = TRUE, col = "red", lty = 2),
             exponential = curve(dexp, from = 0, to = 10, 
                                 add = TRUE, col = "red", lty = 2))
    }
    
    
  })
}

shinyApp(ui = ui, server = server)
library(shiny)
# User interface with slider (input) and plot (output)
ui <- fluidPage(
  titlePanel("Histogram of random values"),
  #######################################################
  # Add  custom layout using fluidRow(), column() and
  # wellPanel() to separate sections
  wellPanel(
  fluidRow(
    column(6,
      sliderInput(inputId = "n", 
                  label   = "Number of samples", 
                  min = 50, max = 1000, value = 50, step = 50)
      ),
    column(2,
      radioButtons(inputId = "distribution", 
                   label = "Distribution", 
                   choices = c("normal", "uniform", "exponential"))
      ),
    column(3,
      checkboxInput("show_distribution", "Show distribution in histogram")
    ))),
    fluidRow(
      plotOutput(outputId = "hist")
    )
  #######################################################
) 

# Server function connecting input and output
server <- function(input, output){
  
  get_data <- reactive({
    switch(input$distribution,
           normal = rnorm(input$n),
           uniform = runif(input$n),
           exponential = rexp(input$n)
    ) 
    
  })

  output$hist <- renderPlot({

    hist(get_data(), main = "Histogram", freq  = FALSE, xlab = "x")

    if(input$show_distribution){
      switch(input$distribution,
             normal = curve(dnorm, from = -6, to = 6, 
                            add = TRUE, col = "red", lty = 2),
             uniform = curve(dunif, from = 0, to = 1, 
                             add = TRUE, col = "red", lty = 2),
             exponential = curve(dexp, from = 0, to = 10, 
                                 add = TRUE, col = "red", lty = 2))
    }
    
    
  })
}

shinyApp(ui = ui, server = server)

  1. Draw the reactive graph by hand and compare it to the one created using the reactlog package (execute options(shiny.reactlog = TRUE) before you start the shiny app to enable reactlog and press Ctrl + F3 or Command + F3 to display the generated reactive graph).

    Note: There are some additional “internal” nodes (clientData$...) in the graph created by reactlog. They are responsible for rendering the plot correctly. You can simply ignore them if you compare the graphs.

library(shiny)

options(shiny.reactlog = TRUE) # enable reactlog

# User interface with slider (input) and plot (output)
ui <- fluidPage(
  titlePanel("Histogram of random values"),
  #######################################################
  # Add  sidebarLayout
  sidebarLayout(
    sidebarPanel(
      sliderInput(inputId = "n", 
                  label   = "Number of samples", 
                  min = 50, max = 1000, value = 50, step = 50),
      radioButtons(inputId = "distribution", 
                   label = "Distribution", 
                   choices = c("normal", "uniform", "exponential")),
      checkboxInput("show_distribution", "Show distribution in histogram")
    ),
    mainPanel(
      plotOutput(outputId = "hist")
    )
  )
  #######################################################
) 

# Server function connecting input and output
server <- function(input, output){
  
  get_data <- reactive({
    switch(input$distribution,
           normal = rnorm(input$n),
           uniform = runif(input$n),
           exponential = rexp(input$n)
    ) 
    
  })

  output$hist <- renderPlot({

    hist(get_data(), main = "Histogram", freq  = FALSE, xlab = "x")

    if(input$show_distribution){
      switch(input$distribution,
             normal = curve(dnorm, from = -6, to = 6, 
                            add = TRUE, col = "red", lty = 2),
             uniform = curve(dunif, from = 0, to = 1, 
                             add = TRUE, col = "red", lty = 2),
             exponential = curve(dexp, from = 0, to = 10, 
                                 add = TRUE, col = "red", lty = 2))
    }
    
    
  })
}

shinyApp(ui = ui, server = server)
# Press Ctrl + 3 (or Command + F3) to open the reactlog graph

2 Analysis of the PlantGrowth dataset

Create a Shiny app that displays a boxplot for the PlantGrowth data in R.

  1. Let the user select the groups to display.

    Depending on the selected groups, the histogram could look like this: (You can adapt the code below for your app)

    par(mfrow = c(1, 3))
## if all groups are selected:
boxplot(weight ~ group, PlantGrowth)

## if only group ctrl and trt2 are selected
data <-  droplevels(PlantGrowth[PlantGrowth$group %in% c("ctrl", "trt2"), ])
boxplot(weight ~ group, data, axes = FALSE)
axis(2)
axis(1, at = 1:nlevels(data$group), labels = levels(data$group))
box()

## if only group trt1 is selected
data <-  droplevels(PlantGrowth[PlantGrowth$group %in% c("trt1"), ])
boxplot(weight ~ group, data, axes = FALSE)
axis(2)
axis(1, at = 1:nlevels(data$group), labels = levels(data$group))
box()

Use checkboxGroupInput() or selectInput() to select the groups.

  1. Use validate(need(...)) to display a message if no group is selected. Otherwise, an error message could appear.

Check whether the input variable in which the selected groups are stored contains elements (e.g. using length(input$...) > 0)

  1. Add an output that shows the results of a one-sample t test, a two-sample t test (t.test()), or a one-way ANOVA (oneway.test()), depending on whether one, two, or three groups are selected.

    # if only group ctrl and trt2 are selected
data <-  droplevels(PlantGrowth[PlantGrowth$group %in% c("ctrl", "trt2"), ])
t.test(weight ~ group, data) # two-sample t test

# if only group trt1 is selected
data <-  droplevels(PlantGrowth[PlantGrowth$group %in% c("trt1"), ])
t.test(data$weight, mu = 0) # one-sample t test

# all three groups
data <-  droplevels(PlantGrowth[PlantGrowth$group %in% c("ctrl", "trt1", "trt2"), ])
oneway.test(weight ~ group, data) # one-way ANOVA
  1. Add an input that lets the user select whether to treat the variances in the groups as being equal. Accordingly, display the correct test.

Use the var.equal argument.

library(shiny)

ui <- fluidPage(
  titlePanel("PlantGrowth"),
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput(inputId =  "groups",
                         label =  "Select group(s)",
                         choices = c("control" =  "ctrl",
                                     "treatment 1" =  "trt1",
                                     "treatment 2" = "trt2")
      ),
      checkboxInput("checkb_vareq", "Treat variances as being equal?")
    ),
    mainPanel(
      plotOutput("box_plot"),
      verbatimTextOutput("result_test")
    )
  )
)

server <- function(input, output){

data <- reactive({
  validate(need(length(input$groups) > 0, "Please select at least one group."))
  droplevels(PlantGrowth[PlantGrowth$group %in% input$groups, ])
})

output$box_plot <- renderPlot({
  boxplot(weight ~ group, data(), axes = FALSE)
  axis(2)
  axis(1, at = 1:nlevels(data()$group), labels = levels(data()$group))
  box()
})

output$result_test <- renderPrint({
  req(input$groups)
  
  if(length(input$groups) == 1){
    t.test(data()$weight, mu = 0)
    
  }else if(length(input$groups) == 2){
    t.test(weight ~ group, data(), var.equal = input$checkb_vareq)
    
  }else if(length(input$groups) == 3){
    oneway.test(weight ~ group, data(), var.equal = input$checkb_vareq)
  }
})
}

shinyApp(ui = ui, server = server)
  1. Bonus exercise: Hide the input that lets the user select whether to treat the variances in the groups as being equal if only one group (or no group) is selected.

Use conditionalPanel() (reminder: the condition has to be a JavaScript expression, see ?conditionalPanel for some examples. In order to access the reactive input value in JS and calculate its length use input['inputId'].length) or uiOutput() paired with renderUI().

library(shiny)

ui <- fluidPage(
  titlePanel("PlantGrowth"),
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput(inputId =  "groups",
                         label =  "Select group(s)",
                         choices = c("control" =  "ctrl",
                                     "treatment 1" =  "trt1",
                                     "treatment 2" = "trt2")
      ),
      conditionalPanel("input['groups'].length > 1",      
        checkboxInput("checkb_vareq", "Treat variances as being equal?")
      )
    ),
    mainPanel(
      plotOutput("box_plot"),
      verbatimTextOutput("result_test")
    )
  )
)

server <- function(input, output){

data <- reactive({
  validate(need(length(input$groups) > 0, "Please select at least one group."))
  droplevels(PlantGrowth[PlantGrowth$group %in% input$groups, ])
})

output$box_plot <- renderPlot({
  boxplot(weight ~ group, data(), axes = FALSE)
  axis(2)
  axis(1, at = 1:nlevels(data()$group), labels = levels(data()$group))
  box()
})

output$result_test <- renderPrint({
  req(input$groups)
  
  if(length(input$groups) == 1){
    t.test(data()$weight, mu = 0)
    
  }else if(length(input$groups) == 2){
    t.test(weight ~ group, data(), var.equal = input$checkb_vareq)
    
  }else if(length(input$groups) == 3){
    oneway.test(weight ~ group, data(), var.equal = input$checkb_vareq)
  }
})
}

shinyApp(ui = ui, server = server)

3 Bootstrap from cars dataset

  1. Create a Shiny app with the user interface consisting of an actionButton() input and two outputs: plotOutput() and verbatimTextOutput(). On each button click

    • a new 50-observations bootstrap sample is drawn with replacement from the cars data,
    • the scatter plot is displayed,
    • descriptive statistics (summary()) are shown.

In the server function, use getsamples <- eventReactive({...}) to be able to access the same data set both within renderPlot() and renderPrint()

library(shiny)

ui <- fluidPage(
  titlePanel("Bootstrap sampling"),
  sidebarLayout(
    sidebarPanel(
        actionButton("new_sample", "New sample"),
        tags$hr(),
        verbatimTextOutput("stats")
    ),
    mainPanel(
      plotOutput("scatterplot")

    )
  )
)

server <- function(input, output){

getsamples <- eventReactive(input$new_sample, {
  cars[sample(1:50, 50, replace = TRUE), ]
})

output$scatterplot <- renderPlot({
   plot(dist ~ speed, getsamples())
})

output$stats <- renderPrint({
  summary(getsamples())
})

}
shinyApp(ui = ui, server = server)

  1. Expand the previous Shiny app.

    • Add a check box to allow the user to show a regression line.
    • Add a second button ‘Reset’ that restores the sample to the original cars data.

To get two buttons to work in the server function, combine reactiveValues() and observe()/observeEvent(). More here: https://shiny.rstudio.com/articles/action-buttons.html.

library(shiny)

ui <- fluidPage(
  titlePanel("Bootstrap sampling"),
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(6, 
          actionButton("new_sample", "New sample")
        ),
        column(6, 
          actionButton("reset", "Reset")
        )
        ),
      checkboxInput("show_regr", "Show regression line"),
      tags$hr(),
        verbatimTextOutput("stats")
    ),
    mainPanel(
      plotOutput("scatterplot")

    )
  )
)

server <- function(input, output){

getsamples <- reactiveValues(data = cars)

observeEvent(input$new_sample,{
  getsamples$data <- cars[sample(1:50, 50, replace = TRUE), ]
})
  
observeEvent(input$reset,{
  getsamples$data <- cars
})

output$scatterplot <- renderPlot({
   plot(dist ~ speed, getsamples$data, xlim =  c(0, 26), ylim = c(0, 125))
  if(input$show_regr){
    abline(lm(dist ~ speed, getsamples$data))
  }
})

output$stats <- renderPrint({
  summary(getsamples$data)
})

}
shinyApp(ui = ui, server = server)
  1. Take a look at the reactive graph created by the reactlog package. Find the nodes for observe() or observeEvent() and reactiveValues() and play a little bit with this graph using the ‘Next Step / Previous Step’ button at the top. Try to understand what happens if you click ‘Reset’ in the app and how this process is represented in the graph.

4 Linear regression

Develop a Shiny App with the following content:

  • Simulate data from the following model \[ y_i = \beta_0 + \beta_1 \cdot x_i + e_i\] with \(e_i \sim N(\mu = 0, \sigma = \sigma)\), \(i = 1, ..., n\) and \(x_i \sim \mathcal{U}(0, 100)\). The parameters \(\beta_0\) and \(\beta_1\) as well as \(\sigma\) and the sample size \(n\) should be freely adjustable by the user (within a certain range).

  • Display the simulated data in a scatterplot.

  • Add the true regression line to the plot if a checkbox has been ticked.

  • Estimate a linear model based on the simulated data and plot the estimated regression line in the scatterplot as well. (but only if another checkbox has been ticked)

  • Give the inputs meaningful labels so that the user can understand what he can change with the inputs.

  • Add descriptions that help the user understand the app. In this context, you should also include the mathematical expression of the model in the app and briefly explain the parameters.

  • If you are still looking for a challenge, then let the user decide whether a quadratic or even cubic term should be included in the model. E.g.: \[ y_i = \beta_0 + \beta_1 \cdot x_i + \beta_2 \cdot x_i^2 + e_i\]

Feel free to show me the finished app and ask me for feedback :)