Package 'teal'

Description

A helper function to create the browser title along with a logo.

Usage

build_app_title(
  title = "teal app",
  favicon =
    "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png"
)

Arguments

Value

A shiny.tag containing the element that adds the title and logo to the shiny app.

Description

Usage

example_module(
  label = "example teal module",
  datanames = "all",
  transformators = list(),
  decorators = NULL
)

Arguments

Details

This module creates an object called object that can be modified with decorators. The object is determined by what's selected in ⁠Choose a dataset⁠ input in UI. The object can be anything that can be handled by renderPrint(). See the vignette("decorate-modules-output", package = "teal") or teal_transform_module to read more about decorators.

Value

A teal module which can be included in the modules argument to init().

Examples

app <- init(
  data = teal_data(IRIS = iris, MTCARS = mtcars),
  modules = example_module()
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Description

End-users: This is the most important function for you to start a teal app that is composed of teal modules.

Usage

init(
  data,
  modules,
  filter = teal_slices(),
  title = build_app_title(),
  header = tags$p(),
  footer = tags$p(),
  id = character(0),
  landing_popup = NULL
)

Arguments

Value

Named list containing server and UI functions.

Examples

app <- init(
  data = within(
    teal_data(),
    {
      new_iris <- transform(iris, id = seq_len(nrow(iris)))
      new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars)))
    }
  ),
  modules = modules(
    module(
      label = "data source",
      server = function(input, output, session, data) {},
      ui = function(id, ...) tags$div(p("information about data source")),
      datanames = "all"
    ),
    example_module(label = "example teal module"),
    module(
      "Iris Sepal.Length histogram",
      server = function(input, output, session, data) {
        output$hist <- renderPlot(
          hist(data()[["new_iris"]]$Sepal.Length)
        )
      },
      ui = function(id, ...) {
        ns <- NS(id)
        plotOutput(ns("hist"))
      },
      datanames = "new_iris"
    )
  ),
  filter = teal_slices(
    teal_slice(dataname = "new_iris", varname = "Species"),
    teal_slice(dataname = "new_iris", varname = "Sepal.Length"),
    teal_slice(dataname = "new_mtcars", varname = "cyl"),
    exclude_varnames = list(new_iris = c("Sepal.Width", "Petal.Width")),
    module_specific = TRUE,
    mapping = list(
      `example teal module` = "new_iris Species",
      `Iris Sepal.Length histogram` = "new_iris Species",
      global_filters = "new_mtcars cyl"
    )
  ),
  title = "App title",
  header = tags$h1("Sample App"),
  footer = tags$p("Sample footer")
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Description

Creates a landing welcome popup for teal applications.

This module is used to display a popup dialog when the application starts. The dialog blocks access to the application and must be closed with a button before the application can be viewed.

Usage

landing_popup_module(
  label = "Landing Popup",
  title = NULL,
  content = NULL,
  buttons = modalButton("Accept")
)

Arguments

Value

A teal_module (extended with teal_landing_module class) to be used in teal applications.

Examples

app1 <- init(
  data = teal_data(iris = iris),
  modules = modules(
    example_module()
  ),
  landing_popup = landing_popup_module(
    content = "A place for the welcome message or a disclaimer statement.",
    buttons = modalButton("Proceed")
  )
)
if (interactive()) {
  shinyApp(app1$ui, app1$server)
}

app2 <- init(
  data = teal_data(iris = iris),
  modules = modules(
    example_module()
  ),
  landing_popup = landing_popup_module(
    title = "Welcome",
    content = tags$b(
      "A place for the welcome message or a disclaimer statement.",
      style = "color: red;"
    ),
    buttons = tagList(
      modalButton("Proceed"),
      actionButton("read", "Read more",
        onclick = "window.open('http://google.com', '_blank')"
      ),
      actionButton("close", "Reject", onclick = "window.close()")
    )
  )
)

if (interactive()) {
  shinyApp(app2$ui, app2$server)
}

Description

A factory function to simplify creation of a teal_transform_module's server. Specified expr is wrapped in a shiny module function and output can be passed to the server argument in teal_transform_module() call. Such a server function can be linked with ui and values from the inputs can be used in the expression. Object names specified in the expression will be substituted with the value of the respective input (matched by the name) - for example in expression(graph <- graph + ggtitle(title)) object title will be replaced with the value of input$title.

Usage

make_teal_transform_server(expr)

Arguments

