Package 'teal.transform'

Description

Usage

add_no_selected_choices(x, multiple = FALSE)

Arguments

Value

choices_selected object with an empty option added to the choices.

Description

An S3 structure representing the selection of all possible choices in a filter_spec, select_spec or choices_selected object.

Usage

all_choices()

Value

all_choices object.

Examples

# Both structures are semantically identical
filter_spec(
  vars = c("selected_variable"),
  choices = c("value1", "value2"),
  selected = c("value1", "value2")
)

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

choices_selected(choices = letters, selected = letters)
choices_selected(choices = letters, selected = all_choices())

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.

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(shiny)
library(teal.data)

ADSL <- teal.transform::rADSL
ADTTE <- teal.transform::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)
}

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)

# all_choices example - semantically the same objects
choices_selected(choices = letters, selected = all_choices())
choices_selected(choices = letters, selected = letters)

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

ADSL <- teal.transform::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"))
)

# 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)
}

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) {
  exactly_2_validation <- function() {
    ~ if (length(.) != 2) "Exactly 2 'Y' column variables must be chosen"
  }

  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"),
        exactly_2_validation()
      )
    )
  )
  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)
}

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) {
  exactly_2_validation <- function(msg) {
    ~ if (length(.) != 2) msg
  }


  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"),
        exactly_2_validation("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)
}

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
)

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)
}

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 = div(
    data_extract_ui(
      id = "regressor",
      label = "Regressor Variable",
      data_extract_spec = response_spec
    )
  )
)

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.

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, "all_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()
)

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)
}

Description

Usage

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

Arguments

Value

(call) to relabel dataset and assign to anl_name.

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()

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.

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.

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"
  )
)

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.

Description

Usage

list_extract_spec(x, allow_null = FALSE)

Arguments

Value

x as a list if it is not already.

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)

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 = 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)
}

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 = 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)
}

Description

Usage

no_selected_as_NULL(x)

Arguments

Value

The word or NULL.

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.transform::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)
})

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, "all_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
)

# all_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())

Description

Usage

split_by_sep(x, sep)

Arguments

Value

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

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.transform::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]
})

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 <- teal.transform::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]
})