Shiny Part 2: Server

Preamble

library(shiny)
library(ggplot2)

As we introduced in our previous lab, the main components of every Shiny app look like this:

ui <- fluidPage(
  # user interface
)

server <- function(input, output) {
  # backend logic
}

shinyApp(ui, server)

Whereas the last lab focus on the major components related to the frontend user interface, this lab will pick up where the previous left off. In particular, we are going to take a closer look at reactivity in the context of Shiny and paint a clearer illustration of how inputs relate to outputs in an interactive environment.

Lab

In this lab we will review again the concept of reactivity, managing the relationship between reactive objects and rendering functions, and introduce a number of techniques for working with server-side logic.

Reactivity again

We ended the previous lab with an illustration of the reactive() function which creates a reactive object responding to changes in user input. Here, we have created reactive objects n() and bins() responding to input$n and input$bin. We illustrate this again with an additional textOutput() that tells us the mean and standard deviation of our simulated data.

ui <- fluidPage(
  numericInput("n", label = "Number of obs:", value = 100),
  sliderInput("bins", label = "Number of bins:", min = 2, max = 20, value = 10),
  
  textOutput("summary"),
  plotOutput("myhist")
)

server <- function(input, output) {
  
  n <- reactive(input$n)
  bins <- reactive(input$bins)
  
  ## It's also worth noting that the order that we define things in server() doesn't
  # matter. Here, we have output$myhist defined before output$summary, even though
  # summary comes first in the UI. This is true for ALL objects in server()
  output$myhist <- renderPlot({
    X <- rnorm(n())
    ggplot() + geom_histogram(aes(x = X), bins = bins())
  })
  
  output$summary <- renderText({
    X <- rnorm(n())
    paste0("The mean is: ",  round(mean(X), 4), 
           " and the standard deviation is: ", round(sd(X), 4))
  })
}

shinyApp(ui, server)

A critical thing to know about the relationship created between rendered and reactive objects is that a render function will respond to any changes from any of the reactive objects specified within it’s expression (between the {}). (Take note of the phrase “within it’s expression” as we will be using it several times in this lab.)

Question 1: To illustrate this reactivity relationship, we will do an experiment. Run the Shiny app above and set the number of observations to 100 and the number of bins to 10. Make careful note of the shape of the distribution. Now, use the slider to change the number of bins to 11, wait for the plot to update, then change the slider back to 10. What do you notice? Is the distribution in the plot the same? What about the summary information? Explain why this is going on.

---

Let’s unpack the solution to Question 1. First, changing the value of input$bins updates the reactive object bins(); any rendered objects dependent on the the previous value of bins() will be invalidated and Shiny will determine that they need to be recomputed. In this case, since renderPlot() contains bin(), the entire block of code within it is rerun, causing the line X <- rnorm(n()) to be rerun, recomputing the data for our histogram. This explains why the underlying data distribution changes each time we change the number of bins.

The way this is currently set up, we have inadvertently created a dependency between the data being plotted and the number of bins in our histogram. Our intention was likely that changing the bins would only change the histogram, not the underlying data. We need to find a way to divorce the relationship between the computation of the data and the creation of the histogram. We can solve the problem by moving the computing of the data inside of the reactive function associated with input$n; now, our underlying data will only change along with changes to input$n.

Take note that this solves a second, less obvious problem as well – previously, when the data was computed within the renderText() and renderPlot() functions, the data in the plot and the data in the summary weren’t even the same! This sort of logical error is far more insidious as there is nothing directly within the app that will warn you of its existence.

ui <- fluidPage(
  numericInput(inputId = "n", label = "Number of obs:", value = 100),
  sliderInput(inputId = "bins", label = "Number of bins:", min = 2, max = 20, value = 10),
  plotOutput(outputId = "myhist")
)

server <- function(input, output) {
  
  X <- reactive(rnorm(input$n))
  bins <- reactive(input$bins)
  
  # Now it's the same X() here as in renderPlot()
  output$summary <- renderText({
    paste0("The mean is: ",  round(mean(X()), 4), 
           " and the standard deviation is: ", round(sd(X()), 4))
  })
  
  output$myhist <- renderPlot({
    ggplot() + geom_histogram(aes(x = X()), bins = bins())
  })
}

shinyApp(ui, server)

---

