teal.transform: Functions for extracting and merging data in the teal framework

Description

A standardized user interface for column selection, that facilitates dataset merging in 'teal' framework.

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.transform/

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

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

R6 Class - A First-In-First-Out Abstract Data Type

Description

Abstract data type that stores and returns any number of elements.

Details

A Queue object stores all elements in a single vector, thus all data types can be stored, but silent coercion may occur.

Elements are returned in the same order that they were added.

Methods

Public methods

• Queue$push()

• Queue$get()

• Queue$pop()

• Queue$remove()

• Queue$empty()

• Queue$size()

• Queue$print()

• Queue$clone()

Method push()

Adds element(s) to Queue.

Usage

Queue$push(new_elements)

Arguments

Returns

self, invisibly.

Method get()

Returns all contents of the Queue object.

Usage

Queue$get()

Returns

Single vector containing all Queue contents.

Method pop()

Returns the first (oldest) element of the Queue and removes it.

Usage

Queue$pop()

Returns

vector of length 1 containing the first element of Queue or NULL if Queue is empty.

Method remove()

Removes the oldest occurrence of specified element(s) from Queue. Relies on implicit type conversions of R identify elements to remove.

Usage

Queue$remove(elements)

Arguments

Returns

self, invisibly.

Method empty()

Removes all elements from Queue.

Usage

Queue$empty()

Returns

self, invisibly.

Method size()

Returns the number of elements in Queue.

Usage

Queue$size()

Returns

integer(1).

Method print()

Prints this Queue.

Usage

Queue$print(...)

Arguments

Returns

self, invisibly.

Method clone()

The objects of this class are cloneable with this method.

Usage

Queue$clone(deep = FALSE)

Arguments

Add empty choice to choices selected

Description

Usage

add_no_selected_choices(x, multiple = FALSE)

Arguments

Value

choices_selected object with an empty option added to the choices.

Checks whether the provided slices have the corresponding join keys

Description

Checks whether the provided slices have the corresponding join keys

Usage

are_needed_keys_provided(join_keys, merged_selector_list)

Arguments

Value

TRUE if all pairs of the slices have the corresponding keys and FALSE otherwise.

Note

merged_selector_list contains a list of descriptions of data frame slices; each coming from a single dataset. This function checks whether all pairs of the datasets have the join keys needed to merge the slices.

Checks varname argument and convert to call

Description

Checks varname type and parse if it's a character.

Usage

call_check_parse_varname(varname)

Arguments

Value

the parsed varname.

Choices condition call

Description

Compose choices condition call from inputs.

Usage

call_condition_choice(varname, choices)

Arguments

Details

choices can be vector of any type but for some output might be converted:

• factor call is composed on choices converted to character;

• Date call is composed on choices converted to character using format(choices);

• POSIXct, POSIXlt call is composed on choices converted to character using format(choices).

One has to be careful here as formatted date-time variable might loose some precision (see format argument in format.POSIXlt() and output call could be insufficient for exact comparison. In this case one should specify ⁠varname = trunc(<varname>)⁠ and possibly convert choices to character).

Value

call.

logical variable condition call

Description

Compose logical variable condition call from inputs.

Usage

call_condition_logical(varname, choice)

Arguments

Value

call.

numeric range condition call

Description

Compose numeric range condition call from inputs.

Usage

call_condition_range(varname, range)

Arguments

Value

call.

Date range condition call

Description

Compose Date range condition call from inputs.

Usage

call_condition_range_date(varname, range)

Arguments

Value

call.

POSIXct range condition call

Description

Compose POSIXct range condition call from inputs.

Usage

call_condition_range_posixct(varname, range, timezone = Sys.timezone())

Arguments

Value

call.

Get call to subset and select array

Description

Get call to subset and select array

Usage

call_extract_array(dataname = ".", row = NULL, column = NULL, aisle = NULL)

Arguments

Value

Extract() call for 3-dimensional array in x[i, j, k] notation.

Compose extract call with $ operator

Description

Compose extract call with $ operator

Usage

call_extract_list(dataname, varname, dollar = TRUE)

Arguments

Value

