From fd79164b52ee94ed86fe52f432e5771559f77bfa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= <6959016+gogonzo@users.noreply.github.com> Date: Thu, 6 Jul 2023 10:05:08 +0200 Subject: [PATCH] Decouple scda (#858) closes https://github.com/insightsengineering/teal/issues/834 see also: - https://github.com/insightsengineering/scda/pull/125 - https://github.com/insightsengineering/scda.2022/pull/123 --------- Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> --- DESCRIPTION | 4 - NEWS.md | 3 + R/dummy_functions.R | 71 ++++--- R/init.R | 30 +-- R/module_nested_tabs.R | 4 +- R/module_tabs_with_filters.R | 4 +- R/module_teal.R | 4 +- R/modules_debugging.R | 14 +- R/validations.R | 177 +++++++++--------- README.md | 2 - ...my_cdisc_data.Rd => example_cdisc_data.Rd} | 6 +- ..._dummy_datasets.Rd => example_datasets.Rd} | 6 +- ...{get_dummy_filter.Rd => example_filter.Rd} | 6 +- ...et_dummy_modules.Rd => example_modules.Rd} | 6 +- man/filter_calls_module.Rd | 14 +- man/init.Rd | 30 +-- man/ui_nested_tabs.Rd | 4 +- man/ui_tabs_with_filters.Rd | 4 +- man/ui_teal.Rd | 4 +- man/validate_has_data.Rd | 21 ++- man/validate_has_elements.Rd | 27 +-- man/validate_has_variable.Rd | 24 +-- man/validate_in.Rd | 21 +-- man/validate_n_levels.Rd | 29 +-- man/validate_no_intersection.Rd | 34 ++-- man/validate_one_row_per_id.Rd | 23 +-- staged_dependencies.yaml | 6 - tests/testthat/test-init.R | 4 +- vignettes/including-adam-data-in-teal.Rmd | 68 ++++++- vignettes/preprocessing-data.Rmd | 15 +- 30 files changed, 353 insertions(+), 312 deletions(-) rename man/{get_dummy_cdisc_data.Rd => example_cdisc_data.Rd} (79%) rename man/{get_dummy_datasets.Rd => example_datasets.Rd} (82%) rename man/{get_dummy_filter.Rd => example_filter.Rd} (82%) rename man/{get_dummy_modules.Rd => example_modules.Rd} (80%) diff --git a/DESCRIPTION b/DESCRIPTION index b775dd7352..d75d7a7d8e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,8 +49,6 @@ Suggests: MultiAssayExperiment, R6, rmarkdown, - scda (>= 0.1.5), - scda.2022 (>= 0.1.3), shinyvalidate, testthat (>= 3.1.5), withr, @@ -60,8 +58,6 @@ VignetteBuilder: RdMacros: lifecycle Remotes: - insightsengineering/scda.2022@*release, - insightsengineering/scda@*release, insightsengineering/teal.code@*release, insightsengineering/teal.data@*release, insightsengineering/teal.logger@*release, diff --git a/NEWS.md b/NEWS.md index 87b867b379..db3880ca65 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # teal 0.13.0.9004 +### Miscellaneous + +* Removed `scda` package dependency from examples. # teal 0.13.0 ### Breaking changes diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 373bf3650d..331cf4dfd3 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -8,7 +8,7 @@ #' @param data (`TealData`) #' @return dummy filter states #' @keywords internal -get_dummy_filter <- function(data) { # nolint +example_filter <- function(data) { # nolint ADSL <- teal.data::get_raw_data(x = data, dataname = "ADSL") # nolint ADLB <- teal.data::get_raw_data(x = data, dataname = "ADLB") # nolint @@ -52,35 +52,50 @@ get_dummy_filter <- function(data) { # nolint #' #' @return `cdisc_data` #' @keywords internal -get_dummy_cdisc_data <- function() { # nolint - teal_with_pkg <- function(pkg, code) { - pkg_name <- paste0("package:", pkg) - if (!pkg_name %in% search()) { - require(pkg, character.only = TRUE) - on.exit(detach(pkg_name, character.only = TRUE)) - } - eval.parent(code) - return(invisible(NULL)) - } - - teal_with_pkg("scda", code = { - ADSL <- scda::synthetic_cdisc_data("latest")$adsl # nolint - ADAE <- scda::synthetic_cdisc_data("latest")$adae # nolint - ADLB <- scda::synthetic_cdisc_data("latest")$adlb # nolint - }) +example_cdisc_data <- function() { # nolint + ADSL <- data.frame( # nolint + STUDYID = "study", + USUBJID = 1:10, + SEX = sample(c("F", "M"), 10, replace = TRUE), + AGE = stats::rpois(10, 40) + ) + ADTTE <- rbind(ADSL, ADSL, ADSL) # nolint + ADTTE$PARAMCD <- rep(c("OS", "EFS", "PFS"), each = 10) # nolint + ADTTE$AVAL <- c( # nolint + stats::rnorm(10, mean = 700, sd = 200), # dummy OS level + stats::rnorm(10, mean = 400, sd = 100), # dummy EFS level + stats::rnorm(10, mean = 450, sd = 200) # dummy PFS level + ) ADSL$logical_test <- sample(c(TRUE, FALSE, NA), size = nrow(ADSL), replace = TRUE) # nolint - ADSL$SEX[1:150] <- NA # nolint + ADSL$SEX[c(2, 5)] <- NA # nolint + + cdisc_data_obj <- teal.data::cdisc_data( + cdisc_dataset(dataname = "ADSL", x = ADSL), + cdisc_dataset(dataname = "ADTTE", x = ADTTE) + ) res <- teal.data::cdisc_data( teal.data::cdisc_dataset(dataname = "ADSL", x = ADSL), - teal.data::cdisc_dataset(dataname = "ADAE", x = ADAE), - teal.data::cdisc_dataset(dataname = "ADLB", x = ADLB), - code = " - ADSL <- synthetic_cdisc_data(\"latest\")$adsl - ADAE <- synthetic_cdisc_data(\"latest\")$adae - ADLB <- synthetic_cdisc_data(\"latest\")$adlb - " + teal.data::cdisc_dataset(dataname = "ADTTE", x = ADTTE), + code = ' + ADSL <- data.frame( + STUDYID = "study", + USUBJID = 1:10, + SEX = sample(c("F", "M"), 10, replace = TRUE), + AGE = rpois(10, 40) + ) + ADTTE <- rbind(ADSL, ADSL, ADSL) + ADTTE$PARAMCD <- rep(c("OS", "EFS", "PFS"), each = 10) + ADTTE$AVAL <- c( + rnorm(10, mean = 700, sd = 200), + rnorm(10, mean = 400, sd = 100), + rnorm(10, mean = 450, sd = 200) + ) + + ADSL$logical_test <- sample(c(TRUE, FALSE, NA), size = nrow(ADSL), replace = TRUE) + ADSL$SEX[c(2, 5)] <- NA + ' ) return(res) } @@ -90,8 +105,8 @@ get_dummy_cdisc_data <- function() { # nolint #' Returns a new `R6` object on each invocation, not a singleton. #' @return `FilteredData` with `ADSL` set #' @keywords internal -get_dummy_datasets <- function() { # nolint - dummy_cdisc_data <- get_dummy_cdisc_data() +example_datasets <- function() { # nolint + dummy_cdisc_data <- example_cdisc_data() return(teal.slice::init_filtered_data(dummy_cdisc_data)) } @@ -102,7 +117,7 @@ get_dummy_datasets <- function() { # nolint #' #' @return `teal_modules` #' @keywords internal -get_dummy_modules <- function() { +example_modules <- function() { mods <- modules( label = "d1", modules( diff --git a/R/init.R b/R/init.R index 5f953443da..cd5e40e6a8 100644 --- a/R/init.R +++ b/R/init.R @@ -111,41 +111,41 @@ #' @include modules.R #' #' @examples -#' library(scda) -#' -#' ADSL <- synthetic_cdisc_data("latest")$adsl +#' new_iris <- transform(iris, id = seq_len(nrow(iris))) +#' new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars))) #' #' app <- init( -#' data = cdisc_data( -#' cdisc_dataset("ADSL", ADSL), -#' code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" +#' data = teal_data( +#' dataset("new_iris", new_iris), +#' dataset("new_mtcars", new_mtcars), +#' code = " +#' new_iris <- transform(iris, id = seq_len(nrow(iris))) +#' new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars))) +#' " #' ), #' modules = modules( #' module( -#' "data source", +#' label = "data source", #' server = function(input, output, session, data) {}, #' ui = function(id, ...) div(p("information about data source")), #' filters = "all" #' ), -#' example_module(), +#' example_module(label = "example teal module"), #' module( -#' "ADSL AGE histogram", +#' "Iris Sepal.Length histogram", #' server = function(input, output, session, data) { #' output$hist <- renderPlot( -#' hist(data[["ADSL"]]()$AGE) +#' hist(data[["new_iris"]]()$Sepal.Length) #' ) #' }, #' ui = function(id, ...) { #' ns <- NS(id) #' plotOutput(ns("hist")) #' }, -#' filters = "ADSL" +#' filters = "new_iris" #' ) #' ), -#' title = "App title", -#' filter = list(ADSL = structure(list(AGE = list()), filterable = c("AGE", "SEX", "RACE"))), -#' header = tags$h1("Sample App"), -#' footer = tags$p("Copyright 2017 - 2020") +#' title = "App title" #' ) #' if (interactive()) { #' shinyApp(app$ui, app$server) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index cdaa15ced3..9082b2feba 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -17,8 +17,8 @@ #' - `teal_modules`: `tabsetPanel` with each tab corresponding to recursively #' calling this function on it. #' @examples -#' mods <- teal:::get_dummy_modules() -#' datasets <- teal:::get_dummy_datasets() +#' mods <- teal:::example_modules() +#' datasets <- teal:::example_datasets() #' app <- shinyApp( #' ui = function() { #' tagList( diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index 81132bf2c0..9036736fea 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -27,8 +27,8 @@ #' #' @examples #' -#' mods <- teal:::get_dummy_modules() -#' datasets <- teal:::get_dummy_datasets() +#' mods <- teal:::example_modules() +#' datasets <- teal:::example_datasets() #' #' app <- shinyApp( #' ui = function() { diff --git a/R/module_teal.R b/R/module_teal.R index fbebfc9027..bb2ff6eaa3 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -27,8 +27,8 @@ #' @keywords internal #' #' @examples -#' mods <- teal:::get_dummy_modules() -#' raw_data <- reactive(teal:::get_dummy_cdisc_data()) +#' mods <- teal:::example_modules() +#' raw_data <- reactive(teal:::example_cdisc_data()) #' app <- shinyApp( #' ui = function() { #' teal:::ui_teal("dummy") diff --git a/R/modules_debugging.R b/R/modules_debugging.R index 0f590d0479..c1f60d0465 100644 --- a/R/modules_debugging.R +++ b/R/modules_debugging.R @@ -13,20 +13,8 @@ #' @keywords internal #' #' @examples -#' library(scda) -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' # by testing with NA values, we will see whether the filtering really works when -#' # we add and remove filters -#' ADSL$SEX[1:150] <- NA -#' #' app <- init( -#' data = cdisc_data( -#' cdisc_dataset( -#' dataname = "ADSL", -#' x = ADSL -#' ), -#' code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" -#' ), +#' data = list(iris = iris, mtcars = mtcars), #' modules = teal:::filter_calls_module(), #' header = "Simple teal app" #' ) diff --git a/R/validations.R b/R/validations.R index 56fee633d4..2f16d95021 100644 --- a/R/validations.R +++ b/R/validations.R @@ -13,22 +13,25 @@ #' @export #' #' @examples -#' library(scda) -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' +#' library(teal) #' ui <- fluidPage( -#' sliderInput("obs", "Max Age", -#' min = 0, max = 100, value = 50 +#' sliderInput("len", "Max Length of Sepal", +#' min = 4.3, max = 7.9, value = 5 #' ), #' plotOutput("plot") #' ) #' #' server <- function(input, output) { #' output$plot <- renderPlot({ -#' ADSL_f <- ADSL[ADSL$AGE <= input$obs, ] -#' validate_has_data(ADSL_f, min_nrow = 10, complete = FALSE, msg = "Please adjust your Max Age") +#' df <- iris[iris$Sepal.Length <= input$len, ] +#' validate_has_data( +#' iris_f, +#' min_nrow = 10, +#' complete = FALSE, +#' msg = "Please adjust Max Length of Sepal" +#' ) #' -#' hist(ADSL_f$AGE, breaks = 5) +#' hist(iris_f$Sepal.Length, breaks = 5) #' }) #' } #' \dontrun{ @@ -81,22 +84,23 @@ validate_has_data <- function(x, #' @export #' #' @examples -#' library(scda) -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' +#' iris$id <- rep(1:50, times = 3) #' ui <- fluidPage( -#' sliderInput("obs", "Max Age", -#' min = 0, max = 100, value = 50 +#' selectInput( +#' inputId = "species", +#' label = "Select species", +#' choices = c("setosa", "versicolor", "virginica"), +#' selected = "setosa", +#' multiple = TRUE #' ), -#' verbatimTextOutput("age_summary") +#' plotOutput("plot") #' ) -#' #' server <- function(input, output) { -#' output$age_summary <- renderText({ -#' ADSL_f <- ADSL[ADSL$AGE <= input$obs, ] -#' validate_one_row_per_id(ADSL_f, key = c("STUDYID")) +#' output$plot <- renderPlot({ +#' iris_f <- iris[iris$Species %in% input$species, ] +#' validate_one_row_per_id(iris_f, key = c("id")) #' -#' paste0("Mean age :", mean(ADSL_f$AGE)) +#' hist(iris_f$Sepal.Length, breaks = 5) #' }) #' } #' \dontrun{ @@ -119,26 +123,21 @@ validate_one_row_per_id <- function(x, key = c("USUBJID", "STUDYID")) { #' @export #' #' @examples -#' library(scda) -#' -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' ADRS <- synthetic_cdisc_data("latest")$adrs -#' #' ui <- fluidPage( #' selectInput( -#' "rsp", -#' "Select response parameter", -#' choices = c("BESRSPI", "INVET", "CBRSPI"), -#' selected = "BESRSPI", +#' "species", +#' "Select species", +#' choices = c("setosa", "versicolor", "virginica", "unknown species"), +#' selected = "setosa", #' multiple = FALSE #' ), -#' verbatimTextOutput("rsp_summary") +#' verbatimTextOutput("summary") #' ) #' #' server <- function(input, output) { -#' output$rsp_summary <- renderPrint({ -#' validate_in(input$rsp, ADRS$PARAMCD, "Parameter does not exist.") -#' nrow(ADRS[ADRS$PARAMCD == input$rsp, ]) +#' output$summary <- renderPrint({ +#' validate_in(input$species, iris$Species, "Species does not exist.") +#' nrow(iris[iris$Species == input$species, ]) #' }) #' } #' \dontrun{ @@ -160,30 +159,31 @@ validate_in <- function(x, choices, msg) { #' @export #' #' @examples -#' library(scda) -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' +#' data <- data.frame( +#' id = c(1:10, 11:20, 1:10), +#' strata = rep(c("A", "B"), each = 15) +#' ) #' ui <- fluidPage( -#' selectInput("ref_arm", "Select reference treatment", -#' choices = c("ARM A", "ARM B", "ARM X"), selected = "ARM A" +#' selectInput("ref1", "Select strata1 to compare", +#' choices = c("A", "B", "C"), selected = "A" #' ), -#' selectInput("comp_arm", "Select comparison treatment", -#' choices = c("ARM C", "ARM Y", "ARM Z"), selected = "ARM C" +#' selectInput("ref2", "Select strata2 to compare", +#' choices = c("A", "B", "C"), selected = "B" #' ), #' verbatimTextOutput("arm_summary") #' ) #' #' server <- function(input, output) { #' output$arm_summary <- renderText({ -#' ref_arm <- ADSL$ARMCD[input$ref_arm == ADSL$ARMCD] -#' comp_arm <- ADSL$ARMCD[input$comp_arm == ADSL$ARMCD] +#' sample_1 <- data$id[data$strata == input$ref1] +#' sample_2 <- data$id[data$strata == input$ref2] #' -#' validate_has_elements(ref_arm, "Need reference treatment.") -#' validate_has_elements(comp_arm, "Need comparison treatment.") +#' validate_has_elements(sample_1, "No subjects in strata1.") +#' validate_has_elements(sample_2, "No subjects in strata2.") #' #' paste0( -#' "Number of patients in: reference treatment=", -#' length(ref_arm), " comparions treatment=", length(comp_arm) +#' "Number of samples in: strata1=", length(sample_1), +#' " comparions strata2=", length(sample_2) #' ) #' }) #' } @@ -206,33 +206,35 @@ validate_has_elements <- function(x, msg) { #' @export #' #' @examples -#' library(scda) -#' ADSL <- synthetic_cdisc_data("latest")$adsl +#' data <- data.frame( +#' id = c(1:10, 11:20, 1:10), +#' strata = rep(c("A", "B", "C"), each = 10) +#' ) #' #' ui <- fluidPage( -#' selectInput("ref_arm", "Select reference treatment", -#' choices = c("ARM A", "ARM B", "ARM C"), -#' selected = "ARM A" +#' selectInput("ref1", "Select strata1 to compare", +#' choices = c("A", "B", "C"), +#' selected = "A" #' ), -#' selectInput("comp_arm", "Select comparison treatment", -#' choices = c("ARM A", "ARM B", "ARM C"), -#' selected = "ARM C" +#' selectInput("ref2", "Select strata2 to compare", +#' choices = c("A", "B", "C"), +#' selected = "B" #' ), -#' verbatimTextOutput("arm_summary") +#' verbatimTextOutput("summary") #' ) #' #' server <- function(input, output) { -#' output$arm_summary <- renderText({ -#' ref_arm <- ADSL$ARMCD[input$ref_arm == ADSL$ARMCD] -#' comp_arm <- ADSL$ARMCD[input$comp_arm == ADSL$ARMCD] +#' output$summary <- renderText({ +#' sample_1 <- data$id[data$strata == input$ref1] +#' sample_2 <- data$id[data$strata == input$ref2] #' #' validate_no_intersection( -#' comp_arm, ref_arm, -#' "reference and comparison treatments cannot overlap" +#' sample_1, sample_2, +#' "subjects within strata1 and strata2 cannot overlap" #' ) #' paste0( -#' "Number of patients in: reference treatment=", length(ref_arm), -#' " comparions treatment=", length(comp_arm) +#' "Number of subject in: reference treatment=", length(sample_1), +#' " comparions treatment=", length(sample_2) #' ) #' }) #' } @@ -257,22 +259,24 @@ validate_no_intersection <- function(x, y, msg) { #' @export #' #' @examples -#' library(scda) -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' +#' data <- data.frame( +#' one = rep("a", length.out = 20), +#' two = rep(c("a", "b"), length.out = 20) +#' ) #' ui <- fluidPage( -#' selectInput("arm", "Select treatment", -#' choices = c("ARM", "ARMCD", "ACTARM", "TRT"), -#' selected = "ARM", multiple = TRUE +#' selectInput( +#' "var", +#' "Select variable", +#' choices = c("one", "two", "three", "four"), +#' selected = "one" #' ), -#' verbatimTextOutput("arm_summary") +#' verbatimTextOutput("summary") #' ) #' #' server <- function(input, output) { -#' output$arm_summary <- renderText({ -#' validate_has_variable(ADSL, input$arm) -#' -#' paste0("Selected treatment variables: ", paste(input$arm, collapse = ", ")) +#' output$summary <- renderText({ +#' validate_has_variable(data, input$var) +#' paste0("Selected treatment variables: ", paste(input$var, collapse = ", ")) #' }) #' } #' \dontrun{ @@ -313,26 +317,29 @@ validate_has_variable <- function(data, varname, msg) { #' #' @export #' @examples -#' library(scda) -#' -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' +#' data <- data.frame( +#' one = rep("a", length.out = 20), +#' two = rep(c("a", "b"), length.out = 20), +#' three = rep(c("a", "b", "c"), length.out = 20), +#' four = rep(c("a", "b", "c", "d"), length.out = 20), +#' stringsAsFactors = TRUE +#' ) #' ui <- fluidPage( -#' selectInput("arm", "Select treatment", -#' choices = c("ARM", "ARMCD", "STUDYID"), selected = "ARM" +#' selectInput( +#' "var", +#' "Select variable", +#' choices = c("one", "two", "three", "four"), +#' selected = "one" #' ), -#' verbatimTextOutput("arm_summary") +#' verbatimTextOutput("summary") #' ) #' #' server <- function(input, output) { -#' output$arm_summary <- renderText({ -#' validate_n_levels(ADSL[[input$arm]], -#' min_levels = 2, max_levels = 15, -#' var_name = input$arm -#' ) +#' output$summary <- renderText({ +#' validate_n_levels(data[[input$var]], min_levels = 2, max_levels = 15, var_name = input$var) #' paste0( #' "Levels of selected treatment variable: ", -#' paste(levels(ADSL[[input$arm]]), +#' paste(levels(data[[input$var]]), #' collapse = ", " #' ) #' ) diff --git a/README.md b/README.md index 542e7d5c34..449c9e2654 100644 --- a/README.md +++ b/README.md @@ -62,8 +62,6 @@ if (!require("remotes")) install.packages("remotes") remotes::install_github("insightsengineering/teal@*release") ``` -In order to run many of the examples you will also need to install the [`scda`](https://insightsengineering.github.io/scda/) package. - A stable release of all `NEST` packages from June 2022 is also available [here](https://github.com/insightsengineering/depository#readme). See package vignettes `browseVignettes(package = "teal")` for usage of this package. diff --git a/man/get_dummy_cdisc_data.Rd b/man/example_cdisc_data.Rd similarity index 79% rename from man/get_dummy_cdisc_data.Rd rename to man/example_cdisc_data.Rd index 42fe4d8c48..0e84056637 100644 --- a/man/get_dummy_cdisc_data.Rd +++ b/man/example_cdisc_data.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/dummy_functions.R -\name{get_dummy_cdisc_data} -\alias{get_dummy_cdisc_data} +\name{example_cdisc_data} +\alias{example_cdisc_data} \title{Get dummy CDISC data} \usage{ -get_dummy_cdisc_data() +example_cdisc_data() } \value{ \code{cdisc_data} diff --git a/man/get_dummy_datasets.Rd b/man/example_datasets.Rd similarity index 82% rename from man/get_dummy_datasets.Rd rename to man/example_datasets.Rd index 73eefdd37f..93fd1b950f 100644 --- a/man/get_dummy_datasets.Rd +++ b/man/example_datasets.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/dummy_functions.R -\name{get_dummy_datasets} -\alias{get_dummy_datasets} +\name{example_datasets} +\alias{example_datasets} \title{Get a dummy \code{datasets} object with \code{ADSL} data, useful in the examples} \usage{ -get_dummy_datasets() +example_datasets() } \value{ \code{FilteredData} with \code{ADSL} set diff --git a/man/get_dummy_filter.Rd b/man/example_filter.Rd similarity index 82% rename from man/get_dummy_filter.Rd rename to man/example_filter.Rd index 2295e29569..66ff87fd6f 100644 --- a/man/get_dummy_filter.Rd +++ b/man/example_filter.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/dummy_functions.R -\name{get_dummy_filter} -\alias{get_dummy_filter} +\name{example_filter} +\alias{example_filter} \title{Get dummy filter states to apply initially} \usage{ -get_dummy_filter(data) +example_filter(data) } \arguments{ \item{data}{(\code{TealData})} diff --git a/man/get_dummy_modules.Rd b/man/example_modules.Rd similarity index 80% rename from man/get_dummy_modules.Rd rename to man/example_modules.Rd index ed26b7ca70..57864598f5 100644 --- a/man/get_dummy_modules.Rd +++ b/man/example_modules.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/dummy_functions.R -\name{get_dummy_modules} -\alias{get_dummy_modules} +\name{example_modules} +\alias{example_modules} \title{Get dummy modules} \usage{ -get_dummy_modules() +example_modules() } \value{ \code{teal_modules} diff --git a/man/filter_calls_module.Rd b/man/filter_calls_module.Rd index 85889fac4d..f7c7cde320 100644 --- a/man/filter_calls_module.Rd +++ b/man/filter_calls_module.Rd @@ -15,20 +15,8 @@ dependencies and simplifies \verb{\link[devtools]\{load_all\}} which otherwise f and avoids session restarts! } \examples{ -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl -# by testing with NA values, we will see whether the filtering really works when -# we add and remove filters -ADSL$SEX[1:150] <- NA - app <- init( - data = cdisc_data( - cdisc_dataset( - dataname = "ADSL", - x = ADSL - ), - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" - ), + data = list(iris = iris, mtcars = mtcars), modules = teal:::filter_calls_module(), header = "Simple teal app" ) diff --git a/man/init.Rd b/man/init.Rd index 2a65a48ef5..516a787bc2 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -126,41 +126,41 @@ This is a wrapper function around the \code{module_teal.R} functions. Unless you an end-user, don't use this function, but instead this module. } \examples{ -library(scda) - -ADSL <- synthetic_cdisc_data("latest")$adsl +new_iris <- transform(iris, id = seq_len(nrow(iris))) +new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars))) app <- init( - data = cdisc_data( - cdisc_dataset("ADSL", ADSL), - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" + data = teal_data( + dataset("new_iris", new_iris), + dataset("new_mtcars", new_mtcars), + code = " + new_iris <- transform(iris, id = seq_len(nrow(iris))) + new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars))) + " ), modules = modules( module( - "data source", + label = "data source", server = function(input, output, session, data) {}, ui = function(id, ...) div(p("information about data source")), filters = "all" ), - example_module(), + example_module(label = "example teal module"), module( - "ADSL AGE histogram", + "Iris Sepal.Length histogram", server = function(input, output, session, data) { output$hist <- renderPlot( - hist(data[["ADSL"]]()$AGE) + hist(data[["new_iris"]]()$Sepal.Length) ) }, ui = function(id, ...) { ns <- NS(id) plotOutput(ns("hist")) }, - filters = "ADSL" + filters = "new_iris" ) ), - title = "App title", - filter = list(ADSL = structure(list(AGE = list()), filterable = c("AGE", "SEX", "RACE"))), - header = tags$h1("Sample App"), - footer = tags$p("Copyright 2017 - 2020") + title = "App title" ) if (interactive()) { shinyApp(app$ui, app$server) diff --git a/man/ui_nested_tabs.Rd b/man/ui_nested_tabs.Rd index 9c86fcf67b..72c11f98cf 100644 --- a/man/ui_nested_tabs.Rd +++ b/man/ui_nested_tabs.Rd @@ -47,8 +47,8 @@ The \code{datasets} argument is required to resolve the teal arguments in an isolated context (with respect to reactivity) } \examples{ -mods <- teal:::get_dummy_modules() -datasets <- teal:::get_dummy_datasets() +mods <- teal:::example_modules() +datasets <- teal:::example_datasets() app <- shinyApp( ui = function() { tagList( diff --git a/man/ui_tabs_with_filters.Rd b/man/ui_tabs_with_filters.Rd index f0641913d5..d93ecf07c4 100644 --- a/man/ui_tabs_with_filters.Rd +++ b/man/ui_tabs_with_filters.Rd @@ -35,8 +35,8 @@ panel is inserted at the right of the modules at depth 1 and not at the leaves. } \examples{ -mods <- teal:::get_dummy_modules() -datasets <- teal:::get_dummy_datasets() +mods <- teal:::example_modules() +datasets <- teal:::example_datasets() app <- shinyApp( ui = function() { diff --git a/man/ui_teal.Rd b/man/ui_teal.Rd index 4531055729..cf8d025b23 100644 --- a/man/ui_teal.Rd +++ b/man/ui_teal.Rd @@ -52,8 +52,8 @@ Shiny session timeouts. It is written as a Shiny module so it can be added into other apps as well. } \examples{ -mods <- teal:::get_dummy_modules() -raw_data <- reactive(teal:::get_dummy_cdisc_data()) +mods <- teal:::example_modules() +raw_data <- reactive(teal:::example_cdisc_data()) app <- shinyApp( ui = function() { teal:::ui_teal("dummy") diff --git a/man/validate_has_data.Rd b/man/validate_has_data.Rd index 527b929fb0..00ca3ed5c5 100644 --- a/man/validate_has_data.Rd +++ b/man/validate_has_data.Rd @@ -31,22 +31,25 @@ infinite.} This function is a wrapper for \code{shiny::validate}. } \examples{ -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl - +library(teal) ui <- fluidPage( - sliderInput("obs", "Max Age", - min = 0, max = 100, value = 50 + sliderInput("len", "Max Length of Sepal", + min = 4.3, max = 7.9, value = 5 ), plotOutput("plot") ) server <- function(input, output) { output$plot <- renderPlot({ - ADSL_f <- ADSL[ADSL$AGE <= input$obs, ] - validate_has_data(ADSL_f, min_nrow = 10, complete = FALSE, msg = "Please adjust your Max Age") - - hist(ADSL_f$AGE, breaks = 5) + df <- iris[iris$Sepal.Length <= input$len, ] + validate_has_data( + iris_f, + min_nrow = 10, + complete = FALSE, + msg = "Please adjust Max Length of Sepal" + ) + + hist(iris_f$Sepal.Length, breaks = 5) }) } \dontrun{ diff --git a/man/validate_has_elements.Rd b/man/validate_has_elements.Rd index efb7b60c65..b708cd09ec 100644 --- a/man/validate_has_elements.Rd +++ b/man/validate_has_elements.Rd @@ -18,30 +18,31 @@ validate_has_elements(x, msg) This function is a wrapper for \code{shiny::validate}. } \examples{ -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl - +data <- data.frame( + id = c(1:10, 11:20, 1:10), + strata = rep(c("A", "B"), each = 15) +) ui <- fluidPage( - selectInput("ref_arm", "Select reference treatment", - choices = c("ARM A", "ARM B", "ARM X"), selected = "ARM A" + selectInput("ref1", "Select strata1 to compare", + choices = c("A", "B", "C"), selected = "A" ), - selectInput("comp_arm", "Select comparison treatment", - choices = c("ARM C", "ARM Y", "ARM Z"), selected = "ARM C" + selectInput("ref2", "Select strata2 to compare", + choices = c("A", "B", "C"), selected = "B" ), verbatimTextOutput("arm_summary") ) server <- function(input, output) { output$arm_summary <- renderText({ - ref_arm <- ADSL$ARMCD[input$ref_arm == ADSL$ARMCD] - comp_arm <- ADSL$ARMCD[input$comp_arm == ADSL$ARMCD] + sample_1 <- data$id[data$strata == input$ref1] + sample_2 <- data$id[data$strata == input$ref2] - validate_has_elements(ref_arm, "Need reference treatment.") - validate_has_elements(comp_arm, "Need comparison treatment.") + validate_has_elements(sample_1, "No subjects in strata1.") + validate_has_elements(sample_2, "No subjects in strata2.") paste0( - "Number of patients in: reference treatment=", - length(ref_arm), " comparions treatment=", length(comp_arm) + "Number of samples in: strata1=", length(sample_1), + " comparions strata2=", length(sample_2) ) }) } diff --git a/man/validate_has_variable.Rd b/man/validate_has_variable.Rd index 5794ecc53c..8837d86123 100644 --- a/man/validate_has_variable.Rd +++ b/man/validate_has_variable.Rd @@ -20,22 +20,24 @@ validate_has_variable(data, varname, msg) This function is a wrapper for \code{shiny::validate}. } \examples{ -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl - +data <- data.frame( + one = rep("a", length.out = 20), + two = rep(c("a", "b"), length.out = 20) +) ui <- fluidPage( - selectInput("arm", "Select treatment", - choices = c("ARM", "ARMCD", "ACTARM", "TRT"), - selected = "ARM", multiple = TRUE + selectInput( + "var", + "Select variable", + choices = c("one", "two", "three", "four"), + selected = "one" ), - verbatimTextOutput("arm_summary") + verbatimTextOutput("summary") ) server <- function(input, output) { - output$arm_summary <- renderText({ - validate_has_variable(ADSL, input$arm) - - paste0("Selected treatment variables: ", paste(input$arm, collapse = ", ")) + output$summary <- renderText({ + validate_has_variable(data, input$var) + paste0("Selected treatment variables: ", paste(input$var, collapse = ", ")) }) } \dontrun{ diff --git a/man/validate_in.Rd b/man/validate_in.Rd index 485ee32aaf..7fd90159e9 100644 --- a/man/validate_in.Rd +++ b/man/validate_in.Rd @@ -20,26 +20,21 @@ validate_in(x, choices, msg) This function is a wrapper for \code{shiny::validate}. } \examples{ -library(scda) - -ADSL <- synthetic_cdisc_data("latest")$adsl -ADRS <- synthetic_cdisc_data("latest")$adrs - ui <- fluidPage( selectInput( - "rsp", - "Select response parameter", - choices = c("BESRSPI", "INVET", "CBRSPI"), - selected = "BESRSPI", + "species", + "Select species", + choices = c("setosa", "versicolor", "virginica", "unknown species"), + selected = "setosa", multiple = FALSE ), - verbatimTextOutput("rsp_summary") + verbatimTextOutput("summary") ) server <- function(input, output) { - output$rsp_summary <- renderPrint({ - validate_in(input$rsp, ADRS$PARAMCD, "Parameter does not exist.") - nrow(ADRS[ADRS$PARAMCD == input$rsp, ]) + output$summary <- renderPrint({ + validate_in(input$species, iris$Species, "Species does not exist.") + nrow(iris[iris$Species == input$species, ]) }) } \dontrun{ diff --git a/man/validate_n_levels.Rd b/man/validate_n_levels.Rd index 485a2ab33a..f0661a47fb 100644 --- a/man/validate_n_levels.Rd +++ b/man/validate_n_levels.Rd @@ -26,26 +26,29 @@ or greater than \code{max_levels} the validation will fail. This function is a wrapper for \code{shiny::validate}. } \examples{ -library(scda) - -ADSL <- synthetic_cdisc_data("latest")$adsl - +data <- data.frame( + one = rep("a", length.out = 20), + two = rep(c("a", "b"), length.out = 20), + three = rep(c("a", "b", "c"), length.out = 20), + four = rep(c("a", "b", "c", "d"), length.out = 20), + stringsAsFactors = TRUE +) ui <- fluidPage( - selectInput("arm", "Select treatment", - choices = c("ARM", "ARMCD", "STUDYID"), selected = "ARM" + selectInput( + "var", + "Select variable", + choices = c("one", "two", "three", "four"), + selected = "one" ), - verbatimTextOutput("arm_summary") + verbatimTextOutput("summary") ) server <- function(input, output) { - output$arm_summary <- renderText({ - validate_n_levels(ADSL[[input$arm]], - min_levels = 2, max_levels = 15, - var_name = input$arm - ) + output$summary <- renderText({ + validate_n_levels(data[[input$var]], min_levels = 2, max_levels = 15, var_name = input$var) paste0( "Levels of selected treatment variable: ", - paste(levels(ADSL[[input$arm]]), + paste(levels(data[[input$var]]), collapse = ", " ) ) diff --git a/man/validate_no_intersection.Rd b/man/validate_no_intersection.Rd index 589533fbd0..87d0f61aaf 100644 --- a/man/validate_no_intersection.Rd +++ b/man/validate_no_intersection.Rd @@ -20,33 +20,35 @@ validate_no_intersection(x, y, msg) This function is a wrapper for \code{shiny::validate}. } \examples{ -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl +data <- data.frame( + id = c(1:10, 11:20, 1:10), + strata = rep(c("A", "B", "C"), each = 10) +) ui <- fluidPage( - selectInput("ref_arm", "Select reference treatment", - choices = c("ARM A", "ARM B", "ARM C"), - selected = "ARM A" + selectInput("ref1", "Select strata1 to compare", + choices = c("A", "B", "C"), + selected = "A" ), - selectInput("comp_arm", "Select comparison treatment", - choices = c("ARM A", "ARM B", "ARM C"), - selected = "ARM C" + selectInput("ref2", "Select strata2 to compare", + choices = c("A", "B", "C"), + selected = "B" ), - verbatimTextOutput("arm_summary") + verbatimTextOutput("summary") ) server <- function(input, output) { - output$arm_summary <- renderText({ - ref_arm <- ADSL$ARMCD[input$ref_arm == ADSL$ARMCD] - comp_arm <- ADSL$ARMCD[input$comp_arm == ADSL$ARMCD] + output$summary <- renderText({ + sample_1 <- data$id[data$strata == input$ref1] + sample_2 <- data$id[data$strata == input$ref2] validate_no_intersection( - comp_arm, ref_arm, - "reference and comparison treatments cannot overlap" + sample_1, sample_2, + "subjects within strata1 and strata2 cannot overlap" ) paste0( - "Number of patients in: reference treatment=", length(ref_arm), - " comparions treatment=", length(comp_arm) + "Number of subject in: reference treatment=", length(sample_1), + " comparions treatment=", length(sample_2) ) }) } diff --git a/man/validate_one_row_per_id.Rd b/man/validate_one_row_per_id.Rd index 0c61a4f70a..f84e61e62f 100644 --- a/man/validate_one_row_per_id.Rd +++ b/man/validate_one_row_per_id.Rd @@ -18,22 +18,23 @@ validate_one_row_per_id(x, key = c("USUBJID", "STUDYID")) This function is a wrapper for \code{shiny::validate}. } \examples{ -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl - +iris$id <- rep(1:50, times = 3) ui <- fluidPage( - sliderInput("obs", "Max Age", - min = 0, max = 100, value = 50 + selectInput( + inputId = "species", + label = "Select species", + choices = c("setosa", "versicolor", "virginica"), + selected = "setosa", + multiple = TRUE ), - verbatimTextOutput("age_summary") + plotOutput("plot") ) - server <- function(input, output) { - output$age_summary <- renderText({ - ADSL_f <- ADSL[ADSL$AGE <= input$obs, ] - validate_one_row_per_id(ADSL_f, key = c("STUDYID")) + output$plot <- renderPlot({ + iris_f <- iris[iris$Species \%in\% input$species, ] + validate_one_row_per_id(iris_f, key = c("id")) - paste0("Mean age :", mean(ADSL_f$AGE)) + hist(iris_f$Sepal.Length, breaks = 5) }) } \dontrun{ diff --git a/staged_dependencies.yaml b/staged_dependencies.yaml index b24868f40a..6ec27ef219 100644 --- a/staged_dependencies.yaml +++ b/staged_dependencies.yaml @@ -24,12 +24,6 @@ upstream_repos: insightsengineering/teal.reporter: repo: insightsengineering/teal.reporter host: https://github.com - insightsengineering/scda: - repo: insightsengineering/scda - host: https://github.com - insightsengineering/scda.2022: - repo: insightsengineering/scda.2022 - host: https://github.com downstream_repos: insightsengineering/teal.modules.general: repo: insightsengineering/teal.modules.general diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 90e4b36eef..98a70272ad 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -4,7 +4,7 @@ adsl_dataset <- teal.data::cdisc_dataset( "ADSL", adsl_df, parent = character(0), keys = teal.data::get_cdisc_keys("ADSL") ) -mods <- teal:::get_dummy_modules() +mods <- teal:::example_modules() testthat::test_that("init data accepts TealData objects", { teal_data_object <- teal.data::teal_data(dataset_1) @@ -18,7 +18,7 @@ testthat::test_that("init data throws an error with input other than accepted in numeric_vector <- c(1, 2, 3) matrix_d <- as.matrix(c(1, 2, 3)) teal_data_list <- list(teal.data::teal_data(dataset_1)) - mods <- teal:::get_dummy_modules() + mods <- teal:::example_modules() testthat::expect_error(init(data = character_vector, modules = mods)) testthat::expect_error(init(data = numeric_vector, modules = mods)) testthat::expect_error(init(data = numeric_vector, modules = mods)) diff --git a/vignettes/including-adam-data-in-teal.Rmd b/vignettes/including-adam-data-in-teal.Rmd index e5ed82db8d..0988ec976f 100644 --- a/vignettes/including-adam-data-in-teal.Rmd +++ b/vignettes/including-adam-data-in-teal.Rmd @@ -31,11 +31,15 @@ shown below. ```{r, message=FALSE} library(teal) -library(scda) # using cdisc_dataset, keys are automatically derived for standard datanames # (although they can be overwritten) -adsl <- synthetic_cdisc_data("latest")$adsl +adsl <- data.frame( + STUDYID = "study", + USUBJID = 1:10, + SEX = sample(c("F", "M"), 10, replace = TRUE), + AGE = rpois(10, 40) +) dataset_adsl <- cdisc_dataset("ADSL", adsl) class(dataset_adsl) ``` @@ -50,12 +54,44 @@ specified. Keys are automatically added if `dataname` matches one of the impleme example: ```{r, message=FALSE} -adsl <- synthetic_cdisc_data("latest")$adsl -adtte <- synthetic_cdisc_data("latest")$adtte +adsl <- data.frame( + STUDYID = "study", + USUBJID = 1:10, + SEX = sample(c("F", "M"), 10, replace = TRUE), + AGE = rpois(10, 40) +) +adtte <- rbind(adsl, adsl, adsl) +adtte$PARAMCD <- rep(c("OS", "EFS", "PFS"), each = 10) +adtte$AVAL <- c( + rnorm(10, mean = 700, sd = 200), # dummy OS level + rnorm(10, mean = 400, sd = 100), # dummy EFS level + rnorm(10, mean = 450, sd = 200) # dummy PFS level +) cdisc_data_obj <- cdisc_data( - cdisc_dataset(dataname = "ADSL", x = adsl, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"), - cdisc_dataset(dataname = "ADTTE", x = adtte, code = "ADTTE <- synthetic_cdisc_data(\"latest\")$adtte") + cdisc_dataset( + dataname = "ADSL", + x = adsl, + code = ' + adsl <- data.frame( + STUDYID = "study", + USUBJID = 1:10, + SEX = sample(c("F", "M"), 10, replace = TRUE), + AGE = rpois(10, 40) + )' + ), + cdisc_dataset( + dataname = "ADTTE", + x = adtte, + code = ' + adtte <- rbind(adsl, adsl, adsl) + adtte$PARAMCD <- rep(c("OS", "EFS", "PFS"), each = 10) + adtte$AVAL <- c( + rnorm(10, mean = 700, sd = 200), + rnorm(10, mean = 400, sd = 100), + rnorm(10, mean = 450, sd = 200) + )' + ) ) class(cdisc_data_obj) @@ -64,15 +100,27 @@ example_data <- cdisc_data( cdisc_dataset( dataname = "ADSL", x = adsl, - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl", + code = ' + adsl <- data.frame( + STUDYID = "study", + USUBJID = 1:10, + SEX = sample(c("F", "M"), 10, replace = TRUE), + AGE = rpois(10, 40) + )', keys = c("STUDYID", "USUBJID") ), cdisc_dataset( dataname = "ADTTE", x = adtte, - code = "ADTTE <- synthetic_cdisc_data(\"latest\")$adtte", - parent = "ADSL", - keys = c("USUBJID", "STUDYID", "PARAMCD") + code = ' + adtte <- rbind(adsl, adsl, adsl) + adtte$PARAMCD <- rep(c("OS", "EFS", "PFS"), each = 10) + adtte$AVAL <- c( + rnorm(10, mean = 700, sd = 200), + rnorm(10, mean = 400, sd = 100), + rnorm(10, mean = 450, sd = 200) + )', + keys = c("STUDYID", "USUBJID", "PARAMCD") ), join_keys = join_keys( join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")), diff --git a/vignettes/preprocessing-data.Rmd b/vignettes/preprocessing-data.Rmd index acbb5f1a96..2f4c2a8a0c 100644 --- a/vignettes/preprocessing-data.Rmd +++ b/vignettes/preprocessing-data.Rmd @@ -29,18 +29,14 @@ To complete the above example try the code below (**NOTE # Code needs modification before it can be run: # - save as app.R # for the purpose of example save the file to current directory -library(scda) library(teal) -synthetic_cdisc_data("latest")$adsl -saveRDS(synthetic_cdisc_data("latest")$adsl, "adsl.rds") + # code> -adsl <- readRDS("adsl.rds") +new_iris <- transform(iris, id = seq_len(nrow(iris))) # # data import -adsl <- synthetic_cdisc_data("latest")$adsl +new_iris <- transform(iris, id = seq_len(nrow(iris))) excluded_obj1 <- 1:10 # nocode @@ -65,6 +60,8 @@ excluded_obj1 <- 1:10 # nocode excluded_obj2 <- 1:10 #