teal.widgets: Custom widgets for teal applications

Description

The teal.widgets package contains functionalities that can be used for teal module development. The package is dedicated to allow developers to extend module functionality by additional inputs and output controls.

Author(s)

Maintainer: Dawid Kaledkowski dawid.kaledkowski@roche.com

Authors:

• Pawel Rucki pawel.rucki@roche.com

• Mahmoud Hallal mahmoud.hallal@roche.com

• Nikolas Burkoff

• Maciej Nasinski

• Konrad Pagacz

• Junlue Zhao

Other contributors:

• F. Hoffmann-La Roche AG [copyright holder, funder]

See Also

Useful links:

• https://insightsengineering.github.io/teal.widgets/

• https://github.com/insightsengineering/teal.widgets

• Report bugs at https://github.com/insightsengineering/teal.widgets/issues

This function checks the plot type and applies specific modifications to the plot object based on the provided parameters.

Description

This function checks the plot type and applies specific modifications to the plot object based on the provided parameters.

Usage

apply_plot_modifications(plot_obj, plot_type, dblclicking, ranges)

Arguments

Builds a basic_table_args object

Description

This function has to be used to build an input for a basic_table_args argument. The basic_table_args argument should be a part of every module which contains any rtables object. Arguments are validated to match their rtables equivalents.

For more details see the vignette: vignette("custom-basic-table-arguments", package = "teal.widgets").

Usage

basic_table_args(...)

Arguments

Value

(basic_table_args) object.

See Also

• resolve_basic_table_args() to resolve multiple objects into one using pre-defined priorities.

• parse_basic_table_args() to parse resolved list into list of calls.

Examples

basic_table_args(subtitles = "SUBTITLE")

Creates a shiny observer handling button clicks.

Description

When the button is clicked it pop up a modal window with the text.

Usage

button_click_observer(
  click_event,
  copy_button_id,
  copied_area_id,
  modal_title,
  modal_content,
  disabled
)

Arguments

Clean brushed points

Description

Cleans and organizes output to account for NAs and remove empty rows. Wrapper around shiny::brushedPoints.

Usage

clean_brushedPoints(data, brush)

Arguments

Value

A data.frame of selected rows.

Examples

brush <- list(
  mapping = list(
    x = "AGE",
    y = "BMRKR1"
  ),
  xmin = 30, xmax = 40,
  ymin = 0.7, ymax = 10,
  direction = "xy"
)

data <- data.frame(
  STUDYID = letters[1:20],
  USUBJID = LETTERS[1:20],
  AGE = sample(25:40, size = 20, replace = TRUE),
  BMRKR1 = runif(20, min = 0, max = 12)
)
nrow(clean_brushedPoints(data, brush))
data$AGE[1:10] <- NA
nrow(clean_brushedPoints(data, brush))

Draggable Buckets

Description

A custom widget with draggable elements that can be put into buckets.

Usage

draggable_buckets(input_id, label, elements = character(), buckets)

Arguments

Details

shinyvalidate validation can be used with this widget. See example below.

Value

the HTML code comprising an instance of this widget

Examples

library(shiny)

ui <- bslib::page_fluid(
  draggable_buckets("id", "Choices #1", c("a", "b"), c("bucket1", "bucket2")),
  draggable_buckets("id2", "Choices #2", letters, c("vowels", "consonants")),
  verbatimTextOutput("out"),
  verbatimTextOutput("out2")
)
server <- function(input, output) {
  iv <- shinyvalidate::InputValidator$new()
  iv$add_rule(
    "id",
    function(data) if (length(data[["bucket1"]]) == 0) "There should be stuff in bucket 1"
  )
  iv$enable()

  observeEvent(list(input$id, input$id2), {
    print(isolate(input$id))
    print(isolate(input$id2))
  })
  output$out <- renderPrint({
    iv$is_valid()
    input$id
  })
  output$out2 <- renderPrint(input$id2)
}
if (interactive()) shinyApp(ui, server)

