I have written a shiny app that presents different radio buttons to the user. Depending on the input, numbers will be added to a score/counter and other radio buttons will pop up (and the previous will be disabled).
I am wondering now, how I could implement a "step back" button that would the user to go back one step (e.g., in the case of a misclick) which means:
score/counterI learned how to add a "reset" button that calls session$reload() which deletes everything and the user can start again. However, it would be much better if the user could just go back one step.
I found similar questions (Create general purpose "go back" button in shiny and https://www.collinberke.com/blog/posts/2021-09-12-shiny-implementing-a-next-and-back-button/index.html), however, these questions deal with a slightly different setting.
Example:
ui.R
ui <- fluidPage(
shinyjs::useShinyjs(),
# Add an invisible counter to store the total score
verbatimTextOutput(outputId = "counter", placeholder = TRUE),
# Add a radio button with two choices
radioButtons(inputId = "a",
# label = "a",
label = "a",
choices = c("10", "5"),
selected = ""),
# UI elements for the b and c radio buttons
uiOutput("b"),
uiOutput("c"),
uiOutput("d"),
uiOutput("c1"),
uiOutput("e"),
uiOutput("f"),
# Add a back button to allow the user to go back to the previous question
actionButton(
inputId = "reset_button",
label = "Reset",
width = "50%"
),
textOutput("reset_val")
)
server.R
server <- function(input, output, session) {
reset_rv <- reactiveVal(value = 0L)
# Initialize the counter to 0
counter <- reactiveValues(value = 0)
# Track the selected options
selected_options <- reactiveValues(
a = NULL,
b = NULL,
d = NULL,
c = NULL,
e = NULL,
f = NULL
)
# Update the counter when the a radio button is clicked
observeEvent(input$a, {
if (!is.null(input$a)) {
selected_options$a <- input$a
if (input$a == "5") {
counter$value <- counter$value + 0
output$b <- renderUI({
radioButtons(inputId = "b",
label = "b",
choices = c("a", "10"),
selected = "")
})
} else if (input$a == "10") {
counter$value <- counter$value + 8
output$c <- renderUI({
radioButtons(inputId = "c",
label = "c",
choices = c("L", "R"),
selected = "")
})
}}
shinyjs::disable("a")
})
# 2 -----------------------------------------------------------------------
observeEvent(input$b, {
if (!is.null(input$b)) {
selected_options$b <- input$b
if (input$b == "5") {
counter$value <- counter$value + 0
output$d <- renderUI({
radioButtons(inputId = "d",
label = "d",
choices = c("5", "10"),
selected = "")
})
} else if (input$b == "10") {
counter$value <- counter$value + 6
output$c1 <- renderUI({
radioButtons(inputId = "c1",
label = "c",
choices = c("L", "R"),
selected = "")})}}
shinyjs::disable("a")
shinyjs::disable("b")
})
observeEvent(input$c, {
if (!is.null(input$c)) {
selected_options$c <- input$c
if (input$c == "R") {
counter$value <- counter$value + 0
output$e <- renderUI({
radioButtons(inputId = "e",
label = "e",
choices = c("5", "10"),
selected = "")
})
} else if (input$c == "L") {
counter$value <- counter$value + 4
output$f <- renderUI({
radioButtons(inputId = "f",
label = "L",
choices = c("5", "10"),
selected = "")})}}
shinyjs::disable("a")
shinyjs::disable("c")
})
# Update the counter output
output$counter <- renderText({
paste("Score:", counter$value)
})
observeEvent(input$reset_button, {
reset_rv(input$reset_button)
session$reload()
})
}
Run
shinyApp(ui = ui, server = server)
I'd suggest (as almost always) to drop renderUI and use a updateXXX-function (updateRadioButtons) instead, as re-rendering an element is slower than updating an existing element.
Furthermore, you can take advantage of radioButtons' choiceNames/choiceValues construct to avoid lengthy if clauses.
To hide the elements I'm using conditionalPanels:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
verbatimTextOutput(outputId = "counter_text", placeholder = TRUE),
radioButtons(inputId = "a",
label = "a",
selected = "",
choiceNames = c("10", "5"),
choiceValues = c(8L, 0L)),
conditionalPanel("input.a == 0", style = "display: none;",
radioButtons(inputId = "b",
label = "b",
selected = "",
choiceNames = c("a", "10"),
choiceValues = c(0L, 6L))),
conditionalPanel("input.a == 8", style = "display: none;",
radioButtons(inputId = "c",
label = "c",
selected = "",
choiceNames = c("L", "R"),
choiceValues = c(4L, 0L))),
conditionalPanel("input.b == 6", style = "display: none;",
radioButtons(inputId = "c1",
label = "c",
selected = "",
choiceNames = c("L", "R"),
choiceValues = c(0L, 0L))),
conditionalPanel("input.b == 0", style = "display: none;",
radioButtons(inputId = "d",
label = "d",
selected = "",
choiceNames = c("5", "10"),
choiceValues = c(0L, 0L))),
conditionalPanel("input.c == 0", style = "display: none;",
radioButtons(inputId = "e",
label = "e",
selected = "",
choiceNames = c("5", "10"),
choiceValues = c(0L, 0L))),
conditionalPanel("input.c == 4", style = "display: none;",
radioButtons(inputId = "f",
label = "L",
selected = "",
choiceNames = c("5", "10"),
choiceValues = c(0L, 0L))),
actionButton(
inputId = "undo_button",
label = "Undo",
width = "25%",
icon = icon("rotate-left")
),
actionButton(
inputId = "reset_button",
label = "Reset",
width = "25%",
icon = icon("xmark")
),
textOutput("reset_val")
)
server <- function(input, output, session) {
radioButtonIds <- list("a", "b", "c", "c1", "d", "e", "f")
counter <- reactive({
# disable input after a selection was made
lapply(radioButtonIds, function(inputId){if(isTruthy(input[[inputId]])){disable(inputId)}})
# sum up all inputs (irrelevant inputs are set to 0)
sum(unlist(lapply(radioButtonIds, function(inputId){as.integer(input[[inputId]])})))
})
observeEvent(input$undo_button, {
# reset inputs in their hierarchical order the first check (has an entry been made?) is done on the lowest level
if(isTruthy(input$c1) || isTruthy(input$d) || isTruthy(input$e) || isTruthy(input$f)){
lapply(list("c1", "d", "e", "f"), function(inputId){
updateRadioButtons(session, inputId, selected = character(0))
enable(inputId)
})
} else if(isTruthy(input$b) || isTruthy(input$c)){
lapply(list("b", "c"), function(inputId){
updateRadioButtons(session, inputId, selected = character(0))
enable(inputId)
})
} else if(isTruthy(input$a)){
updateRadioButtons(session, inputId = "a", selected = character(0))
enable("a")
}
})
observeEvent(input$reset_button, {
# reset all inputs independent of the hierarchy
lapply(radioButtonIds, function(inputId){
updateRadioButtons(session, inputId, selected = character(0))
enable(inputId)
})
})
output$counter_text <- renderText({
paste("Score:", counter())
})
}
shinyApp(ui = ui, server = server)
PS: in this context you might want to check library(shinyglide).