Question 2: The shiny code below draws two samples from a Poisson distribution, a statistical distribution with only a single parameter, lambda, and plots them against each other. Modify the shiny code so that changing the value of n will update both distributions but changing the value of \(\lambda_1\) or \(\lambda_2\) will only impact its related distribution.

# Function for plot
freqpoly <- function(x1, x2, binwidth = 0.1, xlim = c(-3, 3)) {
  df <- data.frame(
    x = c(x1, x2),
    g = c(rep("x1", length(x1)), rep("x2", length(x2)))
  )
  
  ggplot(df, aes(x, colour = g)) +
    geom_freqpoly(binwidth = binwidth, size = 1) +
    coord_cartesian(xlim = xlim)
}

# This would make a good question actually
ui <- fluidPage(
  numericInput("lambda1", label = "lambda1", value = 3),
  numericInput("lambda2", label = "lambda2", value = 5),
  numericInput("n", label = "n", value = 1e4, min = 0), 
  column(9, plotOutput("hist"))
)
server <- function(input, output) {
  output$hist <- renderPlot({
    x1 <- rpois(input$n, input$lambda1)
    x2 <- rpois(input$n, input$lambda2)
    freqpoly(x1, x2, binwidth = 1, xlim = c(0, 40))
  }, res = 96)
}

shinyApp(ui, server)

---

In this section, we spent a bit more time investigating how reactivity works in an R Shiny app. In particular, we reviewed the relationship between rendered and reactive objects, as well as some of the subtle ways in which dependencies (or a lack of dependency in the case of the plot/summary data) can modify what our application is doing without any sort of explicit warning or errors. Next, we will investigate ways in which we can exercise a little bit more control on how our server side function responds to reactive objects.

Controlling Reactivity

As we have seen several times now, a rendering function will update in response to any changes in any of the reactive objects contained within their expression. There are primarily two ways that we can go about controlling this reactivity, the first involves creating reactions in response to a particular event, the other in isolating the reactive objects within their rendering expressions.

Event Reactivity

We return to a simplified version of our basic histogram from earlier in the lab, where we have already put the data generation (X()) and the number of bins (bins()) in their own reactive containers

ui <- fluidPage(
  numericInput("n", label = "Number of obs:", value = 100),
  sliderInput("bins", label = "Number of bins:", min = 2, max = 20, value = 10),
  plotOutput("myhist")
)

server <- function(input, output) {
  X <- reactive(rnorm(input$n))
  bins <- reactive(input$bins)

  output$myhist <- renderPlot({
    ggplot() + geom_histogram(aes(x = X()), bins = bins())
  })
}

shinyApp(ui, server)

Our goal here is to create a situation in which we can directly dictate when the plot is rendered without having it automatically change in response to either of our inputs. One solution here would be to create a button that initiates the simulation. That is, we will create a reactive input that we can use to update all of our reactive objects without changing any of our existing inputs. Run the app below using the simulate button to see how this works.

ui <- fluidPage(
  numericInput("n", label = "Number of obs:", value = 100),
  sliderInput("bins", label = "Number of bins:", min = 2, max = 20, value = 10),
  
  # The action button (class = "btn-success" is just being cute and is not necessary)
  actionButton("simulate", label = "Run Simulation", class = "btn-success"),
  
  plotOutput("myhist")
)

server <- function(input, output) {
  
  X <- reactive({
    # Now simulate will cause this reactive value to update
    input$simulate
    rnorm(input$n)
    })
  bins<- reactive({
    input$simulate # It will also update the computation of bins
    input$bins
    })

  
  output$myhist <- renderPlot({
    ggplot() + geom_histogram(aes(x = X()), bins = bins())
  })
}

shinyApp(ui, server)

As you may have noticed, however, changing the number of observations or the number of bins also caused the plot to update, inadvertently creating more dependencies in our Shiny app, not fewer. The solution to this is to create a reactive object that explicitly responds to changes that we indicate. This function is eventReactive() which takes two arguments – the first is an expression containing any events that should be responded to, the second is an expression that determines the value it returns (exactly as reactive() has done until this point). It works like this:

ui <- fluidPage(
  numericInput("n", label = "Number of obs:", value = 100),
  sliderInput("bins", label = "Number of bins:", min = 2, max = 20, value = 10),
  actionButton("simulate", label = "Run Simulation", class = "btn-success"),
  plotOutput("myhist")
)

