<- fluidPage(
ui actionButton(inputId = "back", label = "Back"),
actionButton(inputId = "next", label = "Next"),
textOutput("narrative")
)# Shiny server code excluded for brevity
Implementing a next and back button in Shiny
Introduction
As part of the R4DS bookclub, our cohort has been working through Hadley Wickham’s (2020) Mastering Shiny book. Chapter 4: Case study: ER injuries had an interesting, challenging exercise I couldn’t figure out. This post aims to walk through my process of trying to solve this exercise, overviewing my thought process while trying to solve it. My hope is future me will look back at this post when I need to implement such a feature in a future Shiny application. I hope others find it useful as well.
The problem
Chapter 4 uses an example application to summarize all the concepts learned in the Getting started section of the book (i.e., basic UI, basic reactivity, etc.). To do this, Hadley, the author, walks through his development process of an application that lets a user explore the National Electronic Injury Surveillance System (NEISS), a dataset collected by the Consumer Product Safety Commission. The purpose of this data is to document accidents needing treatment reported to emergency rooms across the United States. You can see the source code for the application here.
Within this data are narrative reports (i.e. text descriptions) of each accident. An example narrative looks something like this: 69 YR OLD FEMALE SLIPPED AND FELL IN BATHROOM ON WET FLOOR INJ ANKLE WITH PAIN; ADMIT FOR A FIB
. As part of the demonstration, the chapter adds a feature to a Shiny application where the user pushes a button, the narratives are sampled, and the UI displays the one sampled narrative. This is a useful feature, which, for the purpose of the book, does a good job illustrating how eventReactives
can be applied to a Shiny application. The book then challenges the reader to go a step further by adding functionality to the app where:
- The UI provides users a
Next
andBack
button. - These buttons then can be used to cycle through and display one narrative at a time.
- Advanced: Once a user has cycled through all the narratives–either forwards or backwards–the app would start the cycle all over again.
Creating a REPREX
To simplify the application and focus in on the problem, I started with a paired down version of the application. I mainly did this so I can focus in on just the problem. I’ve found that looking at Shiny code as whole can be overwhelming and can really slow down the development process. Once I understand and have solved the problem, I will later add this functionality to the larger application.
Let’s start with the UI. Reviewing the exercise, I see that I need three UI elements:
- A
Back
button. - A
Next
button. - A placeholder to output the narrative text.
We use two functions here to set up the UI: actionButton()
and textOutput()
. Not too overly complex, and it should be pretty clear what we are attempting to do here by reviewing the functions’ names. Here’s the UI code we have so far:
My initial question: what gets passed to the server every time one of these buttons is clicked by the user? The docs (?actionButton
) is the first place I look. If you read the function’s description, you’ll notice two properties of this function: the initial value outputted by the button is zero (i.e., on run time of the app, the function passes a zero as an output), and it increments by one each time it is pressed. We can demonstrate this behavior by using some print debugging to output the value of this input to the server function to the console (check out Chapter 5 for more info on how to do this). We can also output this to the UI for now, just to observe the values via the UI of the application.
Here’s the code to do that:
library(shiny)
library(glue)
<- fluidPage(
ui actionButton(inputId = "back", label = "Back"),
actionButton(inputId = "forward", label = "Next"),
textOutput("narrative")
)
<- function(input, output, session){
server
observeEvent(input$back, {
message(glue("The user clicked the `Back` button. It's value is now {input$back}"))
})
observeEvent(input$forward, {
message(glue("The user clicked the `Next` button. It's value is now {input$forward}"))
})
$narrative <- renderText(glue("Back is {input$back}. Forward is {input$forward}"))
output
}
shinyApp(ui, server)
Knowing now that I have a numeric value being outputted by this UI function, I have the idea of applying subsetting to cycle through the values.
Here’s the server code applying this subsetting strategy:
## UI code excluded for brevity
<- function(input, output, session) {
server
$narrative <- renderText({
output<- input$forward - input$back
select_subset
$narrative[select_subset]
injuries
})
}
I kick off the application and see how my subsetting solution behaves. There’s a problem. At first, no narrative is returned to the UI. Once you click the Next
button you start to cycle through the narratives.
This issue is most likely due to passing a zero as an index for subsetting, as there isn’t technically a value with a zero index in the narrative
vector. However, if you click the forward button enough times, you start to cycle through the narratives. So, the app is partly functioning like I want it to, but it doesn’t meet the full requirements. How about the back button?
No surprise. It doesn’t work as intended. Nothing gets outputted to the UI. Again, this has to do with the index value you are passing to subset the vector. When the app starts, the subsetting index value being passed in the environment is zero. When the user clicks the Back
button, the value is now a negative number. We technically don’t have a value in the vector that has an index of negative one. Ee need to think of another solution at this point.
Another issue in regards to testing becomes evident while experimenting with this subsetting strategy. Because the narrative data could contain hundreds of rows, it will become cumbersome to test if the cycling actually works with every iteration of the app (i.e., I’m not clicking the Next
button that many times every time I modify and test my code). So, let’s simplify the data used in the application. I’ll discuss more about this in the next section.
In the back of my mind, I had a feeling some type of mathematical operation would allow me to meet these requirements. However, I didn’t have the mathematical chops to know what I needed to do. I did know that I needed to do two things at this point, though: 1) simplify my reprex
even further, so I could make testing faster and focus solely on solving the problem and 2) seek out some help.
An even simpler reprex
Let’s simplify this problem even more. Instead of using the NEISS data, I decided to simplify the data used within the app to a character vector of letters, series <- c("a", "b", "c")
. Having this simplified data structure to work with will allow me to quickly test if my app cycles through the values with every new iteration of the app. Here is the app in it’s current state:
library(shiny)
<- c("a", "b", "c")
series
<- fluidPage(
ui actionButton(inputId = "back", label = "Back"),
actionButton(inputId = "forward", label = "Next"),
textOutput("series")
)
<- function(input, output, session) {
server # There's nothing in the server function of this simplified reprex yet
}
shinyApp(ui, server)
A dead end
I Googled and Googled trying to find an answer to how I could cycle through a vector of values, but I just kept getting information on using loops in R, not on how to increment through a vector in the context of a Shiny application. At this point, I was stuck. I was at a dead end. Although I was trying to solve this problem on my own, I had to look at Maya Gans and Marly Gotti’s (2021) solutions guide to learn how to get this working. I thank the authors of the solution guide, as I was lost for weeks trying to figure out how to get this to work. I’m going to pivot at this point in the post. Specifically, I’m going to move into describing the solution provided in this guide as applied to the reprex I’m currently working with.
While reviewing the solution, I noticed I was partly correct that subsetting was going to be used and that a mathematical operation was needed. I also recognized my mental model had some gaps that needed to be filled before I could fully understand how to tackle this problem.
The initial runtime variables
As part of my testing of the actionButton()
UI function, I found out the initial value being sent to the server was zero. I also found out that zero can’t be used for subsetting (i.e, nothing is gets returned to the UI). To address this issue, a variable with a reactive value of one needed to be in the environment upon runtime of the application. This is so we can use the initial value of one to return the first element of our data to our output$series
in the textOutput()
function in the UI when the application starts. Let’s take a look at this in action.
library(shiny)
<- c("a", "b", "c")
series
<- fluidPage(
ui actionButton(inputId = "back", label = "Back"),
actionButton(inputId = "forward", label = "Next"),
textOutput("series")
)
<- function(input, output, session) {
server
# Create a reactive value of 1 in the environment
<- reactiveVal(1)
place
# Use this reactive value to subset our data
$series <- renderText({
outputplace()]
series[
})
}
shinyApp(ui, server)
You’ll notice a new function here in the server, reactiveVal()
. According to the documentation, this function is used to create a “reactive value” object within the app’s environment. Basically, I understand this function is just creating a reactive expression where the initial value is one upon the runtime of the application, which is then used in the subsetting operation applied in the renderText()
function. Great, we have partly solved the indexing issue with the use of reactiveVal(1)
. You’ll also notice the buttons don’t work here because there is no dependency on them as an input, but I’ll get to that here shortly by applying some observeEvents()
functions.
The maximum index value
I also needed a solution to help limit the range of values that could be used for indexing in our subsetting operation. I now had the lower value one available in the environment, however I did not have the maximum value. At this point, I needed a function to calculate the length of the data and to treat it as a reactive expression, as this number might be dynamic in the larger application, and the users’ inputs will determine what data gets displayed within the application (e.g., filtering by product code selection). We can easily calculate the length of our data using the length()
function and making this a reactive expression by wrapping it with the reactive()
function. Here is what this looks like with code.
library(shiny)
<- c("a", "b", "c")
series
<- fluidPage(
ui actionButton(inputId = "back", label = "Back"),
actionButton(inputId = "forward", label = "Next"),
textOutput("series")
)
<- function(input, output, session) {
server
# Determine the upper part of the subset index range
<- reactive(length(series))
max_no_values
# Create a reactive value of 1 in the environment
<- reactiveVal(1)
place
# Use this reactive value to subset our data
$series <- renderText({
outputplace()]
series[
})
}
shinyApp(ui, server)
It’s challenging to show this value in the environment in writing, but now given the current code, I have the lower value of the range, one, and the maximum value three corresponding to the number of values in our data structure available in the environment. This is great, so now I have those two values available to help with subsetting. At this point, we also need to incorporate the two user inputs, the Back
and Next
buttons. However, since we know these two buttons increment by one every time they are pressed, I need to rely on some mathematical operations to control the range of values used to subset the data. Given the simplified application, I know 1, 2, or 3 is the values and range of values I need to properly apply within a subsetting operation.
Enter the %%
Part of getting this functionality to work required the use of the modulus %%
and modular arithmetic. Basically, modulus is an arithmetic operation that performs a division and returns the remainder from the operation. I learned a lot about this in this article here (Busbee and Braunschweig n.d.). The R for Data Science book (Wickham and Grolemund 2017) also introduces the use of %%
as well. While researching the modulus, I found many useful applications for it within programming. It’s definitely worth some more time learning of its other uses. When applied in our case, though, we needed it to keep the subsetting index within the bounds of the size of our data structure.
I am far from a mathematician, so the following explanation of the logic behind how a modulus is applied here is going to be a little fast and loose. However, I’m going to take a crack at it. Take for example our application. On runtime, we have a reactive value place()
that starts at the value one. We also know that our maximum number of values that can be used as an index for our subsetting operation is three, our max_no_values
reactive (i.e., c("a", "b", "c")
). We can now use the modulus with these two values to limit the number we are using in the index of our subsetting based on the number of clicks by the user. Here is a simplified example using code illustrating this point.
<- 3
max_no_values
# User clicks the button to increment the index of the subset
# Vector corresponds to the value outputted by the `actionButton()`
<- c(0:12)
user_clicks
%% max_no_values user_clicks
[1] 0 1 2 0 1 2 0 1 2 0 1 2 0
Earlier in the post, we found out that we can’t use zero to subset, as nothing gets returned. So to solve our issue, we need to shift these values by adding one to the vector. Notice how that with every ‘click’ the range of these values never goes below one or exceeds three, even when a user’s click count (keep in mind every click of the actionButton()
increments by one) goes above three. This is the power of the %%
, as this operation keeps our index range between 1 - 3, regardless of how many times the user clicks an action button.
%% max_no_values + 1 user_clicks
[1] 1 2 3 1 2 3 1 2 3 1 2 3 1
The math is a little different for the Back
button, though. However, the same principles apply.
- 2) %% 3) + 1 ((user_clicks
[1] 2 3 1 2 3 1 2 3 1 2 3 1 2
Let’s use some print debugging here to show how the of %%
works in action. I’m going to use the glue
package to help make the messages sent to the console more human readable.
library(shiny)
library(glue)
<- c("a", "b", "c")
series
<- fluidPage(
ui actionButton(inputId = "back", label = "Back"),
actionButton(inputId = "forward", label = "Next"),
textOutput("series")
)
<- function(input, output, session) {
server
# Determine the total number
<- reactive(length(series))
max_no_values
<- reactiveVal(1)
position
# These cause a side-effect by changing the place value
observeEvent(input$forward, {
position((position() %% max_no_values()) + 1)
message(glue("The place value is now {position()}"))
})
observeEvent(input$back, {
position(((position() - 2) %% max_no_values()) + 1)
message(glue("The place value is now {position()}"))
})
$series <- renderText({
outputposition()]
series[
})
}
shinyApp(ui, server)
If you click the Back
and Next
button and watch your console, you’ll see the position
value for every click being printed. While clicking these values, you will observe a couple of things:
- You’ll notice the value zero is never passed as a subsetting index value.
- The arithmetic operations constrain our subsetting values within a range of 1 - 3, the length of our character vector.
- Multiple clicks remain in order, regardless if the user clicks the
Next
orBack
buttons (e.g., 1, 2, 3 or 3, 2, 1).
At this point, we can get rid of our print debugging code, test our working example, and bask in our accomplishment of understanding how this solution works. The next step is to now integrate what we know into the larger application. We’ll do that here in the next section of this post.
Putting it all together
Let’s put this all together and apply it to the NEISS app. For the sake of clarity and brevity, I’m not going to include the code for the whole application. However, I’m only going to include the code this solution depends on and the other functionality that has a dependency on the components applied within this solution.
If you are interested in seeing this solution applied in the larger context of the app, I suggest looking at these two resources:
- The original code from the Mastering Shiny (Wickham 2020), which can be found here.
- The solution in the Mastering Shiny Solutions (Gans and Gotti 2021), which can be found here.
Here’s the app’s code with all the required functionality. I’ll overview the code in the coming sections.
library(shiny)
library(dplyr)
# You'll need the data to run this example.
# You can find how to download the data in Chapter 5 of Mastering Shiny
if (!exists("injuries")) {
<- vroom::vroom("data/injuries.tsv.gz")
injuries <- vroom::vroom("data/products.tsv")
products <- vroom::vroom("data/population.tsv")
population
}
<- fluidPage(
ui fluidRow(
column(8, selectInput("code", "Product",
choices = setNames(products$prod_code, products$title),
width = "100%")
)
),fluidRow(
column(2, actionButton("back", "Previous story")),
column(2, actionButton("forward", "Next story")),
column(8, textOutput("narrative"))
)
)
<- function(input, output, session) {
server # Filter the data based on user's product selection
<- reactive(injuries %>% filter(prod_code == input$code))
selected
# Calculate the maximum length of the series
<- reactive(length(selected()$narrative))
max_no_stories
# Set the initial position of the subset index
<- reactiveVal(1)
place
# In cases where user changes product code, reset the place value
observeEvent(input$code, {
place(1)
})
# Observe for user button clicks, change place value accordingly
observeEvent(input$forward, {
place((place() %% max_no_stories()) + 1)
})
observeEvent(input$back, {
place(((place() - 2) %% max_no_stories()) + 1)
})
# Output the text narrative to the UI using subsetting
$narrative <- renderText({
outputselected()$narrative[place()]
})
}
shinyApp(ui, server)
Product selection
As part of the original functionality of the app, users were given a selectInput()
in the UI to filter for injuries that were the result of different products. The requirements stated the outputted narratives also needed to reflect the users’ filter selection. This functionality needed to be added back in, and it also needed to be reactive. I do this by adding the selected <- reactive(injuries %>% filter(prod_code == input$code))
near the beginning portion of the server section of the code. You’ll also notice we are using the filter()
function and %>%
operator here, so we need to also bring in the dplyr
package (i.e., library(dplyr)
).
There are now two areas in the server that have a dependency on the selected()
reactive expression, the max_no_stories()
reactive and our output$narrative
object. Since our reprex was using a simplified vector of data (e.g., c("a", "b", "c")
), we need to modify the code to use these reactives. The biggest change is we are now passing a tibble of data rather than a character vector of data. As such, I need to use selected()$narrative
to refer to the narrative vectors we want to use in our server function. Nothing else really changes, as the underlying process of determining the range of values and using a mathematical operation to limit the indexing stays the same. We are just now applying this process to a different set of data, although it is technically a reactive expression rather than an object in our environment.
Cases where users select a new product code
Given the functionality provided within our application, it’s reasonable to expect users would change the product code (i.e., the main purpose is to give users tools to explore the data). It’s also reasonable that the user would then expect the narrative values to change based on their product selection, and indeed we have built this functionality into the app. However, what we didn’t account for yet was what users expectations are for the order to which the new filter data will be presented. When users make a change to their filtering criteria, they would most likely expect that the updated narrative data would start at the beginning, not where their previous clicks would place them within their previously selected data. Given this expectation, I now need some code to ‘reset’ the subsetting index when a user changes their product code filter.
Why might this be important? Take for example if the aim of this functionality was to output the most recent injury reported for a specific product code. Our user would expect that any time they switch their product code filtering input, the displayed narrative would be the most recent reported injury, and that each subsequent click would result in a chronological walk through the narratives, either forwards or backwards. This would especially be important if the app was connected to a streaming data source that isn’t static. Moreover, you might even modify the output$narrtive
object to include the date, so the user is informed on when a specific injury was treated. For the sake of keeping things simple though, we will only add the reset behavior to the app in this post.
This reset of the indexing value was provided in the solutions guide referenced above, and it adds another observeEvent()
to make this work. Specifically, it directed me to add this code to the server section of the application:
observeEvent(input$code, {
place(1)
})
Here you can see that the observeEvent()
is waiting for any changes to the input$code
input. When a change occurs to this input, the place(1)
is run, and the subsetting index is set back to one. We now have included functionality to the app where when the user changes the product code filtering, the narrative increment index will display the first value in that subset of injuries as selected by the user.
Some concluding thoughts
I now have a working application that meets all the requirements:
- The UI provides users a
Next
andBack
button. - These buttons can be used to cycle through and display one narrative at a time: forwards and backwards.
- Advanced: Once a user has cycled through all the narratives–either forwards or backwards–the app would start the cycle all over again.
It took a fair amount of time and mental effort to figure this out and fully understand what was going on, as just this simple functionality required the application of many different concepts. Concepts that I am still trying to learn and apply in my own work. I also needed lots of help, which I am thankful for the solution guide. I truly found myself at a dead end at one point. I hope this explanation of my process and how the solution works serves someone else. If so, let me know and share it with others!
References
Reuse
Citation
@misc{berke2021,
author = {Berke, Collin K},
title = {Implementing a Next and Back Button in {Shiny}},
date = {2021-09-12},
langid = {en}
}