Developing & Testing Your Shiny Application

Addenda

Martin Frigaard (Atorus)

Additional slides



These are slides that didn’t make the cut (either due to time or relevance), but the branches exist in the moviesApp repository and they are covered in the Shiny App-Packages book.

Outline


Launching apps

  • shinyApp()

  • shinyAppDir()

  • runApp()

Debugging

  • browser() & observe()

  • reactiveValuesToList()

Tests

  • Snapshots

  • Test mocks

Launching apps


In the 08_launch-app repo, multiple functions are used to launch the application in moviesApp.


The following slides discuss the differences between these functions (and why you’d use one over the other).


This topic is covered extensively in this blog post from ThinkR.

Launching apps: shinyApp()


What happens when we call shinyApp()?


  • shinyApp() creates and launches an app defined inline (or with UI and server function arguments)
app <- shinyApp(
  ui = fluidPage(), 
  server = function(input, output) {
    
  }
)
  • shinyApp() creates a shiny app object (shiny.appobj)
str(app)
List of 5
 $ httpHandler     :function (req)  
 $ serverFuncSource:function ()  
 $ onStart         : NULL
 $ options         : list()
 $ appOptions      :List of 2
  ..$ appDir       : chr "/path/to/moviesApp"
  ..$ bookmarkStore: NULL
 - attr(*, "class")= chr "shiny.appobj"

Launching apps: shinyAppDir()


What happens when we call shinyAppDir()?


  • shinyAppDir() launches an app from a directory (with an app.R or ui.R/server.R files).


shinyAppDir(
  appDir = "path/to/app/", 
  options = list())


  • shinyAppDir() can use a returned appDir from shinyApp()


app <- shinyApp(ui = movies_ui,
        server = movies_server)
app$appOptions$appDir
[1] "path/to/moviesApp"
shinyAppDir(
  appDir = app$appOptions$appDir)

Launching apps: runApp()


What happens when we call runApp()?


  • runApp() is the most versatile way to launch your app from the IDE


runApp()
  • It will run apps from the console, stored in a directory, or with a shiny object
runApp(
  appDir = "path/to/app/",
  test.mode = TRUE/FALSE)
app <- shinyApp(
        ui = movies_ui,
        server = movies_server)
runApp(appDir = app)

Debugging


In Shiny apps, the debugger can be a powerful tool for investigating error messages and server-side code.


Function execution is paused while we’re in browser mode, which allows us to inspect the variables in the current environment.


The following slides cover two methods for debugging Shiny functions:

  1. Wrapping browser() in a call to observe()

  2. Capturing reactive values with reactiveValuesToList() and sending output to the UI

Debugging Shiny errors


Debugging errors in Shiny can be difficult


movies_app(run = 'p')
ℹ shinyViewerType set to pane
Listening on http://127.0.0.1:6588

Opaque errors messages

browser() and observe()


Wrapping browser() with observe() triggers the debugger when the observer is invalidated


Within the scope of observe() we can interactively examine variables

movies_server <- function(input, output, session) {

    observe({
      browser()
      selected_vars <- mod_var_input_server("vars")
      mod_scatter_display_server("plot", var_inputs = selected_vars)
    })

}


devtools::load_all()

Debugger: pause execution


The debugger pauses execution of the modules in movies_server()


Call to observe(browser())

Debugger console

Debugger: execute line-by-line


Execute next line in the debugger by clicking ‘Next’ or by typing n and return/enter in Console.


Browse[1]> n


Browse[2]> n


Browse[2]> n

Parentheses (or not)


selected_vars vs. selected_vars()


Browse[2]> selected_vars
reactive({
  list(y = input$y, x = input$x, z = input$z,
    alpha = input$alpha, size = input$size,
    plot_title = input$plot_title
  )
}) 


selected_vars without the parentheses returns the reactive() call (not the values)

Browse[2]> selected_vars()
$y
[1] "audience_score"

$x
[1] "imdb_rating"

$z
[1] "mpaa_rating"

$alpha
[1] 0.5

$size
[1] 2

$plot_title
[1] ""

Debugging modules


Repeat the process in mod_scatter_display_server()




Place browser() after moduleServer()

mod_scatter_display_server <- function(id, var_inputs) {
  moduleServer(id, function(input, output, session) {
    
    observe({
      browser()
      # module code
      })

  })
}


Load the package and run the application again

devtools::load_all()

Comparisons: waldo


Use waldo to compare var_inputs() and inputs()


Browse[2]> waldo::compare(var_inputs(), inputs())