Value

⁠function(id, data)⁠ returning shiny module

Examples

trim_iris <- teal_transform_module(
  label = "Simplified interactive transformator for iris",
  datanames = "iris",
  ui = function(id) {
    ns <- NS(id)
    numericInput(ns("n_rows"), "Subset n rows", value = 6, min = 1, max = 150, step = 1)
  },
  server = make_teal_transform_server(expression(iris <- head(iris, n_rows)))
)

app <- init(
  data = teal_data(iris = iris),
  modules = example_module(transformators = trim_iris)
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Description

Module to create a teal app. This module can be called directly instead of init() and included in your custom application. Please note that init() adds reporter_previewer_module automatically, which is not a case when calling ui/srv_teal directly.

Usage

ui_teal(
  id,
  modules,
  title = build_app_title(),
  header = tags$p(),
  footer = tags$p()
)

srv_teal(id, data, modules, filter = teal_slices())

Arguments

Details

Module is responsible for creating the main shiny app layout and initializing all the necessary components. This module establishes reactive connection between the input data and every other component in the app. Reactive change of the data passed as an argument, reloads the app and possibly keeps all input settings the same so the user can continue where one left off.

data flow in teal application

This module supports multiple data inputs but eventually, they are all converted to reactive returning teal_data in this module. On this ⁠reactive teal_data⁠ object several actions are performed:

• data loading in module_init_data

• data filtering in module_filter_data

• data transformation in module_transform_data

Fallback on failure

teal is designed in such way that app will never crash if the error is introduced in any custom shiny module provided by app developer (e.g. teal_data_module(), teal_transform_module()). If any module returns a failing object, the app will halt the evaluation and display a warning message. App user should always have a chance to fix the improper input and continue without restarting the session.

Value

NULL invisibly

Description

Please use module_teal instead.

Usage

ui_teal_with_splash(
  id,
  data,
  title = build_app_title(),
  header = tags$p(),
  footer = tags$p()
)

srv_teal_with_splash(id, data, modules, filter = teal_slices())

Arguments

Value

Returns a reactive expression containing a teal_data object when data is loaded or NULL when it is not.

Description

Module calls teal_transform_module() in sequence so that ⁠reactive teal_data⁠ output from one module is handed over to the following module's input.

Usage

ui_transform_teal_data(id, transformators, class = "well")

srv_transform_teal_data(
  id,
  data,
  transformators,
  modules = NULL,
  is_transform_failed = reactiveValues()
)

Arguments

Value

reactive teal_data

Description

This function generates a report card with a title, an optional description, and the option to append the filter state list.

Usage

report_card_template(
  title,
  label,
  description = NULL,
  with_filter,
  filter_panel_api
)

Arguments

Value

(TealReportCard) populated with a title, description and filter state.

Description

This function wraps teal.reporter::reporter_previewer_ui() and teal.reporter::reporter_previewer_srv() into a teal_module to be used in teal applications.

If you are creating a teal application using init() then this module will be added to your application automatically if any of your teal_modules support report generation.

Usage

reporter_previewer_module(label = "Report previewer", server_args = list())

Arguments

Value

teal_module (extended with teal_module_previewer class) containing the teal.reporter previewer functionality.

Description

Use the shiny::showModal() function to show the R code inside.

Usage

show_rcode_modal(title = NULL, rcode, session = getDefaultReactiveDomain())

Arguments

References

shiny::showModal()

Description

Recent changes in teal cause modules to fail because modules expect a tdata object to be passed to the data argument but instead they receive a teal_data object, which is additionally wrapped in a reactive expression in the server functions. In order to easily adapt such modules without a proper refactor, use this function to downgrade the data argument.

Usage

new_tdata(...)

tdata2env(...)

get_code_tdata(...)

## S3 method for class 'tdata'
join_keys(...)

get_metadata(...)

as_tdata(...)

Arguments

Value

nothing

Description

Create a teal_data_module object and evaluate code on it with history tracking.

Usage

teal_data_module(ui, server, label = "data module", once = TRUE)

## S4 method for signature 'teal_data_module,character'
eval_code(object, code)

## S3 method for class 'teal_data_module'
within(data, expr, ...)

Arguments

Details

teal_data_module creates a shiny module to interactively supply or modify data in a teal application. The module allows for running any code (creation and some modification) after the app starts or reloads. The body of the server function will be run in the app rather than in the global environment. This means it will be run every time the app starts, so use sparingly.

Pass this module instead of a teal_data object in a call to init(). Note that the server function must always return a teal_data object wrapped in a reactive expression.

See vignette vignette("data-as-shiny-module", package = "teal") for more details.

eval_code evaluates given code in the environment of the teal_data object created by the teal_data_module. The code is added to the ⁠@code⁠ slot of the teal_data.

within is a convenience function for evaluating inline code inside the environment of a teal_data_module. It accepts only inline expressions (both simple and compound) and allows for injecting values into expr through the ... argument: as name:value pairs are passed to ..., name in expr will be replaced with value.

Value

teal_data_module returns a list of class teal_data_module containing two elements, ui and server provided via arguments.

eval_code returns a teal_data_module object with a delayed evaluation of code when the module is run.

within returns a teal_data_module object with a delayed evaluation of expr when the module is run.

See Also

teal.data::teal_data, teal.code::qenv()

Examples

tdm <- teal_data_module(
  ui = function(id) {
    ns <- NS(id)
    actionButton(ns("submit"), label = "Load data")
  },
  server = function(id) {
    moduleServer(id, function(input, output, session) {
      eventReactive(input$submit, {
        data <- within(
          teal_data(),
          {
            dataset1 <- iris
            dataset2 <- mtcars
          }
        )

        data
      })
    })
  }
)

eval_code(tdm, "dataset1 <- subset(dataset1, Species == 'virginica')")

within(tdm, dataset1 <- subset(dataset1, Species == "virginica"))

# use additional parameter for expression value substitution.
valid_species <- "versicolor"
within(tdm, dataset1 <- subset(dataset1, Species %in% species), species = valid_species)

Description

Create a nested tab structure to embed modules in a teal application.

Usage

module(
  label = "module",
  server = function(id, data, ...) moduleServer(id, function(input, output, session)
    NULL),
  ui = function(id, ...) tags$p(paste0("This module has no UI (id: ", id, " )")),
  filters,
  datanames = "all",
  server_args = NULL,
  ui_args = NULL,
  transformators = list()
)

modules(..., label = "root")

## S3 method for class 'teal_module'
format(
  x,
  is_last = FALSE,
  parent_prefix = "",
  what = c("datasets", "properties", "ui_args", "server_args", "transformators"),
  ...
)

## S3 method for class 'teal_modules'
format(x, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...)

## S3 method for class 'teal_module'
print(x, ...)

## S3 method for class 'teal_modules'
print(x, ...)

set_datanames(modules, datanames)

Arguments

Details

module() creates an instance of a teal_module that can be placed in a teal application. modules() shapes the structure of a the application by organizing teal_module within the navigation panel. It wraps teal_module and teal_modules objects in a teal_modules object, which results in a nested structure corresponding to the nested tabs in the final application.

Note that for modules() label comes after ..., so it must be passed as a named argument, otherwise it will be captured by ....

The labels "global_filters" and "Report previewer" are reserved because they are used by the mapping argument of teal_slices() and the report previewer module reporter_previewer_module(), respectively.

Value

module() returns an object of class teal_module.

modules() returns a teal_modules object which contains following fields:

• label: taken from the label argument.

• children: a list containing objects passed in .... List elements are named after their label attribute converted to a valid shiny id.

Restricting datasets used by teal_module:

The datanames argument controls which datasets are used by the module’s server. These datasets, passed via server's data argument, are the only ones shown in the module's tab.

When datanames is set to "all", all datasets in the data object are treated as relevant. However, this may include unnecessary datasets, such as:

• Proxy variables for column modifications

• Temporary datasets used to create final versions

• Connection objects

To exclude irrelevant datasets, use the set_datanames() function to change datanames from "all" to specific names. Trying to modify non-"all" values with set_datanames() will result in a warning. Datasets with names starting with . are ignored globally unless explicitly listed in datanames.

datanames with transformators

When transformators are specified, their datanames are added to the module’s datanames, which changes the behavior as follows:

• If module(datanames) is NULL and the transformators have defined datanames, the sidebar will appear showing the transformators' datasets, instead of being hidden.

• If module(datanames) is set to specific values and any transformator has datanames = "all", the module may receive extra datasets that could be unnecessary

Examples

library(shiny)

module_1 <- module(
  label = "a module",
  server = function(id, data) {
    moduleServer(
      id,
      module = function(input, output, session) {
        output$data <- renderDataTable(data()[["iris"]])
      }
    )
  },
  ui = function(id) {
    ns <- NS(id)
    tagList(dataTableOutput(ns("data")))
  },
  datanames = "all"
)

module_2 <- module(
  label = "another module",
  server = function(id) {
    moduleServer(
      id,
      module = function(input, output, session) {
        output$text <- renderText("Another Module")
      }
    )
  },
  ui = function(id) {
    ns <- NS(id)
    tagList(textOutput(ns("text")))
  },
  datanames = NULL
)

modules <- modules(
  label = "modules",
  modules(
    label = "nested modules",
    module_1
  ),
  module_2
)

app <- init(
  data = teal_data(iris = iris),
  modules = modules
)

if (interactive()) {
  shinyApp(app$ui, app$server)
}
mod <- module(
  label = "My Custom Module",
  server = function(id, data, ...) {},
  ui = function(id, ...) {},
  datanames = c("ADSL", "ADTTE"),
  transformators = list(),
  ui_args = list(a = 1, b = "b"),
  server_args = list(x = 5, y = list(p = 1))
)
cat(format(mod))
custom_module <- function(
    label = "label", ui_args = NULL, server_args = NULL,
    datanames = "all", transformators = list(), bk = FALSE) {
  ans <- module(
    label,
    server = function(id, data, ...) {},
    ui = function(id, ...) {
    },
    datanames = datanames,
    transformators = transformators,
    ui_args = ui_args,
    server_args = server_args
  )
  attr(ans, "teal_bookmarkable") <- bk
  ans
}

dummy_transformator <- teal_transform_module(
  label = "Dummy Transform",
  ui = function(id) div("(does nothing)"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) data)
  }
)

