action-feedback.Rmd

# User feedback {#action-feedback}

```{r, include = FALSE}
source("common.R")
source("demo.R")
```

You can often make your app more usable by giving the user more insight in to what is happening. This might take the form of better messages when inputs are invalid, or progress updates for operations that take a long time. Some feedback occurs naturally through outputs, which you already know how to use, but you'll often need something else. The goal of this chapter is to show you what your other options are.

We'll start with techniques for __validation__, informing the user when an input (or combination of inputs) is in an invalid state. We'll then continue on to __notification__, sending general messages to the user, and __progress bars__, which give the details for time consuming operations made up of many small steps. We'll finish up by discussing dangerous actions, and how you give your users peace of mind with __confirmation__ dialogs or the ability to __undo__ an action.

In this chapter, as well as shiny, we'll also use [shinyFeedback](https://github.com/merlinoa/shinyFeedback) by Andy Merlino, and [waiter](http://waiter.john-coene.com/), by John Coene.

```{r setup}
library(shiny)
```

We currently require the development versions of those packages:

```{r, eval = FALSE}
remotes::install_github("JohnCoene/waiter")
remotes::install_github("merlinoa/shinyFeedback")
```

## Validation {#validate}

The first and most important feedback you can give to the user is that they've given you bad input. This analogous to writing good functions in R: user-friendly functions give clear error message describing what the expected input is and how you have violated those expectations. Thinking through how the user might missuse your app allows you to provivde informative messages in the UI, rather than allowing errors to trickle through into the R code and generate uninformative errors.

### Validating input