# With default elements in the bucket
ui <- bslib::page_fluid(
  draggable_buckets("id", "Choices #1", c("a", "b"), list(bucket1 = character(), bucket2 = c("c"))),
  verbatimTextOutput("out")
)
server <- function(input, output) {
  observeEvent(input$id, {
    print(isolate(input$id))
  })
  output$out <- renderPrint(input$id)
}
if (interactive()) shinyApp(ui, server)

Extract labels from choices basing on attributes and names

Description

Extract labels from choices basing on attributes and names

Usage

extract_choices_labels(choices, values = NULL)

Arguments

Value

(character) vector with labels

Extract raw values from choices

Description

Extract raw values from choices

Usage

extract_raw_choices(choices, sep)

Arguments

Value

choices simplified

Formats the content of the modal popup window.

Description

Formats the content of the modal popup window.

Usage

format_content(verbatim_content, style = FALSE)

Arguments

Details

Formats the content:

• concatenates if needed

• styles if style is TRUE

Value

reactive with the formatted content

Map lenghtMenu property

Description

Maps the lengthMenu selected value property of DT::datatable to a shiny variable.

Usage

get_dt_rows(dt_name, dt_rows)

Arguments

Value

(shiny::tagList) A ⁠shiny tagList⁠.

Examples

library(shiny)
library(DT)

ui <- function(id) {
  ns <- NS(id)
  tagList(
    get_dt_rows(ns("data_table"), ns("dt_rows")),
    textOutput(ns("rows")),
    DT::DTOutput(ns("data_table"))
  )
}

# use the input$dt_rows in the Shiny Server function
server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$data_table <- DT::renderDataTable(iris)
    # Change rows selected to see the first line on the UI change
    rows <- reactive({
      paste0("Selected Rows ", input$dt_rows)
    })
    output$rows <- renderText(rows())
  })
}
if (interactive()) {
  shinyApp(
    ui = ui("my_table_module"),
    server = function(input, output, session) server("my_table_module")
  )
}

Creates ggplot2_args object

Description

Constructor of ggplot2_args class of objects. The ggplot2_args argument should be a part of every module which contains any ggplot2 graphics. The function arguments are validated to match their ggplot2 equivalents.

For more details see the vignette: vignette("custom-ggplot2-arguments", package = "teal.widgets").

Usage

ggplot2_args(labs = list(), theme = list())

Arguments

Value

(ggplot2_args) object.

See Also

• resolve_ggplot2_args() to resolve multiple objects into one using pre-defined priorities.

• parse_ggplot2_args() to parse resolved list into list of calls.

Examples

ggplot2_args(
  labs = list(title = "TITLE"),
  theme = list(title = ggplot2::element_text(size = 20))
)

Nested Closeable Modal Popup

Description

Alternative to shiny::modalDialog. Create a nested modal popup that can be shown/hidden using jQuery and modal id, without disturbing the parent modal.

Usage

nested_closeable_modal(id, ..., modal_args = list(easyClose = TRUE))

Arguments

Value

(shiny.tag) returns HTML for shiny module UI which can be nested into a modal popup

Examples

library(shiny)
library(shinyjs)