plot_transformator <- teal_transform_module(
  label = "Plot Settings",
  ui = function(id) div("(does nothing)"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) data)
  }
)

complete_modules <- modules(
  custom_module(
    label = "Data Overview",
    datanames = c("ADSL", "ADAE", "ADVS"),
    ui_args = list(
      view_type = "table",
      page_size = 10,
      filters = c("ARM", "SEX", "RACE")
    ),
    server_args = list(
      cache = TRUE,
      debounce = 1000
    ),
    transformators = list(dummy_transformator),
    bk = TRUE
  ),
  modules(
    label = "Nested 1",
    custom_module(
      label = "Interactive Plots",
      datanames = c("ADSL", "ADVS"),
      ui_args = list(
        plot_type = c("scatter", "box", "line"),
        height = 600,
        width = 800,
        color_scheme = "viridis"
      ),
      server_args = list(
        render_type = "svg",
        cache_plots = TRUE
      ),
      transformators = list(dummy_transformator, plot_transformator),
      bk = TRUE
    ),
    modules(
      label = "Nested 2",
      custom_module(
        label = "Summary Statistics",
        datanames = "ADSL",
        ui_args = list(
          stats = c("mean", "median", "sd", "range"),
          grouping = c("ARM", "SEX")
        )
      ),
      modules(
        label = "Labeled nested modules",
        custom_module(
          label = "Subgroup Analysis",
          datanames = c("ADSL", "ADAE"),
          ui_args = list(
            subgroups = c("AGE", "SEX", "RACE"),
            analysis_type = "stratified"
          ),
          bk = TRUE
        )
      ),
      modules(custom_module(label = "Subgroup Analysis in non-labled modules"))
    )
  ),
  custom_module("Non-nested module")
)