If you want to give additional feedback to the user, a great way to do so is with the [shinyFeedback](https://github.com/merlinoa/shinyFeedback) package. There are two steps to use it. First, you add `useShinyFeedback()` to the ui:

```{r}
ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  numericInput("n", "n", value = 10),
  textOutput("half")
)
```

Then call one of the feedback functions in your server function. There are four variants: `feedback()`, `feedbackWarning()`, `feedbackDanger()`, and `feedbackSuccess()`. They all have three key arguments:

* `inputId`, the id of the input where the feedback should be placed.
* `show`, a logical determining whether or not to show the feedback.
* `text`, the text to display.

We could use that function to display a warning message for odd numbers:

```{r}
server <- function(input, output, session) {
  observeEvent(input$n,
    shinyFeedback::feedbackWarning(
      "n", 
      input$n %% 2 != 0,
      "Please select an even number"
    )  
  )
  output$half <- renderText(input$n / 2)
}
```

These feedback functions also have `color` and `icon` arguments that you can use to further customise the appearance. See the documentation for more details.

Notice, however, that while the error message is displayed, the output is still updated. Typically you don't want that because invalid inputs are likely to cause uninformative R errors which you don't want to show to the user. To fix that problem, you need a new tool: `req()`, shorted for "required". It looks like this:

```{r}
server <- function(input, output, session) {
  half <- reactive({
    even <- input$n %% 2 == 0
    shinyFeedback::feedbackWarning("n", !even, "Please select an even number")
    req(even)
    input$n / 2    
  })
  
  output$half <- renderText(half())
}
```

When the input to `req()` is not true[^truthy], it sends a special signal to tell Shiny that the reactive does not have all the inputs that it requires, so it is "paused". That means any reactive consumers that follow it in the reactive graph will not be updated. We'll take a brief digression to talk about `req()` before we come back to using it in concert with validate.

[^truthy]: More precisely, `req()` proceeds only if its inputs are __truthy__, i.e. any value apart from `FALSE`, `NULL` , `""`, or a handful of other special cases described in `?isTruthy`.

### Pausing execution with `req()`

It's easiest to understand `req()` by starting outside of validation. You may have noticed that when you start an app, the complete reactive graph is computed even before the user does anything. This usually works well, because you have carefully chosen meaningful default `value`s for your inputs. Sometimes, however, you want to wait until the user actually does something.

This need tends to crop up mainly with three controls:

* In `textInput()`, you've used `value = ""`, and you don't want to do 
  anything until the user types something.
  
* In `selectInput()`, you've provide an empty choice, `""`, and you don't
  want to do anything until the user makes a selection.
  
* In `fileInput()`, which has an empty result before the user has uploaded 
  anything. We'll come back to this in Section \@ref(#upload).

We need some way to "pause" reactives so that nothing happens until some condition is true. That's the job of `req()` which checks for required values before allowing a reactive producer to continue.

For example, consider the following app which will generate a greeting in English or Maori. If you run this app, you'll see an error, as in Figure \@ref(fig:require-simple), because there's no entry in the `greetings` vector that corresponds to the default choice of `""`.

```{r}
ui <- fluidPage(
  selectInput("language", "Language", choices = c("", "English", "Maori")),
  textInput("name", "Name"),
  textOutput("greeting")
)

server <- function(input, output, session) {
  greetings <- c(
    English = "Hello", 
    Maori = "Ki ora"
  )
  output$greeting <- renderText({
    paste0(greetings[[input$language]], " ", input$name, "!")
  })
}
```

```{r require-simple, echo = FALSE, message = FALSE, cache = FALSE, fig.cap = "The app displays an uninformation error when it is loaded because language hasn't been selected yet", out.width = "50%", fig.show = "hold"}
demo <- demo_inline("require-simple", ui, server)
demo$resize(400)
demo$screenshot()
```

We can fix this problem by using `req()`, as below. Now nothing will be displayed until the user has suppled values for both language and name, as shown in Figure \@ref(fig:require-simple2).

```{r}
server <- function(input, output, session) {
  greetings <- c(
    English = "Hello", 
    Maori = "Ki ora"
  )
  output$greeting <- renderText({
    req(input$language, input$name)
    paste0(greetings[[input$language]], " ", input$name, "!")
  })
}
```

```{r require-simple2, fig.cap = "By using `req()`, the output is only shown once both language and name have been supplied", out.width = "33%", fig.show = "hold", fig.align = "default", echo = FALSE, message = FALSE, cache = FALSE}
demo <- demo_inline("require-simple2", ui, server)
demo$resize(400)
s1 <- demo$screenshot("on-load")
demo$set_values(language = "English")
s2 <- demo$screenshot("langauge")
demo$set_values(name = "Hadley")
s3 <- demo$screenshot("name")
knitr::include_graphics(c(s1, s2, s3))
```

`req()` works by signalling a special __condition__[^condition]. This special condition causes all downstream reactives and outputs to stop executing. Technically, it leaves any downstream reactive consumers in an invalidated state. We'll come back to this terminology in Chapter \@ref{reactive-components}.

[^condition]: Condition refers jointly to errors, warnings, and messages. If you're interested, you can learn more of the details of R's condition system in <https://adv-r.hadley.nz/conditions.html>.

`req()` is designed so that `req(input$x)` will only proceed if the user has supplied a value, regardless of the type of the input control. You can also use `req()` with your own logical statement if needed. For example, `req(input$a > 0)` will permit computation to proceed when `a` is greater than 0; this is typically the form you'll use when performing validation, as we'll see next.

### `req()` and validation

Let's combine `req()` and shinyFeedback to solve a more challenging problem. I'm going to return to the simple app we made in Chapter \@ref(basic-app) which allowed you to select a built-in dataset and see its contents. I'm going to make it more general and more complex by using `textInput()` instead of `selectInput()`. The UI changes very little:

```{r}
ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  textInput("dataset", "Dataset name"), 
  tableOutput("data")
)
```

But the server function needs to get a little more complex. We're going to use `req()` in two ways: 

* We only want to proceed with computation if the user has entered a
  value so we do `req(input$dataset)`.
  
* Then we check to see if the supplied name actually exists. If it doesn't,
  we display an error message, and then use `req()` to pause computation.
  Note the use of `cancelOutput = TRUE`: normally "pausing" a reactive will
  reset all downstream outputs; using `cancelOutput = TRUE` leaves them
  displaying the last good value. This is import for `inputText()` which 
  may trigger an update while you're in the middle of typing a name.

```{r}
server <- function(input, output, session) {
  data <- reactive({
    req(input$dataset)
    
    exists <- exists(input$dataset, "package:datasets")
    shinyFeedback::feedbackDanger("dataset", !exists, "Unknown dataset")
    req(exists, cancelOutput = TRUE)

    get(input$dataset, "package:datasets")
  })
  
  output$data <- renderTable({
    head(data())
  })
}
```

### Validate output

shinyFeedback is great when the problem is related to a single input. But sometimes the invalid state is a result of a combination of inputs. In this case it doesn't really make sense to put the error next to an input (which one would you put it beside?) and instead it makes more sense to put it in the output. 

You can do so with a tool built into shiny: `validate()`. When called inside a reactive or an output, `validate(message)` stops execution of the rest of the code and instead displays `message` in any downstream outputs. The following code shows a simple example where we don't want to log or square-root negative values.

```{r}
ui <- fluidPage(
  numericInput("x", "x", value = 0),
  selectInput("trans", "transformation", choices = c("square", "log", "square-root")),
  textOutput("out")
)

server <- function(input, output, server) {
  output$out <- renderText({
    if (input$x < 0 && input$trans %in% c("log", "square-root")) {
      validate("x can not be negative for this transformation")
    }
    
    switch(input$trans,
      square = input$x ^ 2,
      "square-root" = sqrt(input$x),
      log = log(input$x)
    )
  })
}
```

## Notifications

If there isn't a problem and just want to let the user know what's happening, then you want a __notification__. In Shiny, notifications are created with `showNotification()`, and stack in the bottom right of the page. There are three basic ways to use `showNotification()`:

* To show a transient notification, that automatically disappears after a fixed
  amount of time.
  
* To show a notification when a process starts, and remove it when the process 
  ends.

* To update a single notification with progressive updates.

These three techniques are discussed in turn below.

### Transient notification

The simplest way to use `showNotification()` is to call it with a single argument: the message that you want to display.

```{r}
ui <- fluidPage(
  actionButton("goodnight", "Good night")
)
server <- function(input, output, session) {
  observeEvent(input$goodnight, {
    showNotification("So long")
    Sys.sleep(1)
    showNotification("Farewell")
    Sys.sleep(1)
    showNotification("Auf Wiedersehen")
    Sys.sleep(1)
    showNotification("Adieu")
  })
}
```

By default, the message will disappear after 5 seconds, which you can override by setting `duration`, or the user can dismiss it earlier by clicking the close button. If you want to make the notification more prominent, you can set the `type` argument to one of "message", "warning", or "error".

```{r}
server <- function(input, output, session) {
  observeEvent(input$goodnight, {
    showNotification("So long")
    Sys.sleep(1)
    showNotification("Farewell", type = "message")
    Sys.sleep(1)
    showNotification("Auf Wiedersehen", type = "warning")
    Sys.sleep(1)
    showNotification("Adieu", type = "error")
  })
}
```

### Removing on completion

Transient actions disappear after a fixed amount of time, but it's often useful to tie the presence of a notification to a long-running task. In this case, you want to show the notification when the task starts, and remove the notification when the task completes. To do this, you'll need to:

* Set `duration = NULL` and `closeButton = FALSE` so that the notification 
  stays visible until the task is complete.
  
* Store `id` returned by `showNotification()`, and then pass this value to 
  `removeNotification()` to remove it when done. The most reliable way to 
  do so is to use `on.exit()`, which ensures that the notification is removed 
  regardless of how the task completes (either successfully or with an error).
  You can learn more about `on.exit()` at
  <https://adv-r.hadley.nz/functions.html#on-exit>.

The following example puts the pieces together to show how you might keep the user up to date when reading in a large csv file[^csv]:

[^csv]: If reading csv files is a bottleneck in your application should consider using `data.table::fread()` and `vroom::vroom()` instead; they can be orders of magnitude faster than `read.csv()`.

```{r}
server <- function(input, output, session) {
  data <- reactive({
    id <- showNotification("Reading data...", duration = NULL, closeButton = FALSE)
    on.exit(removeNotification(id), add = TRUE)
    
    read.csv(input$file$datapath)
  })
}
```

Generally, these sort of notifications will live in a reactive, because that ensures that the long-running task is only re-run when absolutely needed.

### Progressive updates

As you saw in the first example, multiple calls to `showNotification()` usually create multiple notifications. You can instead update a single notification by capturing the `id` from the first call and using it in subsequent calls. This is useful if your long-running task has multiple subcomponents.

```{r}
ui <- fluidPage(
  tableOutput("data")
)

server <- function(input, output, session) {
  notify <- function(msg, id = NULL) {
    showNotification(msg, id = id, duration = NULL, closeButton = FALSE)
  }

  data <- reactive({ 
    id <- notify("Reading data...")
    on.exit(removeNotification(id), add = TRUE)
    Sys.sleep(1)
      
    notify("Reticulating splines...", id = id)
    Sys.sleep(1)
    
    notify("Herding llamas...", id = id)
    Sys.sleep(1)

    notify("Orthogonalizing matrices...", id = id)
    Sys.sleep(1)
        
    mtcars
  })
  
  output$data <- renderTable(head(data()))
}
```

## Progress bars

For long-running tasks, the best type of feedback is a progress bar. As well as telling you where you are in the process, it also helps you estimate how much longer it's going to be: should you take a deep breath, go get a coffee, or come back tomorrow? In this section, I'll show two techniques for displaying progress bars, one built into Shiny, and one from the [waiter](https://waiter.john-coene.com/) package developed by John Coene. Both work roughly the same way, first creating an R6 object and then calling an update method after each step.

Unfortunately both techniques suffer from the same major drawback: to use a progress bar you need to be able to divide the big task into a known number of small pieces that each take roughly the same amount of time. This is often hard, particularly since the underlying code is often written in C and it has no way to communicate progres updates to you. We are working on tools in the [progress package](https://github.com/r-lib/progress) so that packages like dplyr, readr, and vroom will generate progress bars that you can easily forward to Shiny. I'll update this chapter when that approach is mature enough to use.

### Shiny

The following code block shows the basic lifecycle of a Shiny progress bar:

```{r, eval = FALSE}
# Create a progress bar object with `Progress$new(max = number_of_steps)`.
progress <- Progress$new(max = 5)

# Display the progress bar by calling the `$set()` method, 
# providing a title for the progress bar in the `message` argument.
progress$set(message = "Starting process")

# Call `$inc()` repeatedly, once for each step.
for (i in 1:5) {
  progress$inc(1)
}

# When done, call `$close()` to terminate the progress bar.
progress$close()
```

Here's how that might look in a complete Shiny app:

```{r}
ui <- fluidPage(
  numericInput("steps", "How many steps?", 10),
  actionButton("go", "go"),
  textOutput("result")
)

server <- function(input, output, session) {
  data <- reactive({
    req(input$go)
    
    progress <- Progress$new(max = input$steps)
    on.exit(progress$close())
    
    progress$set(message = "Computing random number")
    for (i in seq_len(input$steps)) {
      Sys.sleep(0.5)
      progress$inc(1)
    }
    runif(1)
  })
  
  output$result <- renderText(round(data(), 2))
}
```

Here I'm using `Sys.sleep()` to simulate a long running operation; in your code this would be a moderately expensive operation.

### Waiter

The built-in progress bar is great for the basics, but if you want something that provides more visual options, you might try the waiter package: [waiter](https://waiter.john-coene.com/). Adapating the above code to work with Waiter is straightforward. In the UI, we add `use_waitress()`:

```{r}
ui <- fluidPage(
  waiter::use_waitress(),
  numericInput("steps", "How many steps?", 10),
  actionButton("go", "go"),
  textOutput("result")
)
```

And then we replace `Progress` with `Waitress`. We skip the `$set()` call because waiter's progress bars don't have labels.

```{r}
server <- function(input, output, session) {
  data <- reactive({
    req(input$go)
    waitress <- waiter::Waitress$new(max = input$steps)
    on.exit(waitress$close())
    
    for (i in seq_len(input$steps)) {
      Sys.sleep(0.5)
      waitress$inc(1)
    }
    
    runif(1)
  })
  
  output$result <- renderText(round(data(), 2))
}
```

The default display is a thin progress bar at the top of the page, but there are a number of ways to customise the output:

*   You can override the default `theme` to use one of:

    * `overlay`: an opaque progress bar that hides the whole page
    * `overlay-opacity`: a translucent progress bar that covers the whole page
    * `overlay-percent`: an opaque progress bar that also displays a numeric percentage.

*   And instead of showing a progress bar for the entire page, can overlay it 
    on an existing input or output by setting the `id` parameter, e.g.:
  
    ```{r, eval = FALSE}
    waitress <- Waitress$new(selector = "#steps", theme = "overlay")
    ```

### Spinners

Sometimes you don't know exactly how long an operation will take, and you just want to display an animated spinner that reassures the user that something is happening. You can also use the waiter package for this task; just switch from using a `Waitress` to using a `Waiter`: 

```{r}
ui <- fluidPage(
  waiter::use_waiter(),
  actionButton("go", "go"),
  textOutput("result")
)

server <- function(input, output, session) {
  data <- reactive({
    req(input$go)
    waiter <- waiter::Waiter$new()
    waiter$show()
    on.exit(waiter$hide())
    
    Sys.sleep(sample(5, 1))
    runif(1)
  })
  output$result <- renderText(round(data(), 2))
}
```

Like Waitress, you can also use Waiters for specific outputs. These waiters can automatically remove the spinner when the output updates, so the code is even simpler:

```{r}
ui <- fluidPage(
  waiter::use_waiter(),
  actionButton("go", "go"),
  plotOutput("plot"),
)

server <- function(input, output, session) {
  data <- reactive({
    req(input$go)
    waiter::Waiter$new(id = "plot")$show()
    
    Sys.sleep(3)
    data.frame(x = runif(50), y = runif(50))
  })
  
  output$plot <- renderPlot(plot(data()), res = 96)
}
```

The waiter package provides a large variety of spinners to choose from; see your options at `?waiter::spinners` and then choose one with (e.g.) `Waiter$new(html = spin_ripple())`. 

## Confirming and undoing

Sometimes an action is potentially dangerous, and you either want to make sure that the user _really_ wants to do it, or you want to give them the ability to back out before it's too late. The three techniques in this section lay out your basic options and give you some tips for how you might implement them in your app.

### Explicit confirmation

The simplest approach to protecting the user from accidentally performing a dangerous action is to require an explicit confirmation. The easiest way is to use a dialog box which forces the user to pick from one of a small set of actions. In Shiny, you create a dialog box with `modalDialog()`. This is called a "modal" dialog because it creates a new "mode" of interaction; you can't interact with the main application until you have dealt with the dialog.

Imagine you have an Shiny app that deletes some files from a directory (or rows in a database etc). This is hard to undo so you want to make sure that the user is really sure. You could create a dialog box that requires an explicit confirmation as follows:

```{r}
modal_confirm <- modalDialog(
  "Are you sure you want to continue?",
  title = "Deleting files",
  footer = list(
    actionButton("cancel", "Cancel"),
    actionButton("ok", "Delete", class = "btn btn-danger")
  )
)
```

There are a few small, but important, details to consider when creating a dialog box:

* What should you call the buttons? It's best to be descriptive, so avoid
  yes/no or continue/cancel in favour of recaptiulating the key verb.

* How should you order the buttons? Do you put cancel first (like the Mac), 
  or continue first (like Windows)? Your best option is to mirror the platform
  that you think most people will be using. 

* Can you make the dangerous option more obvious? Here I've used 
  `class = "btn btn-danger"` to style the button prominently.
  
Jakob Nielsen has more good advice at <http://www.useit.com/alertbox/ok-cancel.html>.

Let's use this dialog in a real (if very simple) app. Our UI exposes a single button to "delete all the files":

```{r}
ui <- fluidPage(
  actionButton("delete", "Delete all files?")
)
```

There are two new ideas in the `server()`: 

* We use `showModal()` and `removeModal()` to show and hide the dialog.

* We observe events generated by the UI from `modal_confirm`. These objects
  aren't created statically in the `ui`, but are instead dynamically added
  in the `server()` by `showModal()`. You'll see that technique in much 
  more detail in Chapter \@ref(action-dynamic).

```{r}
server <- function(input, output, session) {
  observeEvent(input$delete, {
    showModal(modal_confirm)
  })
  
  observeEvent(input$ok, {
    showNotification("Files deleted")
    removeModal()
  })
  observeEvent(input$cancel, 
    removeModal()
  )
}
```

We'll come back to more sophisticated uses of modal dialog boxes in Section \@ref(dynamic-dialog).

### Undoing an action

Explicit confirmation is most useful for destructive actions that are only performed infrequently. You should avoid it if you want to reduce the errors made by frequent actions. For example, this technique would not work for twitter - if there was a dialog box that said "Are you sure you want to tweet this?" you would soon learn to automatically click yes, and still feel the same feeling of regret of noticing a typo 10s after tweeting.

In this situation a better approach is to wait few seconds before actually performing the action, giving the user a chance to notice any problems and undo them. This isn't really an undo (since you're not actually doing anything), but it's an evocative word that users will understand.

I illustrate the technique with a website that I personally wish had an undo button: Twitter. The essence of the Twitter UI is very simple: there's a text area to compose your tweet and a button to send it:

```{r}
ui <- fluidPage(
  textAreaInput("message", 
    label = NULL, 
    placeholder = "What's happening?",
    rows = 3
  ),
  actionButton("tweet", "Tweet")
)
```

The server function is quite complex and requires some techniques that we haven't talked about. Don't worry too much about understanding the code, focus on the basic idea: we use some special arguments to `observeEvent()` to run some code after a few seconds. The big new idea is that we capture the result of `observeEvent()` and save it to a variable; this allows us to destroy the observer so the code that would really send the tweet is never run.

```{r}
runLater <- function(action, seconds = 3) {
  observeEvent(
    invalidateLater(seconds * 1000), action, 
    ignoreInit = TRUE, 
    once = TRUE, 
    ignoreNULL = FALSE,
    autoDestroy = FALSE
  )
}

server <- function(input, output, session) {
  waiting <- NULL
  last_message <- NULL
  
  observeEvent(input$tweet, {
    notification <- glue::glue("Tweeted '{input$message}'")
    last_message <<- input$message
    updateTextAreaInput(session, "message", value = "")

    showNotification(
      notification,
      action = actionButton("undo", "Undo?"),
      duration = NULL,
      closeButton = FALSE,
      id = "tweeted",
      type = "warning"
    )

    waiting <<- runLater({
      cat("Actually sending tweet...\n")
      removeNotification("tweeted")
    })
  })
  
  observeEvent(input$undo, {
    waiting$destroy()
    showNotification("Tweet retracted", id = "tweeted")
    updateTextAreaInput(session, "message", value = last_message)
  })
}
```

### Trash

For actions that you might regret days later, a more sophisticated pattern is to implement something like the trash or recycling bin on your computer. When you delete a file, it isn't permanently deleted but instead is moved to a holding cell, which requires a separate action to empty. This is like the "undo" option on steroids; you have a lot of time to regret your action. It's also a bit like the confirmation; you have to do two separate actions to make deletion permanent.

The primary downside of this technique is that it is substantially more complicated to implement (you have to have a separate "holding cell" that stores the information need to undo the action), and requires regular intervention from the user to avoid accumulating. For that reason, I think it's beyond the scope of all but the most complicated Shiny apps, so I'm not going to show an implementation here.