14 Mastering Shiny’s events

We’ve already seen a couple of Shiny JS events since the beginning of this book. You may know the shiny:connected, meaning that the client and server are properly initialized and all internal methods/functions are available to the programmer. Below, we add more elements to the list, trying to give practical examples and see how it can significantly improve your apps. If you ever used the waiter (Coene 2021b) package by John Coene, know that it heavily relies on some Shiny’s event (Figure 14.1).

{waiter} preloader significantly improves the perceived app performance and user experience.

FIGURE 14.1: {waiter} preloader significantly improves the perceived app performance and user experience.

14.1 Get the last changed input

14.1.1 Motivations

We probably all had this question one day: How can I get the last changed input in a Shiny app? There are already some methods like this one:

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/get-last-changed", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)

shinyApp(
  ui = fluidPage(
    textInput('txt_a', 'Input Text A'),
    textInput('txt_b', 'Input Text B'),
    uiOutput('txt_c_out'),
    verbatimTextOutput("show_last")
  ),
  server = function(input, output, session) {
    output$txt_c_out <- renderUI({
      textInput('txt_c', 'Input Text C')
    })

    values <- reactiveValues(
      lastUpdated = NULL
    )

    observe({
      lapply(names(input), function(x) {
        observe({
          input[[x]]
          values$lastUpdated <- x
        })
      })
    })

    output$show_last <- renderPrint({
      values$lastUpdated
    })
  }
)

Shouldn’t this be easier? Could we do that from the client instead, thereby reducing the server load?

14.1.2 Invoke JS events

shiny:inputchanged is the event we are looking for. It is fired each time an input gets a new value. The related events has five properties:

  • name, the event name.
  • value, the new value.
  • inputType, the input type.
  • binding, the related input binding.
  • el the related input DOM element.

You may try below:

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/get-input-changed", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)

ui <- fluidPage(
  tags$script(
    HTML("$(document).on(
      'shiny:inputchanged',
      function(event) {
       console.log(event);
    });"
  )),
  textInput("test", "Test")
)

server <- function(input, output) {}

shinyApp(ui, server)

Changing the textInput() value fires the event as shown Figure 14.2.

Inspect the input-changed event in the JS console.

FIGURE 14.2: Inspect the input-changed event in the JS console.

Contrary to what is mentioned in the online documentation, inputType does not always have a value. In this case, an alternative, is to access the related input binding and extract its name (Figure @ref(fig: input-changed-event-zoom)), as shown below:

$(document).on('shiny:inputchanged', function(event) {
  Shiny.setInputValue(
    'pleaseStayHome', 
    {
      name: event.name, 
      value: event.value, 
      type: event.binding.name.split('.')[1]
    }
  );
});

If you use this code in a custom shiny template, it is possible that input bindings doesn’t have name, which would thereby make event.binding.name.split('.')[1] crash, event.binding being undefined.

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/get-input-changed-info", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)

ui <- fluidPage(
  tags$script(
    HTML("
      $(document).on(
        'shiny:inputchanged',
        function(event) {
          Shiny.setInputValue(
            'last_changed',
            {
              name: event.name,
              value: event.value,
              type: event
                .binding
                .name
                .split('.')[1]
            }
          );
      });"
    )),
  textInput("test", "Test"),
  verbatimTextOutput("last_changed")
)

server <- function(input, output) {
  output$last_changed <- renderPrint(input$last_changed)
}

shinyApp(ui, server)

Extract input-changed event most relevant elements.

FIGURE 14.3: Extract input-changed event most relevant elements.

For the textInput(), the event is also fired when moving the mouse cursor with the keyboard arrows, which is a sort of false positive, since the value isn’t changed. However, as Shiny.setInputValue only sets a new value when the input value really changed (unless the priority is set to event), we avoid this edge case. As an exercise, you may try to add {priority: 'event'} to the above code.

$(document).on('shiny:inputchanged') is also cancellable, that is we may definitely prevent the input to change its value, calling event.preventDefault();, as depicted by Figure 14.4.

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/freeze-input-change", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)

ui <- fluidPage(
  tags$script(
    HTML("
      $(document).on(
        'shiny:inputchanged',
        function(event) {
          event.preventDefault();
      });"
  )),
  textInput("test", "Test"),
  verbatimTextOutput("val")
)

server <- function(input, output) {
  output$val <- renderPrint(input$test)
}

shinyApp(ui, server)

Cancel input update on the client.

FIGURE 14.4: Cancel input update on the client.

14.1.3 Practical example