`names(old)`: "y" "x" "z"   "alpha" "size" "plot_title"
`names(new)`: "x" "y" "col" "alpha" "size" "plot_title"

`old$z` is a character vector ('mpaa_rating')
`new$z` is absent

`old$col` is absent
`new$col` is a character vector ('mpaa_rating')

Can you spot the error?

Comparisons: diffobj


Use diffobj to compare var_inputs() and inputs()


Browse[2]> diffobj::diffObj(target = names(var_inputs()), 
                            current = names(inputs()))


Press ENTER to continue...

Can you spot the error?

Step into a function


Step into scatter_plot() and print the plot (before the labels and theme layer are executed)


Browse[1]> n
Browse[2]> s

Browse[1]> n
Browse[3]> n
Browse[3]> plot
Error in ggplot2::geom_point(alpha = alpha_var, size = size_var) : 
  Problem while computing aesthetics.
 Error occurred in the 1st layer.
Caused by error in `.data[[NULL]]`:
! Must subset the data pronoun with a string, not `NULL`.

Well-placed print()s


The debugger is a powerful tool for your arsenal, but sometimes, a well-placed print() call is the best way to understand your application’s behavior.


In standard R functions, adding a distinctive print() statement in a function lets us quickly direct output to the Console.


In Shiny functions, we can capture the values in input with reactiveValuesToList() and print() them in the UI.

Shiny print() calls


We can combine verbatimTextOutput(), renderPrint(), and reactiveValuesToList() to print the reactive values from modules and the UI/server functions:


In mod_var_input_ui()

verbatimTextOutput(outputId = ns("vals"))

In mod_var_input_server()

output$vals <- renderPrint({
  all_vals <- reactiveValuesToList(x = input, 
                                   all.names = TRUE)
  lobstr::tree(all_vals)
})


In movies_ui()

verbatimTextOutput(outputId = "vals")

In movies_server()

output$vals <- renderPrint({
  all_vals <- reactiveValuesToList(x = input,
                                   all.names = TRUE)
    lobstr::tree(all_vals)
})

Viewing print() calls in Shiny


The module’s reactive values are printed in the sidebar.


movies_app(run = 'p')

Viewing print() calls in Shiny


The reactive values for the app are printed in the main panel.


movies_app(run = 'p',
           bslib = TRUE)

Snapshot tests


The following slides give examples of snapshot tests with vdiffr.


Pros

Help identify visual regressions by comparing current output with previous snapshot


Ensure that plotting functions maintain consistent outputs throughout development


Cons

Brittle/sensitive to minor changes in color, spacing, labels, etc.


Can lead to test failures (even if the changes are insignificant)

Snapshot scenario


An example Feature and Scenario for a snapshot tests:


testthat::describe("Feature: Scatter Plot Points Controlled by Dropdown Menus
     As a user creating a scatter plot,
     I want dropdown menus to select continuous variables for the x and y axes a
     And I want a dropdown menu to select a categorical variable for point coloration,
     So that I can effectively visualize the relationships and categories within the data.", code = {
    testthat::it("Scenario: Change x, y, color values for plotting
         When I launch the Scatter Plot Data Visualization
         And I select the variable 'Audience Score' for the x-axis
         And I select the variable 'IMDB Rating' for the y-axis
         And I select the variable 'Critics Rating' for the color
         Then the scatter plot should show 'Audience Score' on the x-axis
         And the scatter plot should show 'IMDB Rating' on the y-axis
         And the points on the scatter plot should be colored by 'Critics Rating'", code = {
      })
    })

Visual unit test


vdiffr allows us to perform a ‘visual unit test’




expect_doppelganger() stores the expected output as an .svg file

scatter_inputs <- list(x = 'imdb_rating', 
                   y = 'audience_score', 
                   z = 'mpaa_rating', 
                   alpha = 0.5,
                   size = 2, 
                   plot_title = 'Enter plot title')

vdiffr::expect_doppelganger(
  title = "Initial x y z axes", 
  fig = scatter_plot(movies, 
    x_var = scatter_inputs$x, 
    y_var = scatter_inputs$y, 
    col_var = scatter_inputs$z, 
    alpha_var = scatter_inputs$alpha, 
    size_var = scatter_inputs$size) +

Visual unit test


The scenario describes a fully functional graph



So we include the labels and theme in the snapshot:

vdiffr::expect_doppelganger(
  title = "Initial x y z axes", 
  fig = scatter_plot(movies, 
    x_var = scatter_inputs$x, 
    y_var = scatter_inputs$y, 
    col_var = scatter_inputs$z, 
    alpha_var = scatter_inputs$alpha, 
    size_var = scatter_inputs$size) +
  ggplot2::labs(
    title = scatter_inputs$plot_title,
    x = stringr::str_replace_all(
        tools::toTitleCase(scatter_inputs$x),"_", " "),
    y = stringr::str_replace_all(
        tools::toTitleCase(scatter_inputs$y), "_", " ") ) +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "bottom"))