Extract() call in $ or [[ notation (depending on parameters).

Get call to subset and select matrix

Description

Get call to subset and select matrix

Usage

call_extract_matrix(dataname = ".", row = NULL, column = NULL)

Arguments

Value

Extract() call for matrix in x[i, j] notation.

Create a call using a function in a given namespace

Description

The dot arguments in ... need to be quoted because they will be evaluated otherwise.

Usage

call_with_colon(name, ..., unlist_args = list())

Arguments

Value

call.

Combine calls by operator

Description

Combine list of calls by specific operator.

Usage

calls_combine_by(operator, calls)

Arguments

Value

A combined call.

Check data extract specification

Description

Check data extract specification

Usage

check_data_extract_spec(data_extract_spec)

Arguments

Value

Raises an error when check fails, otherwise, it returns the data_extract_spec parameter, invisibly and unchanged.

Function to check data_extract_specs

Description

Checks if dataname argument exists as a dataset. Checks if selected or filter columns exist within the datasets. Throws a shiny validation error if the above requirements are not met.

Usage

check_data_extract_spec_react(datasets, data_extract)

Arguments

Value

NULL.

Validate data_extracts in merge_datasets

Description

Validate selected inputs from data_extract before passing to data_merge to avoid dplyr errors or unexpected results.

Usage

check_data_merge_selectors(selector_list)

Arguments

Value

NULL if check is successful and shiny validate error otherwise.

Check if the merge function is valid

Description

Check if the merge function is valid

Usage

check_merge_function(merge_function)

Arguments

Value

Raises an error when check fails, otherwise, it returns NULL, invisibly.

Checks that the extract_input specification does not allow multiple selection

Description

Usage

check_no_multiple_selection(extract_input)

Arguments

Details

Stops if condition not met.

Value

Raises an error when check fails, otherwise, it returns NULL, invisibly.

Check selector

Description

Check selector

Usage

check_selector(selector)

Arguments

Value

Raises an error when check fails, otherwise, it returns the selector parameter, invisibly and unchanged.

Check selector dataname element

Description

Check selector dataname element

Usage

check_selector_dataname(dataname)

Arguments

Value

Raises an error when check fails, otherwise, it returns the dataname parameter, invisibly and unchanged.

Check selector filters element

Description

Check selector filters element

Usage

check_selector_filters(filters)

Arguments

Value

Raises an error when the check fails, otherwise it returns NULL, invisibly.

Check selector internal_id element

Description

Check selector internal_id element

Usage

check_selector_internal_id(internal_id)

Arguments

Value

Raises an error when check fails, otherwise, it returns the internal_id parameter, invisibly and unchanged.

Check selector keys element

Description

Check selector keys element

Usage

check_selector_keys(keys)

Arguments

Value

Raises an error when check fails, otherwise, it returns the keys parameter, invisibly and unchanged.

Check selector reshape element

Description

Check selector reshape element

Usage

check_selector_reshape(reshape)

Arguments

Value

Raises an error when check fails, otherwise, it returns the reshape parameter, invisibly and unchanged.

Check selector select element

Description

Check selector select element

Usage

check_selector_select(select)

Arguments

Value

Raises an error when check fails, otherwise, it returns the select parameter, invisibly and unchanged.

Set "⁠<choice>:<label>⁠" type of names

Description

This is often useful for choices_selected() as it marks up the drop-down boxes for shiny::selectInput().

Usage

choices_labeled(choices, labels, subset = NULL, types = NULL)

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

Arguments

Details

If either choices or labels are factors, they are coerced to character. Duplicated elements from choices get removed.

Value

Named character vector.

Methods (by generic)

• print(choices_labeled): Print choices_labeled object

Examples

library(teal.data)
library(shiny)

ADSL <- rADSL
ADTTE <- rADTTE

choices1 <- choices_labeled(names(ADSL), col_labels(ADSL, fill = FALSE))
choices2 <- choices_labeled(ADTTE$PARAMCD, ADTTE$PARAM)

# if only a subset of variables are needed, use subset argument
choices3 <- choices_labeled(
  names(ADSL),
  col_labels(ADSL, fill = FALSE),
  subset = c("ARMCD", "ARM")
)

ui <- fluidPage(
  selectInput("c1",
    label = "Choices from ADSL",
    choices = choices1,
    selected = choices1[1]
  ),
  selectInput("c2",
    label = "Choices from ADTTE",
    choices = choices2,
    selected = choices2[1]
  ),
  selectInput("c3",
    label = "Arm choices from ADSL",
    choices = choices3,
    selected = choices3[1]
  )
)
server <- function(input, output) {}

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

Choices selected

Description

Construct a single list containing available choices, the default selected value, and additional settings such as to order the choices with the selected elements appearing first or whether to block the user from making selections.

Can be used in UI input elements such as teal.widgets::optionalSelectInput().

Usage

choices_selected(
  choices,
  selected = if (inherits(choices, "delayed_data")) NULL else choices[1],
  keep_order = FALSE,
  fixed = FALSE
)

is.choices_selected(x)

Arguments

Details

Please note that the order of selected will always follow the order of choices. The keep_order argument is set to false which will run the following code inside:

choices <- c(selected, setdiff(choices, selected))

In case you want to keep your specific order of choices, set keep_order to TRUE.

Value

choices_selected returns list of choices_selected, encapsulating the specified choices, selected, keep_order and fixed.

is.choices_selected returns TRUE if x inherits from a choices_selected object, FALSE otherwise.

Functions

• is.choices_selected(): Check if an object is a choices_selected class

Examples

library(shiny)
library(teal.widgets)

ADSL <- teal.data::rADSL
choices_selected(variable_choices(ADSL), "SEX")

# How to select nothing
# use an empty character
choices_selected(
  choices = c("", "A", "B", "C"),
  selected = ""
)

# How to allow the user to select nothing
# use an empty character
choices_selected(
  choices = c("A", "", "B", "C"),
  selected = "A"
)


# How to make Nothing the Xth choice
# just use keep_order
choices_selected(
  choices = c("A", "", "B", "C"),
  selected = "A",
  keep_order = TRUE
)


# How to give labels to selections
# by adding names - choices will be replaced by "name" in UI, not in code
choices_selected(
  choices = c("name for A" = "A", "Name for nothing" = "", "name for b" = "B", "name for C" = "C"),
  selected = "A"
)

# by using choices_labeled
# labels will be shown behind the choice
choices_selected(
  choices = choices_labeled(
    c("A", "", "B", "C"),
    c("name for A", "nothing", "name for B", "name for C")
  ),
  selected = "A"
)

# Passing a `delayed_data` object to `selected`
choices_selected(
  choices = variable_choices("ADSL"),
  selected = variable_choices("ADSL", subset = c("STUDYID"))
)

# Passing `delayed_choices` object - semantically identical objects:
choices_selected(choices = letters, selected = letters)
choices_selected(choices = letters, selected = all_choices())

choices_selected(
  choices = setNames(LETTERS[1:5], paste("Letter", LETTERS[1:5])),
  selected = "E"
)
choices_selected(
  choices = setNames(LETTERS[1:5], paste("Letter", LETTERS[1:5])),
  selected = last_choice()
)

# functional form (subsetting for factor variables only) of choices_selected
# with delayed data loading
choices_selected(variable_choices("ADSL", subset = function(data) {
  idx <- vapply(data, is.factor, logical(1))
  names(data)[idx]
}))

cs <- choices_selected(
  choices = c("A", "B", "C"),
  selected = "A"
)

ui <- fluidPage(
  optionalSelectInput(
    inputId = "id",
    choices = cs$choices,
    selected = cs$selected
  )
)

server <- function(input, output, session) {}
if (interactive()) {
  shinyApp(ui, server)
}

Function to compose validators from data_extract_multiple_srv

Description

This function takes the output from data_extract_multiple_srv and collates the shinyvalidate::InputValidators returned into a single validator and enables this.

Usage

compose_and_enable_validators(iv, selector_list, validator_names = NULL)

Arguments

Value

(shinyvalidate::InputValidator) enabled iv with appropriate validators added into it.

Examples

library(shiny)
library(shinyvalidate)
library(shinyjs)
library(teal.widgets)

iris_extract <- data_extract_spec(
  dataname = "iris",
  select = select_spec(
    label = "Select variable:",
    choices = variable_choices(iris, colnames(iris)),
    selected = "Sepal.Length",
    multiple = TRUE,
    fixed = FALSE
  )
)

data_list <- list(iris = reactive(iris))

ui <- fluidPage(
  useShinyjs(),
  standard_layout(
    output = verbatimTextOutput("out1"),
    encoding = tagList(
      data_extract_ui(
        id = "x_var",
        label = "Please select an X column",
        data_extract_spec = iris_extract
      ),
      data_extract_ui(
        id = "y_var",
        label = "Please select a Y column",
        data_extract_spec = iris_extract
      ),
      data_extract_ui(
        id = "col_var",
        label = "Please select a color column",
        data_extract_spec = iris_extract
      )
    )
  )
)

server <- function(input, output, session) {
  selector_list <- data_extract_multiple_srv(
    list(x_var = iris_extract, y_var = iris_extract, col_var = iris_extract),
    datasets = data_list,
    select_validation_rule = list(
      x_var = sv_required("Please select an X column"),
      y_var = compose_rules(
        sv_required("Exactly 2 'Y' column variables must be chosen"),
        function(x) if (length(x) != 2) "Exactly 2 'Y' column variables must be chosen"
      )
    )
  )
  iv_r <- reactive({
    iv <- InputValidator$new()
    compose_and_enable_validators(
      iv,
      selector_list,
      # if validator_names = NULL then all validators are used
      # to turn on only "x_var" then set this argument to "x_var"
      validator_names = NULL
    )
  })

  output$out1 <- renderPrint({
    if (iv_r()$is_valid()) {
      ans <- lapply(selector_list(), function(x) {
        cat(format_data_extract(x()), "\n\n")
      })
    } else {
      "Check that you have made a valid selection"
    }
  })
}

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

Creates a panel that displays (with filter and column selection) conditionally on input[ns("dataset")] == dataname

Description

Creates a panel that displays (with filter and column selection) conditionally on input[ns("dataset")] == dataname

Usage

cond_data_extract_single_ui(ns, single_data_extract_spec)

Arguments

Value

shiny.tag with the HTML code for the panel.

Ensures datasets is a list of reactive expression

Description

Ensures datasets is a list of reactive expression

Usage

convert_teal_data(datasets)

Arguments

Value

List of reactive expressions that contains all the individual datasets.

Handles events emitted from the UI generated by data_extract_filter_ui

Description

Handles events emitted from the UI generated by data_extract_filter_ui

Usage

data_extract_filter_srv(id, datasets, filter)

Arguments

Value

NULL, invisibly.

Note

This shiny module server updates the values of the vals teal.widgets::optionalSelectInput() widget. It's responsible for setting the initial values and the subsequent updates to the vals widget based on the input of the col widget.

Returns a shiny.tag object with the UI for a filter_spec object

Description

Returns a shiny.tag object with the UI for a filter_spec object

Usage

data_extract_filter_ui(filter, id = "filter")

Arguments

Details

Creates two optionSelectInput elements (one for column and one for values) based on a definition of a filter_spec() object.

Value

shiny.tag defining the filter_spec's UI element.

Creates a named list of data_extract_srv output

Description

data_extract_multiple_srv loops over the list of data_extract given and runs data_extract_srv for each one returning a list of reactive objects.

Usage

data_extract_multiple_srv(data_extract, datasets, ...)

## S3 method for class 'reactive'
data_extract_multiple_srv(data_extract, datasets, ...)

## S3 method for class 'FilteredData'
data_extract_multiple_srv(data_extract, datasets, ...)

## S3 method for class 'list'
data_extract_multiple_srv(
  data_extract,
  datasets,
  join_keys = NULL,
  select_validation_rule = NULL,
  filter_validation_rule = NULL,
  dataset_validation_rule = if (is.null(select_validation_rule) &&
    is.null(filter_validation_rule)) {
     NULL
 } else {
    
    shinyvalidate::sv_required("Please select a dataset")
 },
  ...
)

Arguments

Value

reactive named list containing outputs from data_extract_srv(). Output list names are the same as data_extract input argument.

Examples

library(shiny)
library(shinyvalidate)
library(shinyjs)
library(teal.widgets)

iris_select <- data_extract_spec(
  dataname = "iris",
  select = select_spec(
    label = "Select variable:",
    choices = variable_choices(iris, colnames(iris)),
    selected = "Sepal.Length",
    multiple = TRUE,
    fixed = FALSE
  )
)

iris_filter <- data_extract_spec(
  dataname = "iris",
  filter = filter_spec(
    vars = "Species",
    choices = c("setosa", "versicolor", "virginica"),
    selected = "setosa",
    multiple = TRUE
  )
)

data_list <- list(iris = reactive(iris))

ui <- fluidPage(
  useShinyjs(),
  standard_layout(
    output = verbatimTextOutput("out1"),
    encoding = tagList(
      data_extract_ui(
        id = "x_var",
        label = "Please select an X column",
        data_extract_spec = iris_select
      ),
      data_extract_ui(
        id = "species_var",
        label = "Please select 2 Species",
        data_extract_spec = iris_filter
      )
    )
  )
)

server <- function(input, output, session) {
  selector_list <- data_extract_multiple_srv(
    list(x_var = iris_select, species_var = iris_filter),
    datasets = data_list,
    select_validation_rule = list(
      x_var = sv_required("Please select an X column")
    ),
    filter_validation_rule = list(
      species_var = compose_rules(
        sv_required("Exactly 2 Species must be chosen"),
        function(x) if (length(x) != 2) "Exactly 2 Species must be chosen"
      )
    )
  )
  iv_r <- reactive({
    iv <- InputValidator$new()
    compose_and_enable_validators(
      iv,
      selector_list,
      validator_names = NULL
    )
  })

  output$out1 <- renderPrint({
    if (iv_r()$is_valid()) {
      ans <- lapply(selector_list(), function(x) {
        cat(format_data_extract(x()), "\n\n")
      })
    } else {
      "Please fix errors in your selection"
    }
  })
}

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

Returns a reactive list with values read from the inputs of data_extract_spec

Description

Returns a reactive list with values read from the inputs of data_extract_spec

Usage

data_extract_read_srv(
  id,
  datasets,
  single_data_extract_spec,
  iv,
  select_validation_rule = NULL,
  filter_validation_rule = NULL
)

Arguments

Details

Reads the UI inputs of a single data_extract_spec object in a running teal application. Returns a reactive list of reactive values read from the input.

The returned list has keys corresponding to the UI inputs: select, filters, always_selected, reshape.

Value

shiny::reactive the reactive list with reactive values read from the UI.

Returns a shiny.tag.list object with the UI for a select_spec object

Description

Returns a shiny.tag.list object with the UI for a select_spec object

Usage

data_extract_select_ui(select, id = "select")

Arguments

Value

shiny.tag.list with the UI.

The server function for a single data_extract_spec object

Description

The server function for a single data_extract_spec object

Usage

data_extract_single_srv(id, datasets, single_data_extract_spec)

Arguments

Details

The Shiny server function for handling a single data_extract_spec object.

Value

NULL.

Returns a shiny.tag with the UI elements for a data_extract_spec

Description

Returns a shiny.tag with the UI elements for a data_extract_spec

Usage

data_extract_single_ui(id = NULL, single_data_extract_spec)

Arguments

Details

Creates a shiny.tag element defining the UI elements corresponding to a single data_extract_spec object.

Value

shiny.tag the HTML element defining the UI.

Data extract input for teal modules

Description

The Data extract input can be used to filter and select columns from a data set. This function enables such an input in teal. Please use the constructor function data_extract_spec to set it up.

Usage

data_extract_spec(dataname, select = NULL, filter = NULL, reshape = FALSE)

Arguments

Value

data_extract_spec object.

Module Development

teal.transform uses this object to construct a UI element in a module.

Note

No checks based on columns can be done because the data is only referred to by name.

References

select_spec filter_spec

Examples

adtte_filters <- filter_spec(
  vars = c("PARAMCD", "CNSR"),
  sep = "-",
  choices = c("OS-1" = "OS-1", "OS-0" = "OS-0", "PFS-1" = "PFS-1"),
  selected = "OS-1",
  multiple = FALSE,
  label = "Choose endpoint and Censor"
)

data_extract_spec(
  dataname = "ADTTE",
  filter = adtte_filters,
  select = select_spec(
    choices = c("AVAL", "BMRKR1", "AGE"),
    selected = c("AVAL", "BMRKR1"),
    multiple = TRUE,
    fixed = FALSE,
    label = "Column"
  )
)

data_extract_spec(
  dataname = "ADSL",
  filter = NULL,
  select = select_spec(
    choices = c("AGE", "SEX", "USUBJID"),
    selected = c("SEX"),
    multiple = FALSE,
    fixed = FALSE
  )
)
data_extract_spec(
  dataname = "ADSL",
  filter = filter_spec(
    vars = variable_choices("ADSL", subset = c("AGE"))
  )
)

dynamic_filter <- filter_spec(
  vars = choices_selected(variable_choices("ADSL"), "COUNTRY"),
  multiple = TRUE
)
data_extract_spec(
  dataname = "ADSL",
  filter = dynamic_filter
)

Extraction of the selector(s) details

Description

Extracting details of the selection(s) in data_extract_ui elements.

Usage

data_extract_srv(id, datasets, data_extract_spec, ...)

## S3 method for class 'FilteredData'
data_extract_srv(id, datasets, data_extract_spec, ...)

## S3 method for class 'list'
data_extract_srv(
  id,
  datasets,
  data_extract_spec,
  join_keys = NULL,
  select_validation_rule = NULL,
  filter_validation_rule = NULL,
  dataset_validation_rule = if (is.null(select_validation_rule) &&
    is.null(filter_validation_rule)) {
     NULL
 } else {
    
    shinyvalidate::sv_required("Please select a dataset")
 },
  ...
)

Arguments

Value

A reactive list containing following fields:

• filters: A list with the information on the filters that are applied to the data set.

• select: The variables that are selected from the dataset.

• always_selected: The column names from the data set that should always be selected.

• reshape: Whether reshape long to wide should be applied or not.

• dataname: The name of the data set.

• internal_id: The id of the corresponding shiny input element.

• keys: The names of the columns that can be used to merge the data set.

• iv: A shinyvalidate::InputValidator containing validator for this data_extract.

References

data_extract_srv

Examples

library(shiny)
library(shinyvalidate)
library(teal.data)
library(teal.widgets)

# Sample ADSL dataset
ADSL <- data.frame(
  STUDYID = "A",
  USUBJID = LETTERS[1:10],
  SEX = rep(c("F", "M"), 5),
  AGE = rpois(10, 30),
  BMRKR1 = rlnorm(10)
)

# Specification for data extraction
adsl_extract <- data_extract_spec(
  dataname = "ADSL",
  filter = filter_spec(vars = "SEX", choices = c("F", "M"), selected = "F"),
  select = select_spec(
    label = "Select variable:",
    choices = variable_choices(ADSL, c("AGE", "BMRKR1")),
    selected = "AGE",
    multiple = TRUE,
    fixed = FALSE
  )
)

# Using reactive list of data.frames
data_list <- list(ADSL = reactive(ADSL))

join_keys <- join_keys(join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")))

# App: data extraction with validation
ui <- fluidPage(
  standard_layout(
    output = verbatimTextOutput("out1"),
    encoding = tagList(
      data_extract_ui(
        id = "adsl_var",
        label = "ADSL selection",
        data_extract_spec = adsl_extract
      )
    )
  )
)
server <- function(input, output, session) {
  adsl_reactive_input <- data_extract_srv(
    id = "adsl_var",
    datasets = data_list,
    data_extract_spec = adsl_extract,
    join_keys = join_keys,
    select_validation_rule = sv_required("Please select a variable.")
  )

  iv_r <- reactive({
    iv <- InputValidator$new()
    iv$add_validator(adsl_reactive_input()$iv)
    iv$enable()
    iv
  })

  output$out1 <- renderPrint({
    if (iv_r()$is_valid()) {
      cat(format_data_extract(adsl_reactive_input()))
    } else {
      "Please fix errors in your selection"
    }
  })
}

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

# App: simplified data extraction
ui <- fluidPage(
  standard_layout(
    output = verbatimTextOutput("out1"),
    encoding = tagList(
      data_extract_ui(
        id = "adsl_var",
        label = "ADSL selection",
        data_extract_spec = adsl_extract
      )
    )
  )
)

server <- function(input, output, session) {
  adsl_reactive_input <- data_extract_srv(
    id = "adsl_var",
    datasets = data_list,
    data_extract_spec = adsl_extract
  )

  output$out1 <- renderPrint(adsl_reactive_input())
}

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

teal data extraction module user-interface

Description

Usage

data_extract_ui(id, label, data_extract_spec, is_single_dataset = FALSE)

Arguments

Details

There are three inputs that will be rendered

1. Dataset select Optional. If more than one data_extract_spec is handed over to the function, a shiny shiny::selectInput will be rendered. Else just the name of the dataset is given.

2. Filter Panel Optional. If the data_extract_spec contains a filter element a shiny shiny::selectInput will be rendered with the options to filter the dataset.

3. Select panel A shiny shiny::selectInput to select columns from the dataset to go into the analysis.

The output can be analyzed using data_extract_srv(...).

This functionality should be used in the encoding panel of your teal app. It will allow app-developers to specify a data_extract_spec() object. This object should be used to teal module variables being filtered data from CDISC datasets.

You can use this function in the same way as any ⁠shiny module⁠ UI. The corresponding server module can be found in data_extract_srv().

Value

Shiny shiny::selectInputs that allow to define how to extract data from a specific dataset. The input elements will be returned inside a shiny::div container.

Examples

library(shiny)
library(teal.widgets)

adtte_filters <- filter_spec(
  vars = c("PARAMCD", "CNSR"),
  sep = "-",
  choices = c("OS-1" = "OS-1", "OS-0" = "OS-0", "PFS-1" = "PFS-1"),
  selected = "OS-1",
  multiple = FALSE,
  label = "Choose endpoint and Censor"
)

response_spec <- data_extract_spec(
  dataname = "ADTTE",
  filter = adtte_filters,
  select = select_spec(
    choices = c("AVAL", "BMRKR1", "AGE"),
    selected = c("AVAL", "BMRKR1"),
    multiple = TRUE,
    fixed = FALSE,
    label = "Column"
  )
)
# Call to use inside your teal module UI function
standard_layout(
  output = tableOutput("table"),
  encoding = tags$div(
    data_extract_ui(
      id = "regressor",
      label = "Regressor Variable",
      data_extract_spec = response_spec
    )
  )
)

Help text with available datasets input

Description

Creates shiny::helpText() with the names of available datasets for the current module.

Usage

datanames_input(data_extracts)

Arguments

Value

shiny.tag defining help-text element that can be added to a UI element.

Bare constructor for delayed_choices object

Description

Special S3 structures that delay selection of possible choices in a filter_spec, select_spec or choices_selected object.

Usage

all_choices()

first_choice()

last_choice()

first_choices(n)

last_choices(n)

Arguments

Value

Object of class ⁠delayed_data, delayed_choices⁠, which is a function that returns the appropriate subset of its argument. all_choices, first_choices, and last_choices structures also have an additional class for internal use.

Examples

# These pairs of structures represent semantically identical specifications:
choices_selected(choices = letters, selected = letters)
choices_selected(choices = letters, selected = all_choices())

choices_selected(choices = letters, selected = letters[1])
choices_selected(choices = letters, selected = first_choice())

choices_selected(choices = letters, selected = letters[length(letters)])
choices_selected(choices = letters, selected = last_choice())

choices_selected(choices = letters, selected = head(letters, 4))
choices_selected(choices = letters, selected = first_choices(4))

choices_selected(choices = letters, selected = tail(letters, 4))
choices_selected(choices = letters, selected = last_choices(4))

filter_spec(
  vars = c("selected_variable"),
  choices = c("value1", "value2", "value3"),
  selected = "value3"
)
filter_spec(
  vars = c("selected_variable"),
  choices = c("value1", "value2", "value3"),
  selected = last_choice()
)

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.

Data extract filter specification

Description

It consists in choices and additionally the variable names for the choices.

Usage

filter_spec(
  vars,
  choices = NULL,
  selected = if (inherits(choices, "delayed_data")) NULL else choices[1],
  multiple = length(selected) > 1 || inherits(selected, "multiple_choices"),
  label = "Filter by",
  sep = attr(choices, "sep"),
  drop_keys = FALSE
)

Arguments

Details

The filter_spec is used inside teal apps to allow filtering datasets for their key variables. Imagine having an adverse events table. It has the columns PARAMCD and CNSR. PARAMCD contains the levels "OS", "PFS", "EFS". CNSR contains the levels "0" and "1". The first example should show how a filter_spec setup will influence the drop-down menu the app user will see.

Value

filter_spec-S3-class object or delayed_filter_spec-S3-class object.

Examples

# for Adverse Events table
filter_spec(
  vars = c("PARAMCD", "CNSR"),
  sep = "-",
  choices = c("OS-1" = "OS-1", "OS-0" = "OS-0", "PFS-1" = "PFS-1"),
  selected = "OS-1",
  multiple = FALSE,
  label = "Choose endpoint and Censor"
)

# filtering a single variable
filter_spec(
  vars = c("PARAMCD"),
  sep = "-",
  choices = c("OS", "PFS", "EFS"),
  selected = "OS",
  multiple = FALSE,
  label = "Choose endpoint"
)

# filtering a single variable by multiple levels of the variable
filter_spec(
  vars = c("PARAMCD"),
  sep = "-",
  choices = c("OS", "PFS", "EFS"),
  selected = c("OS", "PFS"),
  multiple = TRUE,
  label = "Choose endpoint"
)

# delayed version
filter_spec(
  vars = variable_choices("ADSL", "SEX"),
  sep = "-",
  choices = value_choices("ADSL", "SEX", "SEX"),
  selected = "F",
  multiple = FALSE,
  label = "Choose endpoint and Censor"
)
# using `choices_selected()`
filter_spec(
  vars = choices_selected(variable_choices("ADSL", subset = c("SEX", "AGE")), "SEX", fixed = FALSE),
  multiple = TRUE
)

filter_spec(
  vars = choices_selected(variable_choices("ADSL"), "SEX", fixed = TRUE),
  multiple = TRUE
)

# choose all choices
adsl_filter <- filter_spec(
  vars = choices_selected(variable_choices("ADSL"), "SEX", fixed = FALSE),
  choices = value_choices("ADSL", "SEX"),
  selected = all_choices()
)

Data extract dynamic filter specification

Description

Builds a configuration for the data_extract_ui module. This function covers the configuration of filtering datasets (so called filter_spec), which then is used to build the UI element in the teal app.

Usage

filter_spec_internal(
  vars_choices,
  vars_selected = NULL,
  vars_label = NULL,
  vars_fixed = FALSE,
  vars_multiple = TRUE,
  choices = NULL,
  selected = NULL,
  label = NULL,
  fixed = FALSE,
  multiple = TRUE,
  sep = attr(vars_choices, "sep"),
  drop_keys = FALSE,
  dataname = NULL,
  initialized = FALSE
)

## S3 method for class 'delayed_data'
filter_spec_internal(
  vars_choices,
  vars_selected = NULL,
  vars_label = NULL,
  vars_fixed = FALSE,
  vars_multiple = TRUE,
  choices = NULL,
  selected = NULL,
  label = NULL,
  fixed = FALSE,
  multiple = TRUE,
  sep = attr(vars_choices, "sep"),
  drop_keys = FALSE,
  dataname = NULL,
  initialized = FALSE
)

## Default S3 method:
filter_spec_internal(
  vars_choices,
  vars_selected = NULL,
  vars_label = NULL,
  vars_fixed = FALSE,
  vars_multiple = TRUE,
  choices = NULL,
  selected = NULL,
  label = NULL,
  fixed = FALSE,
  multiple = TRUE,
  sep = attr(vars_choices, "sep"),
  drop_keys = FALSE,
  dataname = NULL,
  initialized = FALSE
)

Arguments

Value

filter_spec or delayed_filter_spec S3-class object.

See Also

filter_spec

Formatting data extracts

Description

Returns a human-readable string representation of an extracted data_extract_spec object.

Usage

format_data_extract(data_extract)

Arguments

Details

This function formats the output of data_extract_srv. See the example for more information.

Value

character(1) representation of the data_extract object.

Examples

library(shiny)

simple_des <- data_extract_spec(
  dataname = "iris",
  filter = filter_spec(vars = "Petal.Length", choices = c("1.4", "1.5")),
  select = select_spec(choices = c("Petal.Length", "Species"))
)

ui <- fluidPage(
  data_extract_ui(
    id = "extract",
    label = "data extract ui",
    data_extract_spec = simple_des,
    is_single_dataset = TRUE
  ),
  verbatimTextOutput("formatted_extract")
)
server <- function(input, output, session) {
  extracted_input <- data_extract_srv(
    id = "extract",
    datasets = list(iris = iris),
    data_extract_spec = simple_des
  )
  output$formatted_extract <- renderPrint({
    cat(format_data_extract(extracted_input()))
  })
}

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

Gets the relabel call

Description

Usage

get_anl_relabel_call(columns_source, datasets, anl_name = "ANL")

Arguments

Value

(call) to relabel dataset and assign to anl_name.

Returns non-key column names from data

Description

Usage

get_dataset_prefixed_col_names(data)

Arguments

Value

A named character vector with the non-key columns of the data.

References

data_extract_srv()

Parses filter, select, rename and reshape call

Description

Parses filter, select, rename and reshape call

Usage

get_dplyr_call(
  selector_list,
  idx = 1L,
  join_keys = teal.data::join_keys(),
  dplyr_call_data = get_dplyr_call_data(selector_list, join_keys = join_keys),
  datasets = NULL
)

Arguments

Value

(call) filter, select, rename and reshape call.

Aggregates data extract selectors

Description

Simplifies selector_list into aggregated list with one element per same selector - same dataset, same filter configuration and same reshape status.

Usage

get_dplyr_call_data(selector_list, join_keys = teal.data::join_keys())

Arguments

Value

(list) simplified selectors with aggregated set of filters, selections, reshapes etc. All necessary data for merging.

Names of filtered-out filters dropped from selection

Description

Names of filtered-out filters dropped from selection

Usage

get_dropped_filters(selector)

Arguments

Details

Names of filtered-out filters dropped from automatic selection (key vars are automatically included in select). Dropped filter is filter which became not unique for all observations. This means that if variable is filtered to just one level, it's not a key anymore.

Other variables used in filter should also be dropped from automatic selection, unless they have been selected.

Value

Vector of character names of the filters which should be dropped from select call.

Gets names of the datasets from a list of data_extract_spec objects

Description

Fetches dataname slot per data_extract_spec from a list of data_extract_spec.

Usage

get_extract_datanames(data_extracts)

Arguments

Value

character vector with the unique dataname set.

Build a dplyr filter call

Description

Build a dplyr filter call

Usage

get_filter_call(filter, dataname = NULL, datasets = NULL)

Arguments

Value

dplyr filter call.

Returns the initial values for the vals widget of a filter_spec object

Description

Returns the initial values for the vals widget of a filter_spec object

Usage

get_initial_filter_values(filter, datasets)

Arguments

Value

named list with two slots choices and selected.

Get merge call from a list of selectors

Description

Creates list of calls depending on selector(s) and type of the merge. The merge order is the same as in selectors passed to the function.

Usage

get_merge_call(
  selector_list,
  join_keys = teal.data::join_keys(),
  dplyr_call_data = get_dplyr_call_data(selector_list, join_keys = join_keys),
  merge_function = "dplyr::full_join",
  anl_name = "ANL"
)

Arguments

Value

List with merge call elements.

Gets merge key pair list from keys list

Description

Gets merge key pair list from keys list

Usage

get_merge_key_grid(selector_list, join_keys = teal.data::join_keys())

Arguments

Value

List of merge key pairs between all datasets.

Gets keys needed for join call of two selectors

Description

Gets keys needed for join call of two selectors

Usage

get_merge_key_i(
  selector_list,
  idx,
  dplyr_call_data = get_dplyr_call_data(selector_list)
)

Arguments

Value

character list of keys.

Gets keys vector from keys list

Description

Gets keys vector from keys list

Usage

get_merge_key_pair(selector_from, selector_to, key_from)

Arguments

Details

This function covers up to now 4 cases:

• Dataset without parent: Primary keys are returned;

• Dataset source = dataset target: The primary keys subtracted of all key columns that get purely filtered. This means just one value would be left after filtering inside this column Then it can be taken out;

• Target dataname is parent foreign keys;

• Any other case foreign keys;

Value

character vector of selector keys.

Get pivot longer columns

Description

Get values names which are spread into columns.

Usage

get_pivot_longer_col(selector)

Arguments

Value

A character vector of all the selected columns that are not a keys element.

Create relabel call from named character

Description

Function creates relabel call from named character.

Usage

get_relabel_call(labels)

Arguments

Value

call object with relabel step.

Examples

get_relabel_call(
  labels = c(
    x = as.name("ANL"),
    AGE = "Age",
    AVAL = "Continuous variable"
  )
)

get_relabel_call(
  labels = c(
    AGE = "Age",
    AVAL = "Continuous variable"
  )
)

Get columns to relabel

Description

Get columns to relabel excluding these which has been reshaped (pivot_wider).

Usage

get_relabel_cols(columns_source, dplyr_call_data)

Arguments

Value

columns_source list without columns that have been reshaped.

Returns dplyr rename call

Description

Rename is used only if there are duplicated columns.

Usage

get_rename_call(
  selector_list = list(),
  idx = 1L,
  join_keys = teal.data::join_keys(),
  dplyr_call_data = get_dplyr_call_data(selector_list, join_keys = join_keys)
)

Arguments

Value

(call) dplyr rename call.

Returns dplyr reshape call

Description

Returns dplyr reshape call

Usage

get_reshape_call(
  selector_list = list(),
  idx = 1L,
  join_keys = teal.data::join_keys(),
  dplyr_call_data = get_dplyr_call_data(selector_list, join_keys = join_keys)
)

Arguments

Value

List of multiple dplyr calls that reshape data.

Get unite columns

Description

Get key names which spreads values into columns. Reshape is done only on keys which are in filter_spec.

Usage

get_reshape_unite_col(selector)

Arguments

Value

A character vector of all the selector's keys that are defined in the filters.

Get unite columns values

Description

Get key values (levels) of the unite columns.

Usage

get_reshape_unite_vals(selector)

Arguments

Value

A character vector of keys of the unite columns.

Parse dplyr select call

Description

Parse dplyr select call

Usage

get_select_call(select)

Arguments

Value

dplyr select call.

Generate id for dataset

Description

Generate id for dataset

Usage

id_for_dataset(dataname)

Arguments

Value

character(1).

Include CSS files from ⁠/inst/css/⁠ package directory to application header

Description

system.file should not be used to access files in other packages, it does not work with devtools. As a result, this method is individually redefined as required in each package. Therefore, this function is not exported.

Usage

include_css_files(pattern = "*")

Arguments

Value

HTML code that includes CSS files.

Verify uniform dataset source across data extract specification

Description

Checks if the input data_extract_spec objects all come from the same dataset.

Usage

is_single_dataset(...)

Arguments

Value

TRUE if all data_extract_spec objects come from the same dataset, FALSE otherwise.

Make sure that the extract specification is in list format

Description

Usage

list_extract_spec(x, allow_null = FALSE)

Arguments

Value

x as a list if it is not already.

Merge the datasets on the keys

Description

Combines/merges multiple datasets with specified keys attribute.

Usage

merge_datasets(
  selector_list,
  datasets,
  join_keys,
  merge_function = "dplyr::full_join",
  anl_name = "ANL"
)

Arguments

Details

Internally this function uses calls to allow reproducibility.

This function is often used inside a teal module server function with the selectors being the output of data_extract_srv or data_extract_multiple_srv.

# inside teal module server function

response <- data_extract_srv(
  id = "reponse",
  data_extract_spec = response_spec,
  datasets = datasets
)
regressor <- data_extract_srv(
  id = "regressor",
  data_extract_spec = regressor_spec,
  datasets = datasets
)
merged_data <- merge_datasets(list(regressor(), response()))

Value

merged_dataset list containing:

• expr (list of call) code needed to replicate merged dataset;

• columns_source (list) of column names selected for particular selector; Each list element contains named character vector where:

  • Values are the names of the columns in the ANL. In case if the same column name is selected in more than one selector it gets prefixed by the id of the selector. For example if two data_extract have id x, y, then their duplicated selected variable (for example AGE) is prefixed to be x.AGE and y.AGE;

  • Names of the vector denote names of the variables in the input dataset;

  • attr(,"dataname") to indicate which dataset variable is merged from;

  • attr(, "always selected") to denote the names of the variables which need to be always selected;

• keys (list) the keys of the merged dataset;

• filter_info (list) The information given by the user. This information defines the filters that are applied on the data. Additionally it defines the variables that are selected from the data sets.

Examples

library(shiny)
library(teal.data)

X <- data.frame(A = c(1, 1:3), B = 2:5, D = 1:4, E = letters[1:4], G = letters[6:9])
Y <- data.frame(A = c(1, 1, 2), B = 2:4, C = c(4, 4:5), E = letters[4:6], G = letters[1:3])
join_keys <- join_keys(join_key("X", "Y", c("A", "B")))

selector_list <- list(
  list(
    dataname = "X",
    filters = NULL,
    select = "E",
    keys = c("A", "B"),
    reshape = FALSE,
    internal_id = "x"
  ),
  list(
    dataname = "Y",
    filters = NULL,
    select = "G",
    keys = c("A", "C"),
    reshape = FALSE,
    internal_id = "y"
  )
)

data_list <- list(X = reactive(X), Y = reactive(Y))

merged_datasets <- isolate(
  merge_datasets(
    selector_list = selector_list,
    datasets = data_list,
    join_keys = join_keys
  )
)

paste(merged_datasets$expr)

Merge expression module

Description

Convenient wrapper to combine data_extract_multiple_srv() and merge_expression_srv() when no additional processing is required. Compare the example below with that found in merge_expression_srv().

Usage

merge_expression_module(
  datasets,
  join_keys = NULL,
  data_extract,
  merge_function = "dplyr::full_join",
  anl_name = "ANL",
  id = "merge_id"
)

## S3 method for class 'reactive'
merge_expression_module(
  datasets,
  join_keys = NULL,
  data_extract,
  merge_function = "dplyr::full_join",
  anl_name = "ANL",
  id = "merge_id"
)

## S3 method for class 'list'
merge_expression_module(
  datasets,
  join_keys = NULL,
  data_extract,
  merge_function = "dplyr::full_join",
  anl_name = "ANL",
  id = "merge_id"
)

Arguments

Value

Reactive expression with output from merge_expression_srv().

See Also

merge_expression_srv()

Examples

library(shiny)
library(teal.data)
library(teal.widgets)

ADSL <- data.frame(
  STUDYID = "A",
  USUBJID = LETTERS[1:10],
  SEX = rep(c("F", "M"), 5),
  AGE = rpois(10, 30),
  BMRKR1 = rlnorm(10)
)
ADLB <- expand.grid(
  STUDYID = "A",
  USUBJID = LETTERS[1:10],
  PARAMCD = c("ALT", "CRP", "IGA"),
  AVISIT = c("SCREENING", "BASELINE", "WEEK 1 DAY 8", "WEEK 2 DAY 15")
)
ADLB$AVAL <- rlnorm(120)
ADLB$CHG <- rnorm(120)

data_list <- list(
  ADSL = reactive(ADSL),
  ADLB = reactive(ADLB)
)

join_keys <- join_keys(
  join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")),
  join_key("ADSL", "ADLB", c("STUDYID", "USUBJID")),
  join_key("ADLB", "ADLB", c("STUDYID", "USUBJID", "PARAMCD", "AVISIT"))
)

adsl_extract <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    label = "Select variable:",
    choices = c("AGE", "BMRKR1"),
    selected = "AGE",
    multiple = TRUE,
    fixed = FALSE
  )
)
adlb_extract <- data_extract_spec(
  dataname = "ADLB",
  filter = filter_spec(vars = "PARAMCD", choices = c("ALT", "CRP", "IGA"), selected = "ALT"),
  select = select_spec(
    label = "Select variable:",
    choices = c("AVAL", "CHG"),
    selected = "AVAL",
    multiple = TRUE,
    fixed = FALSE
  )
)

ui <- fluidPage(
  standard_layout(
    output = tags$div(
      verbatimTextOutput("expr"),
      dataTableOutput("data")
    ),
    encoding = tagList(
      data_extract_ui("adsl_var", label = "ADSL selection", adsl_extract),
      data_extract_ui("adlb_var", label = "ADLB selection", adlb_extract)
    )
  )
)

server <- function(input, output, session) {
  data_q <- qenv()

  data_q <- eval_code(
    data_q,
    "ADSL <- data.frame(
        STUDYID = 'A',
        USUBJID = LETTERS[1:10],
        SEX = rep(c('F', 'M'), 5),
        AGE = rpois(10, 30),
        BMRKR1 = rlnorm(10)
      )"
  )

  data_q <- eval_code(
    data_q,
    "ADLB <- expand.grid(
        STUDYID = 'A',
        USUBJID = LETTERS[1:10],
        PARAMCD = c('ALT', 'CRP', 'IGA'),
        AVISIT = c('SCREENING', 'BASELINE', 'WEEK 1 DAY 8', 'WEEK 2 DAY 15'),
        AVAL = rlnorm(120),
        CHG = rlnorm(120)
       )"
  )

  merged_data <- merge_expression_module(
    data_extract = list(adsl_var = adsl_extract, adlb_var = adlb_extract),
    datasets = data_list,
    join_keys = join_keys,
    merge_function = "dplyr::left_join"
  )

  code_merge <- reactive({
    for (exp in merged_data()$expr) data_q <- eval_code(data_q, exp)
    data_q
  })

  output$expr <- renderText(paste(merged_data()$expr, collapse = "\n"))
  output$data <- renderDataTable(code_merge()[["ANL"]])
}

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