cat(format(complete_modules))
cat(format(complete_modules, what = c("ui_args", "server_args", "transformators")))
# change the module's datanames
set_datanames(module(datanames = "all"), "a")

# change modules' datanames
set_datanames(
  modules(
    module(datanames = "all"),
    module(datanames = "a")
  ),
  "b"
)

Description

teal_transform_module provides a shiny module that enables data transformations within a teal application and allows for customization of outputs generated by modules.

Usage

teal_transform_module(
  ui = NULL,
  server = function(id, data) data,
  label = "transform module",
  datanames = "all"
)

Arguments

Transforming Module Inputs in teal

Data transformations occur after data has been filtered in teal. The transformed data is then passed to the server of teal_module() and managed by teal's internal processes. The primary advantage of teal_transform_module over custom modules is in its error handling, where all warnings and errors are managed by teal, allowing developers to focus on transformation logic.

For more details, see the vignette: vignette("data-transform-as-shiny-module", package = "teal").

Customizing Module Outputs

teal_transform_module also allows developers to modify any object created within teal.data::teal_data. This means you can use it to customize not only datasets but also tables, listings, and graphs. Some teal_modules permit developers to inject custom shiny modules to enhance displayed outputs. To manage these decorators within your module, use ui_transform_teal_data() and srv_transform_teal_data(). (For further guidance on managing decorators, refer to ui_args and srv_args in the vignette documentation.)