Example test (snapshots & logging)

The initial test run gives us a warning about the snapshot files


Snapshots

── Warning (test-scatter_plot.R:27:5): 
Scenario: Displaying the Pre-configured Initial Scatter Plot ──
Adding new file snapshot: 'tests/testthat/_snaps/initial-x-y-z-axes.svg'

── Warning (test-scatter_plot.R:71:5):
Scenario: Change x, y, color values for plotting ──
Adding new file snapshot: 'tests/testthat/_snaps/updated-x-y-color.svg'
[ FAIL 0 | WARN 2 | SKIP 0 | PASS 2 ]


svg files are stored in tests/testthat/_snaps/

tests/testthat/_snaps/
└── scatter_plot
    ├── initial-x-y-z-axes.svg
    └── updated-x-y-color.svg

2 directories, 2 files

Example test (snapshots & logging)


Subsequent runs give more verbose output from devtools::test_active_file():


Start test

INFO [2023-10-24 12:23:56] [ START scatter_plot(movies) = snap initial x,y,z,size,alpha]


Test ends

[ FAIL 0 | WARN 0 | SKIP 0 | PASS 1 ]
INFO [2023-10-24 12:23:56] [ END scatter_plot(movies) = snap initial x,y,z,size,alpha]


Test updated values

INFO [2023-10-24 12:23:56] [ START scatter_plot(movies) = snap updated x,y,z]
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 2 ]
INFO [2023-10-24 12:23:57] [ END scatter_plot(movies) = snap updated x,y,z]

Reviewing snapshots

initial-x-y-z-axes.svg

updated-x-y-color.svg

These are test results we can share with users/shareholders.

Test mocks

Test mocking functions are a relatively new addition to testthat


Example test with mocking

Mocking functions can be used to substitute functions by emulating their behavior within the test scope


test_that(
  "Scenario: 
     Given `local_function()` behavior
     When I ...
     Then ...", {
  local_mocked_bindings(
    local_function = function(...) 'value'
   )
  expect_equal(observed = x, expected = y)
})

Example function: check_installed()


Assume we have a check_installed() function that checks if a package is installed


  • check_installed() relies on is_installed() from rlang

  • rlang is already listed under Imports in the DESCRIPTION

check_installed <- function(package) {
  if (is_installed(package)) {
    return(invisible())
  } else {
    stop("Please install '{package}' before continuing")
  }
}




The example above has been adapted from the package development masterclass workshop at posit::conf(2023)

Example function: feature and scenario


Feature and scenario decriptions for check_installed() might look like:


Feature: Checking if an R package is installed

  Scenario: Checking an uninstalled package
    Given the R package 'foo' is not installed
    When I call the `check_installed()` function with 'foo'
    Then the function should raise an error with the message
    `Please install 'foo' before continuing`
is_installed('foo')
## [1] FALSE


  Scenario: Checking an installed package
    Given the R package 'base' is installed
    When I call the `check_installed()` function with 'base'
    Then the function should return without any error
is_installed('base')
## [1] TRUE

Example test mock


Instead of real-time computations, mocks return predefined responses to given inputs.

describe("Feature: Checking if an R package is installed", code = {
  describe("Scenario: Checking an uninstalled package
              Given the R package 'foo' is not installed
              When I call the `check_installed()` function with 'foo'", code = {
  test_that("Then the function should raise an error with the message
             `Please install 'foo' before continuing`", code = {
      test_logger(start = "mock is_installed", msg = "FALSE")
      local_mocked_bindings(
        is_installed = function(package) FALSE
      )
      expect_error(object = check_installed("foo"))
      test_logger(end = "mock is_installed", msg = "FALSE")
    })

is_installed() is set to FALSE

expect_error() confirms the error message

Notes on mocking


The roxygen2 documentation for check_installed() needs an @importFrom tag to import is_installed from rlang


Using explicit namespacing alone won’t work

#' Check if package is installed
#' 
#' An example function for demonstrating how to use `testthat`'s
#' mocking functions.
#' 
#' @param package string, name of package
#'
#' @return invisible 
#'
#' @importFrom rlang is_installed
#'
#' @export
#'
#' @examples
#' check_installed("foo")
#' check_installed("base")