Data merge module server

Description

Usage

merge_expression_srv(
  id = "merge_id",
  selector_list,
  datasets,
  join_keys,
  merge_function = "dplyr::full_join",
  anl_name = "ANL"
)

## S3 method for class 'reactive'
merge_expression_srv(
  id = "merge_id",
  selector_list,
  datasets,
  join_keys,
  merge_function = "dplyr::full_join",
  anl_name = "ANL"
)

## S3 method for class 'list'
merge_expression_srv(
  id = "merge_id",
  selector_list,
  datasets,
  join_keys,
  merge_function = "dplyr::full_join",
  anl_name = "ANL"
)

Arguments

Details

When additional processing of the data_extract list input is required, merge_expression_srv() can be combined with data_extract_multiple_srv() or data_extract_srv() to influence the selector_list input. Compare the example below with that found in merge_expression_module().

Value

Reactive expression with output from merge_expression_srv().

See Also

merge_expression_module()

Examples

library(shiny)
library(teal.data)
library(teal.widgets)

ADSL <- data.frame(
  STUDYID = "A",
  USUBJID = LETTERS[1:10],
  SEX = rep(c("F", "M"), 5),
  AGE = rpois(10, 30),
  BMRKR1 = rlnorm(10)
)

ADLB <- expand.grid(
  STUDYID = "A",
  USUBJID = LETTERS[1:10],
  PARAMCD = c("ALT", "CRP", "IGA"),
  AVISIT = c("SCREENING", "BASELINE", "WEEK 1 DAY 8", "WEEK 2 DAY 15")
)
ADLB$AVAL <- rlnorm(120)
ADLB$CHG <- rlnorm(120)