ui <- bslib::page_fluid(
  useShinyjs(),
  actionButton("show_1", "$(\"#modal_1\").modal(\"show\")"),
  nested_closeable_modal(
    "modal_1",
    modal_args = list(
      size = "l",
      title = "First Modal",
      easyClose = TRUE,
      footer = NULL
    ),
    tags$div(
      "This modal can be closed by running", tags$code("$(\"#modal_1\").modal(\"hide\")"),
      "in the JS console!",
      tags$br(),
      "Note that the second modal is placed right within this modal",
      tags$br(),
      "Alternatively, calling the", tags$code("removeModal()"),
      "will remove all the active modal popups",
      tags$br(), tags$br(),
      actionButton("show_2", "$(\"#modal_2\").modal(\"show\")"),
      actionButton("hide_1", "$(\"#modal_1\").modal(\"hide\")"),
      nested_closeable_modal(
        id = "modal_2",
        modal_args = list(
          size = "m",
          title = "Second Modal",
          footer = NULL,
          easyClose = TRUE
        ),
        tags$div(
          "This modal can be closed by running", tags$code("$(\"#modal_1\").modal(\"hide\")"),
          "in the JS console!",
          "Note that removing the parent will remove the child.
           But, reopening will remember the open state of child",
          actionButton("hide_2", "$(\"#modal_2\").modal(\"hide\")"),
          actionButton("hide_all", "$(\"#modal_1\").modal(\"hide\")")
        )
      )
    )
  )
)

server <- function(input, output) {
  observeEvent(input$show_1, {
    runjs("$(\"#modal_1\").modal(\"show\")")
  })
  observeEvent(input$show_2, {
    runjs("$(\"#modal_2\").modal(\"show\")")
  })
  observeEvent(c(input$hide_1, input$hide_all), {
    runjs("$(\"#modal_1\").modal(\"hide\")")
  })
  observeEvent(input$hide_2, {
    runjs("$(\"#modal_2\").modal(\"hide\")")
  })
}

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

Wrapper for pickerInput

Description

Wrapper for shinyWidgets::pickerInput() with additional features. When fixed = TRUE or when the number of choices is less or equal to 1 (see fixed_on_single), the pickerInput widget is hidden and non-interactive widget will be displayed instead. Toggle of HTML elements is just the visual effect to avoid displaying pickerInput widget when there is only one choice.

Usage

optionalSelectInput(
  inputId,
  label = NULL,
  choices = NULL,
  selected = NULL,
  multiple = FALSE,
  sep = NULL,
  options = list(),
  label_help = NULL,
  fixed = FALSE,
  fixed_on_single = FALSE,
  width = NULL
)

updateOptionalSelectInput(
  session,
  inputId,
  label = NULL,
  selected = NULL,
  choices = NULL
)

Arguments

Value

(shiny.tag) HTML tag with pickerInput widget and non-interactive element listing selected values.

Examples

library(shiny)

ui_grid <- function(...) {
  bslib::page_fluid(
    bslib::layout_columns(
      col_widths = c(4, 4, 4),
      ...
    )
  )
}

ui <- ui_grid(
  wellPanel(
    optionalSelectInput(
      inputId = "c1",
      label = "Fixed choices",
      choices = LETTERS[1:5],
      selected = c("A", "B"),
      fixed = TRUE
    ),
    verbatimTextOutput(outputId = "c1_out")
  ),
  wellPanel(
    optionalSelectInput(
      inputId = "c2",
      label = "Single choice",
      choices = "A",
      selected = "A"
    ),
    verbatimTextOutput(outputId = "c2_out")
  ),
  wellPanel(
    optionalSelectInput(
      inputId = "c3",
      label = "NULL choices",
      choices = NULL
    ),
    verbatimTextOutput(outputId = "c3_out")
  ),
  wellPanel(
    optionalSelectInput(
      inputId = "c4",
      label = "Default",
      choices = LETTERS[1:5],
      selected = "A"
    ),
    verbatimTextOutput(outputId = "c4_out")
  ),
  wellPanel(
    optionalSelectInput(
      inputId = "c5",
      label = "Named vector",
      choices = c(`A - value A` = "A", `B - value B` = "B", `C - value C` = "C"),
      selected = "A"
    ),
    verbatimTextOutput(outputId = "c5_out")
  ),
  wellPanel(
    selectInput(
      inputId = "c6_choices", label = "Update choices", choices = letters, multiple = TRUE
    ),
    optionalSelectInput(
      inputId = "c6",
      label = "Updated choices",
      choices = NULL,
      multiple = TRUE,
      fixed_on_single = TRUE
    ),
    verbatimTextOutput(outputId = "c6_out")
  )
)