shinyMobile natively implements this feature that may be accessed with input$lastInputChanged.

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/get-last-changed-shinyMobile", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)
library(shinyMobile)

shinyApp(
  ui = f7Page(
    title = "My app",
    f7SingleLayout(
      navbar = f7Navbar(
        title = "Single Layout",
        hairline = FALSE,
        shadow = TRUE
      ),
      toolbar = f7Toolbar(
        position = "bottom",
        f7Link(label = "Link 1", href = "https://www.google.com"),
        f7Link(label = "Link 2", href = "https://www.google.com")
      ),
      # main content,
      f7Card(
        f7Text(inputId = "text", label = "Text"),
        f7Slider(
          inputId = "range1",
          label = "Range",
          min = 0, max = 2,
          value = 1,
          step = 0.1
        ),
        verbatimTextOutput("lastChanged")
      )
    )
  ),
  server = function(input, output) {
    output$lastChanged <- renderPrint(input$lastInputChanged)
  }
)

This approach has the advantage not to overload the server part with complex logic.

14.1.4 About {shinylogs}

The shinylogs (Meyer and Perrier 2019) package developed by dreamRs provide this feature with much more advanced options such as a history of past values, as demonstrated on Figure 14.5.

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/get-last-changed-shinylogs", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)
library(shinylogs)

shinyApp(
  ui = fluidPage(
    numericInput("n", "n", 1),
    sliderInput("s", "s", min = 0, max = 10, value = 5),
    verbatimTextOutput("lastChanged")
  ),
  server = function(input, output, session) {
    # specific to shinylogs
    track_usage(storage_mode = store_null())
    output$lastChanged <- renderPrint({
      input$`.shinylogs_lastInput`
    })
  }
)

{shinylogs} allows real time input tracking and storage for analytics purposes.

FIGURE 14.5: {shinylogs} allows real time input tracking and storage for analytics purposes.

14.2 Custom overlay screens

If you ever designed corporate production apps, you probably faced this situation where clients wanted a loading screen, whenever a computation occurs or at start. To date, one of the most comprehensive alternative is the waiter package. It provide myriad of options to significantly enhance the perceived performance of your app. In the following, we’ll focus on the waiter_preloader() and waiter_on_busy() functions. How does this work?

14.2.1 Preloader

Under the hood, this feature relies on the shiny:idle event. When the app starts, shiny:idle is triggered just after shiny:connected and shiny:sessioninitialized. shiny:idle is also called each time a computation cycle is finished, that is each time an input is changed and the related output are re-rendered.

Whenever we call waiter_preloader(), an HTML overlay is added in the DOM. Moreover, this extra JS code ensures to hide the waiter when shiny is ready:

window.ran = false;
$(document).on('shiny:idle', function(event){
  if(!window.ran)
    hide_waiter(id = null);
  window.ran = true;
});

As a security, window.ran prevents us from running this code twice. As an example, consider this app with a slider input and a plot output. We simulated a delay of three seconds to produce the plot.

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/waiter-on-load", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)
library(waiter)

ui <- fluidPage(
  use_waiter(), # dependencies
  # shows before anything else
  waiter_preloader(spin_fading_circles()),
  sliderInput("obs", "Number of observations:",
              min = 0, max = 1000, value = 500
  ),
  plotOutput("distPlot")
)

server <- function(input, output){
  output$distPlot <- renderPlot({
    Sys.sleep(3)
    hist(rnorm(input$obs))
  })
}
shinyApp(ui, server)

Notice how the waiter correctly handles the plot processing time.

14.2.2 Load on busy

Similarly, the waiter_on_busy() exploit the shiny:idle and shiny:busy events. Each time an output is invalidated, shiny:busy is fired, which triggers the recalculation until the next shiny:idle event. The loader is shown as soon as shiny is busy:

$(document).on('shiny:busy', function(event) {
  show_waiter(
    id = null,
    html = ..., 
    color = ...
  );
});

and is hidden once shiny is done:

$(document).on('shiny:idle', function(event) {
  hide_waiter(null);
});

### RUN ### 
# OSUICode::run_example( 
#  "shiny-events/waiter-on-busy", 
#   package = "OSUICode" 
# ) 

### APP CODE ### 
library(shiny)
library(waiter)

ui <- fluidPage(
  use_waiter(), # dependencies
  waiter_on_busy(),
  sliderInput("obs", "Number of observations:",
              min = 0, max = 1000, value = 500
  ),
  plotOutput("distPlot")
)

server <- function(input, output){
  output$distPlot <- renderPlot({
    Sys.sleep(3)
    hist(rnorm(input$obs))
  })
}
shinyApp(ui, server)