data_list <- list(
  ADSL = reactive(ADSL),
  ADLB = reactive(ADLB)
)

join_keys <- join_keys(
  join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")),
  join_key("ADSL", "ADLB", c("STUDYID", "USUBJID")),
  join_key("ADLB", "ADLB", c("STUDYID", "USUBJID", "PARAMCD", "AVISIT"))
)

adsl_extract <- data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    label = "Select variable:",
    choices = c("AGE", "BMRKR1"),
    selected = "AGE",
    multiple = TRUE,
    fixed = FALSE
  )
)
adlb_extract <- data_extract_spec(
  dataname = "ADLB",
  filter = filter_spec(vars = "PARAMCD", choices = c("ALT", "CRP", "IGA"), selected = "ALT"),
  select = select_spec(
    label = "Select variable:",
    choices = c("AVAL", "CHG"),
    selected = "AVAL",
    multiple = TRUE,
    fixed = FALSE
  )
)

ui <- fluidPage(
  standard_layout(
    output = tags$div(
      verbatimTextOutput("expr"),
      dataTableOutput("data")
    ),
    encoding = tagList(
      data_extract_ui("adsl_var", label = "ADSL selection", adsl_extract),
      data_extract_ui("adlb_var", label = "ADLB selection", adlb_extract)
    )
  )
)