See the vignette vignette("decorate-modules-output", package = "teal") for additional examples.

server as a language

The server function in teal_transform_module must return a reactive teal.data::teal_data object. For simple transformations without complex reactivity, the server function might look like this:s

function(id, data) {
  moduleServer(id, function(input, output, session) {
    reactive({
      within(
        data(),
        expr = x <- subset(x, col == level),
        level = input$level
      )
    })
  })
}

The example above can be simplified using make_teal_transform_server, where level is automatically matched to the corresponding input parameter:

make_teal_transform_server(expr = expression(x <- subset(x, col == level)))

Examples

data_transformators <- list(
  teal_transform_module(
    label = "Static transformator for iris",
    datanames = "iris",
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(), {
            iris <- head(iris, 5)
          })
        })
      })
    }
  ),
  teal_transform_module(
    label = "Interactive transformator for iris",
    datanames = "iris",
    ui = function(id) {
      ns <- NS(id)
      tags$div(
        numericInput(ns("n_cols"), "Show n columns", value = 5, min = 1, max = 5, step = 1)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
            {
              iris <- iris[, 1:n_cols]
            },
            n_cols = input$n_cols
          )
        })
      })
    }
  )
)

output_decorator <- teal_transform_module(
  server = make_teal_transform_server(
    expression(
      object <- rev(object)
    )
  )
)