server <- function(input, output, session) {
  observeEvent(input$c6_choices, ignoreNULL = FALSE, {
    updateOptionalSelectInput(
      session = session,
      inputId = "c6",
      choices = input$c6_choices,
      selected = input$c6_choices
    )
  })

  output$c1_out <- renderPrint(input$c1)
  output$c2_out <- renderPrint(input$c2)
  output$c3_out <- renderPrint(input$c3)
  output$c4_out <- renderPrint(input$c4)
  output$c5_out <- renderPrint(input$c5)
  output$c6_out <- renderPrint(input$c6)
}

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

Optional Slider Input Widget

Description

Hidden input widgets are useful to have the input[[inputId]] variable on available in the server function but no corresponding visual clutter from input widgets that provide only a single choice.

Usage

optionalSliderInput(inputId, label, min, max, value, label_help = NULL, ...)

Arguments

Details

if min or max are NA then the slider widget will be hidden

Value

(shiny.tag) HTML tag with sliderInput widget.

Examples

ui <- bslib::page_fluid(
  shinyjs::useShinyjs(),
  optionalSliderInput("s", "shown", 0, 1, 0.2),
  optionalSliderInput("h", "hidden", 0, NA, 1),
)
if (interactive()) {
  shiny::shinyApp(ui, function(input, output) {})
}

Optional Slider Input with minimal and maximal values

Description

The optionalSliderInput() function needs three arguments to determine whether to hide the sliderInput widget or not. For teal modules we specify an optional slider input with one argument here called value_min_max.

Usage

optionalSliderInputValMinMax(
  inputId,
  label,
  value_min_max,
  label_help = NULL,
  ...
)

Arguments

Details

For teal modules we parameterize an optionalSliderInput with one argument value_min_max

Value

(shiny.tag) HTML tag with range sliderInput widget.

Examples

ui <- bslib::page_fluid(
  shinyjs::useShinyjs(),
  optionalSliderInputValMinMax("a1", "b1", 1), # Hidden
  optionalSliderInputValMinMax("a2", "b2", c(3, 1, 5)) # Shown
)
if (interactive()) {
  shiny::shinyApp(ui, function(input, output) {})
}

Panel group widget

Description

Designed to group panel_item elements. Used to handle shiny inputs in the encoding panel.

Usage

panel_group(..., id = NULL)

Arguments

Value

(shiny.tag)

Examples

library(shiny)
panel_group(
  panel_item(
    title = "Display",
    collapsed = FALSE,
    checkboxGroupInput(
      "check",
      "Tables display",
      choices = LETTERS[1:3],
      selected = LETTERS[1]
    ),
    radioButtons(
      "radio",
      label = "Plot type",
      choices = letters[1:2],
      selected = letters[1]
    )
  ),
  panel_item(
    title = "Pre-processing",
    radioButtons(
      "filtering",
      "What to filter",
      choices = LETTERS[1:4],
      selected = LETTERS[1]
    ),
    radioButtons(
      "na_action",
      "NA action",
      choices = letters[1:3],
      selected = letters[1]
    )
  )
)

Panel item widget

Description

Designed to be grouped using panel_group element. Used to handle shiny inputs in the encoding panel.

Usage

panel_item(title, ..., collapsed = TRUE, input_id = NULL)

Arguments

Value

(shiny.tag)

Examples

library(shiny)
panel_item(
  title = "Display",
  collapsed = FALSE,
  checkboxGroupInput(
    "check",
    "Tables display",
    choices = LETTERS[1:3],
    selected = LETTERS[1]
  ),
  radioButtons(
    "radio",
    label = "Plot type",
    choices = letters[1:2],
    selected = letters[1]
  )
)

Parses basic_table_args object into the basic_table expression

Description

A function to parse expression from the basic_table_args object.

Usage

parse_basic_table_args(basic_table_args = teal.widgets::basic_table_args())