server <- function(input, output, session) {
  data_q <- qenv()

  data_q <- eval_code(
    data_q,
    "ADSL <- data.frame(
        STUDYID = 'A',
        USUBJID = LETTERS[1:10],
        SEX = rep(c('F', 'M'), 5),
        AGE = rpois(10, 30),
        BMRKR1 = rlnorm(10)
      )"
  )

  data_q <- eval_code(
    data_q,
    "ADLB <- expand.grid(
        STUDYID = 'A',
        USUBJID = LETTERS[1:10],
        PARAMCD = c('ALT', 'CRP', 'IGA'),
        AVISIT = c('SCREENING', 'BASELINE', 'WEEK 1 DAY 8', 'WEEK 2 DAY 15'),
        AVAL = rlnorm(120),
        CHG = rlnorm(120)
      )"
  )

  selector_list <- data_extract_multiple_srv(
    list(adsl_var = adsl_extract, adlb_var = adlb_extract),
    datasets = data_list
  )
  merged_data <- merge_expression_srv(
    selector_list = selector_list,
    datasets = data_list,
    join_keys = join_keys,
    merge_function = "dplyr::left_join"
  )

  code_merge <- reactive({
    for (exp in merged_data()$expr) data_q <- eval_code(data_q, exp)
    data_q
  })

  output$expr <- renderText(paste(merged_data()$expr, collapse = "\n"))
  output$data <- renderDataTable(code_merge()[["ANL"]])
}

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