app <- init(
  data = teal_data(iris = iris),
  modules = example_module(
    transformators = data_transformators,
    decorators = list(output_decorator)
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Description

Child class of ReportCard that is used for teal specific applications. In addition to the parent methods, it supports rendering teal specific elements such as the source code, the encodings panel content and the filter panel content as part of the meta data.

Super class

teal.reporter::ReportCard -> TealReportCard

Methods

Public methods

• TealReportCard$append_src()

• TealReportCard$append_fs()

• TealReportCard$append_encodings()

• TealReportCard$clone()

Method append_src()

Appends the source code to the content meta data of this TealReportCard.

Usage

TealReportCard$append_src(src, ...)

Arguments

Returns

Object of class TealReportCard, invisibly.

Examples

card <- TealReportCard$new()$append_src(
  "plot(iris)"
)
card$get_content()[[1]]$get_content()

Method append_fs()

Appends the filter state list to the content and metadata of this TealReportCard. If the filter state list has an attribute named formatted, it appends it to the card otherwise it uses the default yaml::as.yaml to format the list. If the filter state list is empty, nothing is appended to the content.

Usage

TealReportCard$append_fs(fs)

Arguments

Returns

self, invisibly.

Method append_encodings()

Appends the encodings list to the content and metadata of this TealReportCard.

Usage

TealReportCard$append_encodings(encodings)

Arguments

Returns

self, invisibly.

Examples

card <- TealReportCard$new()$append_encodings(list(variable1 = "X"))
card$get_content()[[1]]$get_content()

Method clone()

The objects of this class are cloneable with this method.

Usage

TealReportCard$clone(deep = FALSE)

Arguments

Examples

## ------------------------------------------------
## Method `TealReportCard$append_src`
## ------------------------------------------------

card <- TealReportCard$new()$append_src(
  "plot(iris)"
)
card$get_content()[[1]]$get_content()

## ------------------------------------------------
## Method `TealReportCard$append_encodings`
## ------------------------------------------------

card <- TealReportCard$new()$append_encodings(list(variable1 = "X"))
card$get_content()[[1]]$get_content()

Description

Usage

validate_has_data(
  x,
  min_nrow = NULL,
  complete = FALSE,
  allow_inf = TRUE,
  msg = NULL
)

Arguments

Details

This function is a wrapper for shiny::validate.

Examples

library(teal)
ui <- fluidPage(
  sliderInput("len", "Max Length of Sepal",
    min = 4.3, max = 7.9, value = 5
  ),
  plotOutput("plot")
)

server <- function(input, output) {
  output$plot <- renderPlot({
    iris_df <- iris[iris$Sepal.Length <= input$len, ]
    validate_has_data(
      iris_df,
      min_nrow = 10,
      complete = FALSE,
      msg = "Please adjust Max Length of Sepal"
    )

    hist(iris_df$Sepal.Length, breaks = 5)
  })
}
if (interactive()) {
  shinyApp(ui, server)
}

Description

Usage

validate_has_elements(x, msg)

Arguments

Details

This function is a wrapper for shiny::validate.

Examples

data <- data.frame(
  id = c(1:10, 11:20, 1:10),
  strata = rep(c("A", "B"), each = 15)
)
ui <- fluidPage(
  selectInput("ref1", "Select strata1 to compare",
    choices = c("A", "B", "C"), selected = "A"
  ),
  selectInput("ref2", "Select strata2 to compare",
    choices = c("A", "B", "C"), selected = "B"
  ),
  verbatimTextOutput("arm_summary")
)

server <- function(input, output) {
  output$arm_summary <- renderText({
    sample_1 <- data$id[data$strata == input$ref1]
    sample_2 <- data$id[data$strata == input$ref2]

    validate_has_elements(sample_1, "No subjects in strata1.")
    validate_has_elements(sample_2, "No subjects in strata2.")

    paste0(
      "Number of samples in: strata1=", length(sample_1),
      " comparions strata2=", length(sample_2)
    )
  })
}
if (interactive()) {
  shinyApp(ui, server)
}

Description

Usage

validate_has_variable(data, varname, msg)

Arguments

Details

This function is a wrapper for shiny::validate.

Examples

data <- data.frame(
  one = rep("a", length.out = 20),
  two = rep(c("a", "b"), length.out = 20)
)
ui <- fluidPage(
  selectInput(
    "var",
    "Select variable",
    choices = c("one", "two", "three", "four"),
    selected = "one"
  ),
  verbatimTextOutput("summary")
)

server <- function(input, output) {
  output$summary <- renderText({
    validate_has_variable(data, input$var)
    paste0("Selected treatment variables: ", paste(input$var, collapse = ", "))
  })
}
if (interactive()) {
  shinyApp(ui, server)
}

Description

Usage

validate_in(x, choices, msg)

Arguments

Details

This function is a wrapper for shiny::validate.

Examples

ui <- fluidPage(
  selectInput(
    "species",
    "Select species",
    choices = c("setosa", "versicolor", "virginica", "unknown species"),
    selected = "setosa",
    multiple = FALSE
  ),
  verbatimTextOutput("summary")
)

server <- function(input, output) {
  output$summary <- renderPrint({
    validate_in(input$species, iris$Species, "Species does not exist.")
    nrow(iris[iris$Species == input$species, ])
  })
}
if (interactive()) {
  shinyApp(ui, server)
}

Description

Captures messages from InputValidator objects and collates them into one message passed to validate.

Usage

validate_inputs(..., header = "Some inputs require attention")

Arguments

Details

shiny::validate is used to withhold rendering of an output element until certain conditions are met and to print a validation message in place of the output element. shinyvalidate::InputValidator allows to validate input elements and to display specific messages in their respective input widgets. validate_inputs provides a hybrid solution. Given an InputValidator object, messages corresponding to inputs that fail validation are extracted and placed in one validation message that is passed to a validate/need call. This way the input validator messages are repeated in the output.

The ... argument accepts any number of InputValidator objects or a nested list of such objects. If validators are passed directly, all their messages are printed together under one (optional) header message specified by header. If a list is passed, messages are grouped by validator. The list's names are used as headers for their respective message groups. If neither of the nested list elements is named, a header message is taken from header.

Value

Returns NULL if the final validation call passes and a shiny.silent.error if it fails.

See Also

shinyvalidate::InputValidator, shiny::validate

Examples

library(shiny)
library(shinyvalidate)

ui <- fluidPage(
  selectInput("method", "validation method", c("sequential", "combined", "grouped")),
  sidebarLayout(
    sidebarPanel(
      selectInput("letter", "select a letter:", c(letters[1:3], LETTERS[4:6])),
      selectInput("number", "select a number:", 1:6),
      tags$br(),
      selectInput("color", "select a color:",
        c("black", "indianred2", "springgreen2", "cornflowerblue"),
        multiple = TRUE
      ),
      sliderInput("size", "select point size:",
        min = 0.1, max = 4, value = 0.25
      )
    ),
    mainPanel(plotOutput("plot"))
  )
)

server <- function(input, output) {
  # set up input validation
  iv <- InputValidator$new()
  iv$add_rule("letter", sv_in_set(LETTERS, "choose a capital letter"))
  iv$add_rule("number", function(x) {
    if (as.integer(x) %% 2L == 1L) "choose an even number"
  })
  iv$enable()
  # more input validation
  iv_par <- InputValidator$new()
  iv_par$add_rule("color", sv_required(message = "choose a color"))
  iv_par$add_rule("color", function(x) {
    if (length(x) > 1L) "choose only one color"
  })
  iv_par$add_rule(
    "size",
    sv_between(
      left = 0.5, right = 3,
      message_fmt = "choose a value between {left} and {right}"
    )
  )
  iv_par$enable()

  output$plot <- renderPlot({
    # validate output
    switch(input[["method"]],
      "sequential" = {
        validate_inputs(iv)
        validate_inputs(iv_par, header = "Set proper graphical parameters")
      },
      "combined" = validate_inputs(iv, iv_par),
      "grouped" = validate_inputs(list(
        "Some inputs require attention" = iv,
        "Set proper graphical parameters" = iv_par
      ))
    )

    plot(faithful$eruptions ~ faithful$waiting,
      las = 1, pch = 16,
      col = input[["color"]], cex = input[["size"]]
    )
  })
}

if (interactive()) {
  shinyApp(ui, server)
}

Description

Usage

validate_n_levels(x, min_levels = 1, max_levels = 12, var_name)

Arguments

Details

If the number of levels of x is less than min_levels or greater than max_levels the validation will fail. This function is a wrapper for shiny::validate.

Examples

data <- data.frame(
  one = rep("a", length.out = 20),
  two = rep(c("a", "b"), length.out = 20),
  three = rep(c("a", "b", "c"), length.out = 20),
  four = rep(c("a", "b", "c", "d"), length.out = 20),
  stringsAsFactors = TRUE
)
ui <- fluidPage(
  selectInput(
    "var",
    "Select variable",
    choices = c("one", "two", "three", "four"),
    selected = "one"
  ),
  verbatimTextOutput("summary")
)

server <- function(input, output) {
  output$summary <- renderText({
    validate_n_levels(data[[input$var]], min_levels = 2, max_levels = 15, var_name = input$var)
    paste0(
      "Levels of selected treatment variable: ",
      paste(levels(data[[input$var]]),
        collapse = ", "
      )
    )
  })
}
if (interactive()) {
  shinyApp(ui, server)
}

Description

Usage

validate_no_intersection(x, y, msg)

Arguments

Details

This function is a wrapper for shiny::validate.

Examples

data <- data.frame(
  id = c(1:10, 11:20, 1:10),
  strata = rep(c("A", "B", "C"), each = 10)
)

ui <- fluidPage(
  selectInput("ref1", "Select strata1 to compare",
    choices = c("A", "B", "C"),
    selected = "A"
  ),
  selectInput("ref2", "Select strata2 to compare",
    choices = c("A", "B", "C"),
    selected = "B"
  ),
  verbatimTextOutput("summary")
)

server <- function(input, output) {
  output$summary <- renderText({
    sample_1 <- data$id[data$strata == input$ref1]
    sample_2 <- data$id[data$strata == input$ref2]

    validate_no_intersection(
      sample_1, sample_2,
      "subjects within strata1 and strata2 cannot overlap"
    )
    paste0(
      "Number of subject in: reference treatment=", length(sample_1),
      " comparions treatment=", length(sample_2)
    )
  })
}
if (interactive()) {
  shinyApp(ui, server)
}

Description

Usage

validate_one_row_per_id(x, key = c("USUBJID", "STUDYID"))

Arguments

Details

This function is a wrapper for shiny::validate.

Examples

iris$id <- rep(1:50, times = 3)
ui <- fluidPage(
  selectInput(
    inputId = "species",
    label = "Select species",
    choices = c("setosa", "versicolor", "virginica"),
    selected = "setosa",
    multiple = TRUE
  ),
  plotOutput("plot")
)
server <- function(input, output) {
  output$plot <- renderPlot({
    iris_f <- iris[iris$Species %in% input$species, ]
    validate_one_row_per_id(iris_f, key = c("id"))

    hist(iris_f$Sepal.Length, breaks = 5)
  })
}
if (interactive()) {
  shinyApp(ui, server)
}