server <- function(input, output) {
  
  
  X <- eventReactive(eventExpr = input$simulate, # This causes it to update
                     valueExpr = { # This is the value it returns
                       rnorm(input$n)
                     })
  
  # We don't need to name the arguments, though
  bins <- eventReactive(input$simulate, input$bins)
  
  output$myhist <- renderPlot({
    ggplot() + geom_histogram(aes(x = X()), bins = bins())
  })
}

shinyApp(ui, server)

Notice that changes to either input$n or input$bins no longer causes the histogram or data to regenerate. By introducing a reactive object that responds to a particular event, we gained more explicit control on the operations of the app.

Isolate

In nearly opposite fashion to the use of eventReactive() there is the isolate() function which, when wrapped around a reactive object, prevents changes from triggering changes in its embedded expression. Here, the use of isolate() prevents changes in input$n from updating the histogram while still allowing it to respond to changes from input$bins:

ui <- fluidPage(
  numericInput("n", label = "Number of obs:", value = 100),
  sliderInput("bins", label = "Number of bins:", min = 2, max = 20, value = 10),
  plotOutput("myhist")
)

server <- function(input, output) {
  
  X <- reactive(rnorm(input$n))
  bins <- reactive(input$bins)
  
  output$myhist <- renderPlot({
    X <- isolate(X())
    ggplot() + geom_histogram(aes(x = X), bins = bins())
  })
}

shinyApp(ui, server)

The isolate() function is less commonly used than eventReactive(), but it’s a helpful resource to be aware of in the event that you need it.

Question 3: Using the isolate() function, rewrite the Shiny app below so that it functions the same (updates on input$simluate, not on input$n or input$bins) but without using eventReactive()

ui <- fluidPage(
  numericInput("n", label = "Number of obs:", value = 100),
  sliderInput("bins", label = "Number of bins:", min = 2, max = 20, value = 10),
  actionButton("simulate", label = "Run Simulation", class = "btn-success"),
  
  plotOutput("myhist")
)

server <- function(input, output) {
  
  X <- eventReactive(input$simulate, rnorm(input$n))
  bins <- eventReactive(input$simulate, input$bins)
  
  output$myhist <- renderPlot({
    ggplot() + geom_histogram(aes(x = X()), bins = bins())
  })
}

shinyApp(ui, server)

Additional Techniques

Using dplyr

As mentioned in the previous lab, we run into a potential conflict with the fact that most of the input objects are either characters or numerics, while up until now dplyr and ggplot2 both used names. That is, we are used to typing

mpg %>% group_by(cyl) %>% 
  filter(cty > 10) %>% 
  summarize(meanHwy = mean(hwy))

instead of what we would get using character vectors, which doesn’t work:

mpg %>% group_by("cyl") %>% 
  filter("cty" > 10) %>% 
  summarize(meanHwy = mean("hwy"))

Rather than spending any time discussing why this is, or why the solution is the way it is (you are more than welcome to come to my office to discuss, however), I am simply going to present the solution to this problem.

First, we should understand that “variables” can have two meanings when discussing data manipulation in dplyr: first, there are variables within the data frame (such as cyl, cty, displ) that, for now, we will call data variables. Second, we have variables that exist within the environment which involves nearly everything that you might create with <-. We will call these environment variables.

To get around the issue with using dplyr with strings in Shiny and to remove any potential of confusing the app, we will always designate data variables with .data. and environment variables with .env and then reference the variable name within [[]] when using .data and $ when using .env:

var1 <- "cyl"
var2 <- "cty"
var3 <- "hwy"
ten <- 10

mpg %>% group_by(.data[[var1]]) %>% 
  filter(.data[[var2]] > .env$ten) %>% 
  summarize(meanHwy = mean(.data[[var3]]))

Yes, this is cumbersome and weird, but unfortunately it is what it is. If its any consolation, the base R solution is not tremendously better:

# base R solution
mpg2 <- mpg[mpg[[var2]] > ten, ]
by(mpg2, 
   mpg2[[var1]], 
   function(x) mean(x[[var3]])) %>% array2DF()

Question 4 Complete the logic of this Shiny app so that it is dplyr compliant. Note that if an input (say, input$cutoff) has multiple values, you can access each one as you would a vector, i.e., input$cutoff[1] and input$cutoff[2].