Arguments

Value

(language) the rtables::basic_table() filled with additional arguments.

Examples

parse_basic_table_args(
  resolve_basic_table_args(
    user_table = basic_table_args(title = "TITLE"),
    user_default = basic_table_args(title = "DEFAULT_TITLE", subtitles = "SUBTITLE")
  )
)

Parse ggplot2_args object into the ggplot2 expression

Description

A function to parse expression from the ggplot2_args object.

Usage

parse_ggplot2_args(
  ggplot2_args = teal.widgets::ggplot2_args(),
  ggtheme = c("default", "gray", "bw", "linedraw", "light", "dark", "minimal", "classic",
    "void", "test")
)

Arguments

Value

(list) of up to three elements of class languange: "labs", "ggtheme" and "theme".

Examples

parse_ggplot2_args(
  resolve_ggplot2_args(ggplot2_args(
    labs = list(title = "TITLE"),
    theme = list(title = ggplot2::element_text(size = 20))
  ))
)

parse_ggplot2_args(
  resolve_ggplot2_args(
    ggplot2_args(
      labs = list(title = "TITLE"),
      theme = list(title = ggplot2::element_text(size = 20))
    )
  ),
  ggtheme = "gray"
)

Create choicesOpt for pickerInput

Description

Create choicesOpt for pickerInput

Usage

picker_options(choices)

Arguments

Value

(list)
to be passed as choicesOpt argument.

Optional content for optionalSelectInput

Description

Prepares content to be displayed in optionalSelectInput with icons and labels

Usage

picker_options_content(var_name, var_label, var_type)

Arguments

Value

(character) HTML contents with all elements combined

Plot-with-settings module

Description

Universal module for plots with settings for height, width, and download.

Usage

plot_with_settings_ui(id)

plot_with_settings_srv(
  id,
  plot_r,
  height = c(600, 200, 2000),
  width = NULL,
  show_hide_signal = reactive(TRUE),
  brushing = FALSE,
  clicking = FALSE,
  dblclicking = FALSE,
  hovering = FALSE,
  graph_align = "left"
)

Arguments

Details

By default the plot is rendered with ⁠72 dpi⁠. In order to change this, to for example 96 set options(teal.plot_dpi = 96). The minimum allowed dpi value is 24 and it must be a whole number. If an invalid value is set then the default value is used and a warning is outputted to the console.

Value

A shiny module.

Examples

# Example using a reactive as input to plot_r
library(shiny)
library(ggplot2)

ui <- bslib::page_fluid(
  plot_with_settings_ui(
    id = "plot_with_settings"
  )
)

server <- function(input, output, session) {
  plot_r <- reactive({
    ggplot(faithful, aes(x = .data$waiting, y = .data$eruptions)) +
      geom_point()
  })

  plot_with_settings_srv(
    id = "plot_with_settings",
    plot_r = plot_r,
    height = c(400, 100, 1200),
    width = c(500, 250, 750)
  )
}

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

# Example using a function as input to plot_r
library(lattice)

ui <- bslib::page_fluid(
  radioButtons("download_option", "Select the Option", list("ggplot", "trellis", "grob", "base")),
  plot_with_settings_ui(
    id = "plot_with_settings"
  ),
  sliderInput("nums", "Value", 1, 10, 1)
)

server <- function(input, output, session) {
  plot_r <- function() {
    numbers <- seq_len(input$nums)
    if (input$download_option == "ggplot") {
      ggplot(data.frame(n = numbers), aes(.data$n)) +
        geom_bar()
    } else if (input$download_option == "trellis") {
      densityplot(numbers)
    } else if (input$download_option == "grob") {
      tr_plot <- densityplot(numbers)
      ggplotGrob(
        ggplot(data.frame(n = numbers), aes(.data$n)) +
          geom_bar()
      )
    } else if (input$download_option == "base") {
      plot(numbers)
    }
  }

  plot_with_settings_srv(
    id = "plot_with_settings",
    plot_r = plot_r,
    height = c(400, 100, 1200),
    width = c(500, 250, 750)
  )
}

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