Merge selectors when dataname, reshape, filters and keys entries are identical

Description

Merge selectors when dataname, reshape, filters and keys entries are identical

Usage

merge_selectors(selector_list)

Arguments

Value

List of merged selectors or original parameter if the conditions to merge are not applicable.

Check select choices for no choice made

Description

Usage

no_selected_as_NULL(x)

Arguments

Value

The word or NULL.

Parses merge keys

Description

Parses merge keys

Usage

parse_merge_key_i(
  selector_list,
  idx,
  dplyr_call_data = get_dplyr_call_data(selector_list),
  merge_key = get_merge_key_i(selector_list, idx, dplyr_call_data)
)

Arguments

Value

call with merge keys.

Objects exported from other packages

Description

These objects are imported from other packages. Follow the links below to see their documentation.

dplyr

%>%

Resolve delayed inputs by evaluating the code within the provided datasets

Description

Usage

resolve(x, datasets, keys = NULL)

## S3 method for class 'delayed_variable_choices'
resolve(x, datasets, keys)

## S3 method for class 'delayed_value_choices'
resolve(x, datasets, keys)

## S3 method for class 'delayed_choices_selected'
resolve(x, datasets, keys)

## S3 method for class 'delayed_select_spec'
resolve(x, datasets, keys)

## S3 method for class 'delayed_filter_spec'
resolve(x, datasets, keys)