ui <- fluidPage(
  selectInput("group", "Group by: ", c("year", "drv")),
  selectInput("filter", "Filter var: ", c("cty", "hwy")),
  sliderInput("cutoff", "Cutoff for filter:", min = 9, max = 44, value = c(10, 40)), 
  DT::DTOutput("result")
)

server <- function(input, output) {
  
  dat <- reactive({
    # filter input$filter by input$cutoff values
    # group by input$group
    # summarize to find mean hwy by group
  })
  
  output$result <- renderDT({
    # Example of how input vector value works, you can delete this
    data.frame(x = input$cutoff[1], y = input$cutoff[2])
    
    #dat() # uncomment when you are done creating dat()
  })
}

shinyApp(ui, server)

Reactive UI

In many cases, the interface that we provide to a user of our app will be dependent on various user inputs. For example, if we wish to simulate the sampling of a random variable according to a distribution’s parameters, the parameters used as input will be dependent on the distribution from which we are sampling. The process of creating a responsive UI is similar to other server-side operations we have seen thus far: there is a uiOutput() function that reserves space on the UI side and a renderUI() on the server side. We include UI input functions within renderUI() just as we would in the UI object.

ui <- fluidPage(
  selectInput("dist", "Select distribution", choices = c("normal", "poisson")),
  uiOutput("par1out"), 
  uiOutput("par2out"),
  plotOutput("plot")
)

server <- function(input, output) {
  
  output$par1out <- renderUI({
    # This will create a numericInput based on input$dist
    if (input$dist == "normal") {
      numericInput(inputId = "normalMean", label = "Mean", value = 0, min = -3, max = 3)
    } else if (input$dist == "poisson") {
      numericInput(inputId = "lambda", "Lambda", value = 1, min = 0.1, max = 5)
    }
  })
  
  output$par2out <- renderUI({
    if (input$dist == "normal") {
      numericInput(inputId = "normalSD", label = "Standard Deviation", value = 1, min = 0.1, max = 5)
    } else if (input$dist == "poisson") {
     # Returning NULL will leave the slot empty
      NULL 
    }
  })
  
  dat <- reactive({
    if (input$dist == "normal") {
      X <- rnorm(n = 1000, mean = input$normalMean, sd = input$normalSD)
    } else {
      X <- rpois(n = 1000, lambda = input$lambda)
    }
    data.frame(x = X)
  })
  
  output$plot <- renderPlot({
    ggplot(dat(), aes(x)) + geom_freqpoly(binwidth = 1)
  })
  
}

shinyApp(ui, server)

Misc

Finally, we include two relatively simple functions that exist in base R that you may find helpful on your journey towards making a really cool Shiny app. The first of these, switch(), is a generally useful function to know – it takes a single input and, depending on it’s value, returns something else:

val <- "five"

switch(val, 
       "five" = 5, # If equal to "five", return 5
       "six" = 6, 
       "seven" = 7, 
       "I DON'T KNOW")

## [1] 5

val <- "six"

switch(val, 
       "five" = 5, 
       "six" = 6, # If equal to "six" return 6
       "seven" = 7, 
       "I DON'T KNOW")

## [1] 6

val <- "nine"

switch(val, 
       "five" = 5, 
       "six" = 6, 
       "seven" = 7, 
       "I DON'T KNOW") # If a match isn't found, return the last row (default)

## [1] "I DON'T KNOW"

The other function you will be far less likely to run into in the wild but is incredibly useful with Shiny apps: this function is get(). get() takes as an argument a character vector and returns any objects in the environment with that name.

somevar <- 1991
get("somevar")

Of course, this works with variables containing strings as well:

somevar <- 1991
string <- "somevar"
get(string)

This may come in handy if your Shiny app utilizes multiple datasets.

# Create some data sets named df1 and df2
N <- 1000
X <- rnorm(N)
df1 <- data.frame(x = X, y = -X + rnorm(N, sd = 0.1))
df2 <- data.frame(x = X, y = 4*X + rnorm(N, sd = 2))

ui <- fluidPage(
  selectInput("dataset", label = "Select dataset", choices = c("Data 1", "Data 2")), 
  plotOutput("plot")
)

server <- function(input, output) {
  
  dat <- reactive({
    var <- switch(input$dataset, 
                  "Data 1" = "df1", 
                  "Data 2" = "df2", 
                  NULL)
    get(var)
  })
  
  output$plot <- renderPlot({
    ggplot(dat(), aes(x, y)) + geom_point()
  })
  
}

shinyApp(ui, server)