# Example with brushing/hovering/clicking/double-clicking
ui <- bslib::page_fluid(
  plot_with_settings_ui(
    id = "plot_with_settings"
  ),
  fluidRow(
    column(4, tags$h3("Brush"), verbatimTextOutput("brushing_data")),
    column(4, tags$h3("Click"), verbatimTextOutput("clicking_data")),
    column(4, tags$h3("DblClick"), verbatimTextOutput("dblclicking_data")),
    column(4, tags$h3("Hover"), verbatimTextOutput("hovering_data"))
  )
)

server <- function(input, output, session) {
  plot_r <- reactive({
    ggplot(faithful, aes(x = .data$waiting, y = .data$eruptions)) +
      geom_point()
  })

  plot_data <- plot_with_settings_srv(
    id = "plot_with_settings",
    plot_r = plot_r,
    height = c(400, 100, 1200),
    brushing = TRUE,
    clicking = TRUE,
    dblclicking = TRUE,
    hovering = TRUE
  )

  output$brushing_data <- renderPrint(plot_data$brush())
  output$clicking_data <- renderPrint(plot_data$click())
  output$dblclicking_data <- renderPrint(plot_data$dblclick())
  output$hovering_data <- renderPrint(plot_data$hover())
}

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

# Example which allows module to be hidden/shown
library("shinyjs")

ui <- bslib::page_fluid(
  useShinyjs(),
  actionButton("button", "Show/Hide"),
  plot_with_settings_ui(
    id = "plot_with_settings"
  )
)

server <- function(input, output, session) {
  plot_r <- plot_r <- reactive(
    ggplot(faithful, aes(x = .data$waiting, y = .data$eruptions)) +
      geom_point()
  )

  show_hide_signal_rv <- reactiveVal(TRUE)

  observeEvent(input$button, show_hide_signal_rv(!show_hide_signal_rv()))

  plot_with_settings_srv(
    id = "plot_with_settings",
    plot_r = plot_r,
    height = c(400, 100, 1200),
    width = c(500, 250, 750),
    show_hide_signal = reactive(show_hide_signal_rv())
  )
}

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

Print plot for download functionality

Description

Print plot for download functionality

Usage

print_plot(plot, plot_type)

Arguments

Value

Nothing returned, the plot is printed.

Resolves and reduces multiple basic_table_args objects

Description

Resolving and reducing multiple basic_table_args objects. This function is intended to utilize user provided settings, defaults provided by the module creator and also teal option. See Details, below, to understand the logic.

Usage

resolve_basic_table_args(
  user_table = basic_table_args(),
  user_default = basic_table_args(),
  module_table = basic_table_args(),
  app_default = getOption("teal.basic_table_args", basic_table_args())
)

Arguments

Details

The function picks the first non NULL value for each argument, checking in the following order:

1. basic_table_args argument provided by the end user. Per table (user_table) and then default (user_default) setup.

2. app_default global R variable, teal.basic_table_args.

3. module_table which is a module creator setup.

Value

basic_table_args object.

See Also

parse_basic_table_args() to parse resolved list into list of calls.

Examples

resolve_basic_table_args(
  user_table = basic_table_args(title = "TITLE"),
  user_default = basic_table_args(title = "DEFAULT_TITLE", subtitles = "SUBTITLE")
)

Resolving and reducing multiple ggplot2_args objects

Description

Resolving and reducing multiple ggplot2_args objects. This function is intended to utilize user provided settings, defaults provided by the module creator and also teal option. See Details, below, to understand the logic.

Usage

resolve_ggplot2_args(
  user_plot = ggplot2_args(),
  user_default = ggplot2_args(),
  module_plot = ggplot2_args(),
  app_default = getOption("teal.ggplot2_args", ggplot2_args())
)