## S3 method for class 'delayed_data_extract_spec'
resolve(x, datasets, keys)

## S3 method for class 'list'
resolve(x, datasets, keys)

## Default S3 method:
resolve(x, datasets, keys)

Arguments

Value

Resolved object.

Methods (by class)

• resolve(delayed_variable_choices): Call variable_choices() on the delayed variable_choices object.

• resolve(delayed_value_choices): Call value_choices() on the delayed value_choices object.

• resolve(delayed_choices_selected): Call select_spec() on the delayed choices_selected object.

• resolve(delayed_select_spec): Call select_spec() on the delayed specification.

• resolve(delayed_filter_spec): Call filter_spec() on the delayed specification.

• resolve(delayed_data_extract_spec): Call data_extract_spec() on the delayed specification.

• resolve(list): Iterates over elements of the list and recursively calls resolve.

• resolve(default): Default method that does nothing and returns x itself.

Note

This is an internal function that is used by resolve_delayed(). All the methods are used internally only.

Resolve delayed inputs by evaluating the code within the provided datasets

Description

Usage

resolve_delayed(x, datasets, keys)

## S3 method for class 'FilteredData'
resolve_delayed(
  x,
  datasets,
  keys = sapply(datasets$datanames(), datasets$get_keys, simplify = FALSE)
)

## S3 method for class 'list'
resolve_delayed(x, datasets, keys = NULL)

Arguments

Value

Resolved object.

Methods (by class)

• resolve_delayed(FilteredData): Default values for keys parameters is extracted from datasets.

• resolve_delayed(list): Generic method when datasets argument is a named list.

Examples

library(shiny)

ADSL <- teal.data::rADSL
isolate({
  data_list <- list(ADSL = reactive(ADSL))

  # value_choices example
  v1 <- value_choices("ADSL", "SEX", "SEX")
  v1
  resolve_delayed(v1, data_list)

  # variable_choices example
  v2 <- variable_choices("ADSL", c("BMRKR1", "BMRKR2"))
  v2
  resolve_delayed(v2, data_list)

  # data_extract_spec example
  adsl_filter <- filter_spec(
    vars = variable_choices("ADSL", "SEX"),
    sep = "-",
    choices = value_choices("ADSL", "SEX", "SEX"),
    selected = "F",
    multiple = FALSE,
    label = "Choose endpoint and Censor"
  )

  adsl_select <- select_spec(
    label = "Select variable:",
    choices = variable_choices("ADSL", c("BMRKR1", "BMRKR2")),
    selected = "BMRKR1",
    multiple = FALSE,
    fixed = FALSE
  )

  adsl_de <- data_extract_spec(
    dataname = "ADSL",
    select = adsl_select,
    filter = adsl_filter
  )

  resolve_delayed(adsl_filter, datasets = data_list)
  resolve_delayed(adsl_select, datasets = data_list)
  resolve_delayed(adsl_de, datasets = data_list)

  # nested list (arm_ref_comp)
  arm_ref_comp <- list(
    ARMCD = list(
      ref = variable_choices("ADSL"),
      comp = variable_choices("ADSL")
    )
  )

  resolve_delayed(arm_ref_comp, datasets = data_list)
})

Resolve expression after delayed data are loaded

Description

Resolve expression after delayed data are loaded

Usage

resolve_delayed_expr(x, ds, is_value_choices)

Arguments

Value

character vector - result of calling function x on dataset ds.

Column selection input specification

Description

select_spec is used inside teal to create a shiny::selectInput() that will select columns from a dataset.

Usage

select_spec(
  choices,
  selected = if (inherits(choices, "delayed_data")) NULL else choices[1],
  multiple = length(selected) > 1 || inherits(selected, "multiple_choices"),
  fixed = FALSE,
  always_selected = NULL,
  ordered = FALSE,
  label = "Select"
)

select_spec.delayed_data(
  choices,
  selected = NULL,
  multiple = length(selected) > 1,
  fixed = FALSE,
  always_selected = NULL,
  ordered = FALSE,
  label = NULL
)

select_spec.default(
  choices,
  selected = choices[1],
  multiple = length(selected) > 1,
  fixed = FALSE,
  always_selected = NULL,
  ordered = FALSE,
  label = NULL
)

Arguments

Value

A select_spec-S3 class object or delayed_select_spec-S3-class object. It contains all input values.

If select_spec, then the function double checks the choices and selected inputs.

Examples

# Selection with just one column allowed
select_spec(
  choices = c("AVAL", "BMRKR1", "AGE"),
  selected = c("AVAL"),
  multiple = FALSE,
  fixed = FALSE,
  label = "Column"
)

# Selection with just multiple columns allowed
select_spec(
  choices = c("AVAL", "BMRKR1", "AGE"),
  selected = c("AVAL", "BMRKR1"),
  multiple = TRUE,
  fixed = FALSE,
  label = "Columns"
)

# Selection without user access
select_spec(
  choices = c("AVAL", "BMRKR1"),
  selected = c("AVAL", "BMRKR1"),
  multiple = TRUE,
  fixed = TRUE,
  label = "Columns"
)

# Delayed version
select_spec(
  label = "Select variable:",
  choices = variable_choices("ADSL", c("BMRKR1", "BMRKR2")),
  selected = "BMRKR1",
  multiple = FALSE,
  fixed = FALSE
)

# delayed_choices passed to selected
select_spec(
  label = "Select variable:",
  choices = variable_choices("ADSL", c("BMRKR1", "BMRKR2")),
  selected = all_choices()
)

# Both below objects are semantically the same
select_spec(choices = variable_choices("ADSL"), selected = variable_choices("ADSL"))
select_spec(choices = variable_choices("ADSL"), selected = all_choices())

Split by separator (matched exactly)

Description

Usage

split_by_sep(x, sep)

Arguments

Value

List of character vectors split by sep. Self if x is not a character.

Validates whether the provided keys are sufficient to merge the datasets slices

Description

Validates whether the provided keys are sufficient to merge the datasets slices

Usage

validate_keys_sufficient(join_keys, merged_selector_list)

Arguments

Value

TRUE if the provided keys meet the requirement and shiny validate error otherwise.

Note

The keys are not sufficient if the datasets slices described in merged_selector_list come from datasets, which don't have the appropriate join keys in join_keys.

Value labeling and filtering based on variable relationship

Description

Wrapper on choices_labeled to label variable values basing on other variable values.

Usage

value_choices(data, var_choices, var_label = NULL, subset = NULL, sep = " - ")

## S3 method for class 'character'
value_choices(data, var_choices, var_label = NULL, subset = NULL, sep = " - ")

## S3 method for class 'data.frame'
value_choices(data, var_choices, var_label = NULL, subset = NULL, sep = " - ")

Arguments

Value

named character vector or delayed_data object.

Examples

ADRS <- teal.data::rADRS
value_choices(ADRS, "PARAMCD", "PARAM", subset = c("BESRSPI", "INVET"))
value_choices(ADRS, c("PARAMCD", "ARMCD"), c("PARAM", "ARM"))
value_choices(ADRS, c("PARAMCD", "ARMCD"), c("PARAM", "ARM"),
  subset = c("BESRSPI - ARM A", "INVET - ARM A", "OVRINV - ARM A")
)
value_choices(ADRS, c("PARAMCD", "ARMCD"), c("PARAM", "ARM"), sep = " --- ")

# delayed version
value_choices("ADRS", c("PARAMCD", "ARMCD"), c("PARAM", "ARM"))

# functional subset
value_choices(ADRS, "PARAMCD", "PARAM", subset = function(data) {
  levels(data$PARAMCD)[1:2]
})

Variable label extraction and custom selection from data

Description

Wrapper on choices_labeled to label variables basing on existing labels in data.

Usage

variable_choices(data, subset = NULL, fill = FALSE, key = NULL)

## S3 method for class 'character'
variable_choices(data, subset = NULL, fill = FALSE, key = NULL)

## S3 method for class 'data.frame'
variable_choices(data, subset = NULL, fill = TRUE, key = NULL)

Arguments

Value

Named character vector with additional attributes or delayed_data object.

Examples

library(teal.data)
ADRS <- rADRS
variable_choices(ADRS)
variable_choices(ADRS, subset = c("PARAM", "PARAMCD"))
variable_choices(ADRS, subset = c("", "PARAM", "PARAMCD"))
variable_choices(
  ADRS,
  subset = c("", "PARAM", "PARAMCD"),
  key = default_cdisc_join_keys["ADRS", "ADRS"]
)

# delayed version
variable_choices("ADRS", subset = c("USUBJID", "STUDYID"))

# functional subset (with delayed data) - return only factor variables
variable_choices("ADRS", subset = function(data) {
  idx <- vapply(data, is.factor, logical(1))
  names(data)[idx]
})