Arguments

Details

The function picks the first non NULL value for each argument, checking in the following order:

1. ggplot2_args argument provided by the end user. Per plot (user_plot) and then default (user_default) setup.

2. app_default global R variable, teal.ggplot2_args.

3. module_plot which is a module creator setup.

Value

ggplot2_args object.

See Also

parse_ggplot2_args() to parse resolved list into list of calls.

Examples

resolve_ggplot2_args(
  user_plot = ggplot2_args(
    labs = list(title = "TITLE"),
    theme = list(title = ggplot2::element_text(size = 20))
  ),
  user_default = ggplot2_args(
    labs = list(x = "XLAB")
  )
)

Standard UI layout

Description

Create a standard UI layout with output on the right and an encoding panel on the left. This is the layout used by the teal modules.

Usage

standard_layout(
  output,
  encoding = NULL,
  forms = NULL,
  pre_output = NULL,
  post_output = NULL
)

Arguments

Value

an object of class shiny.tag with the UI code.

Examples

library(shiny)
standard_layout(
  output = white_small_well(tags$h3("Tests")),
  encoding = tags$div(
    tags$label("Encodings", class = "text-primary"),
    panel_item(
      "Tests",
      optionalSelectInput(
        "tests",
        "Tests:",
        choices = c(
          "Shapiro-Wilk",
          "Kolmogorov-Smirnov (one-sample)"
        ),
        selected = "Shapiro-Wilk"
      )
    )
  ),
  forms = tagList(
    verbatim_popup_ui("warning", "Show Warnings"),
    verbatim_popup_ui("rcode", "Show R code")
  )
)

table_with_settings module

Description

Module designed to create a shiny table output based on rtable object (ElementaryTable or TableTree) input.

Usage

table_with_settings_ui(id, ...)

table_with_settings_srv(id, table_r, show_hide_signal = reactive(TRUE))

Arguments

Value

A shiny module.

Examples

library(shiny)
library(rtables)
library(magrittr)

ui <- bslib::page_fluid(
  table_with_settings_ui(
    id = "table_with_settings"
  )
)

server <- function(input, output, session) {
  table_r <- reactive({
    l <- basic_table() %>%
      split_cols_by("ARM") %>%
      analyze(c("SEX", "AGE"))

    tbl <- build_table(l, DM)

    tbl
  })

  table_with_settings_srv(id = "table_with_settings", table_r = table_r)
}

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

Get icons to represent variable types in dataset

Description

Get icons to represent variable types in dataset

Usage

variable_type_icons(var_type)

Arguments

Value

(character)
vector of HTML icons corresponding to data type in each column.

A shiny module that pops up verbatim text.

Description

This module consists of a button that once clicked pops up a modal window with verbatim-styled text.

Usage

verbatim_popup_ui(id, button_label, type = c("button", "link"), ...)

verbatim_popup_srv(
  id,
  verbatim_content,
  title,
  style = FALSE,
  disabled = shiny::reactiveVal(FALSE)
)

Arguments

Value

the UI function returns a shiny.tag.list object

Examples

library(shiny)

ui <- bslib::page_fluid(verbatim_popup_ui("my_id", button_label = "Open popup"))
srv <- function(input, output) {
  verbatim_popup_srv(
    "my_id",
    "if (TRUE) { print('Popups are the best') }",
    title = "My custom title",
    style = TRUE
  )
}
if (interactive()) shinyApp(ui, srv)

Small well class for HTML

Description

Adds Small Well class and overflow-x property to HTML output element.

Usage

white_small_well(...)

Arguments

Details

white_small_well is intended to be used with shiny::uiOutput(). The overflow-x property is set to auto so that a scroll bar is added when the content overflows at the left and right edges of the output window. For example, this is useful for displaying wide tables.

Value

An HTML output element with class Small Well and overflow-x property

Examples

white_small_well(shiny::htmlOutput("summary"))