diff --git a/.Rbuildignore b/.Rbuildignore index a262382cf..f8c83ef87 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -28,6 +28,7 @@ SECURITY.md ^Jenkinsfile$ ^logs$ ^Makefile$ +^man/roxygen$ ^man-roxygen$ ^Meta$ ^outputdir$ @@ -40,6 +41,7 @@ SECURITY.md ^staged_dependencies\.yaml$ ^\.gitlab-ci\.yml$ ^LICENSE\.md$ +LICENSE coverage.* ^sample_files$ ^\.pre-commit-config\.yaml diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md index 31cb149c9..9683864a4 100644 --- a/.github/CONTRIBUTING.md +++ b/.github/CONTRIBUTING.md @@ -130,7 +130,7 @@ The package maintainer also reserves the right to adjust the criteria to recogni If you have further questions regarding the contribution guidelines, please contact the package/repository maintainer. -[docs]: https://insightsengineering.github.io/teal.modules.general/index.html -[articles]: https://insightsengineering.github.io/teal.modules.general/main/articles/index.html -[license]: https://insightsengineering.github.io/teal.modules.general/main/LICENSE-text.html +[docs]: https://insightsengineering.github.io/teal.modules.general/latest-tag/ +[articles]: https://insightsengineering.github.io/teal.modules.general/latest-tag/articles/index.html +[license]: https://insightsengineering.github.io/teal.modules.general/latest-tag/LICENSE-text.html [insights]: https://github.com/insightsengineering/teal.modules.general/pulse diff --git a/.github/ISSUE_TEMPLATE/bug.yml b/.github/ISSUE_TEMPLATE/bug.yml index 9143772f7..406469fc4 100644 --- a/.github/ISSUE_TEMPLATE/bug.yml +++ b/.github/ISSUE_TEMPLATE/bug.yml @@ -33,7 +33,7 @@ body: id: code-of-conduct attributes: label: Code of Conduct - description: By submitting this issue, you agree to follow our [Code of Conduct.](https://insightsengineering.github.io/teal.modules.general/CODE_OF_CONDUCT.html) + description: By submitting this issue, you agree to follow our [Code of Conduct.](https://insightsengineering.github.io/teal.modules.general/latest-tag/CODE_OF_CONDUCT.html) options: - label: I agree to follow this project's Code of Conduct. required: true @@ -41,7 +41,7 @@ body: id: contributor-guidelines attributes: label: Contribution Guidelines - description: By submitting this issue, you agree to follow our [Contribution Guidelines.](https://insightsengineering.github.io/teal.modules.general/CONTRIBUTING.html) + description: By submitting this issue, you agree to follow our [Contribution Guidelines.](https://insightsengineering.github.io/teal.modules.general/latest-tag/CONTRIBUTING.html) options: - label: I agree to follow this project's Contribution Guidelines. required: true diff --git a/.github/ISSUE_TEMPLATE/feature.yml b/.github/ISSUE_TEMPLATE/feature.yml index 84ec822de..c2731f8d6 100644 --- a/.github/ISSUE_TEMPLATE/feature.yml +++ b/.github/ISSUE_TEMPLATE/feature.yml @@ -13,7 +13,7 @@ body: id: code-of-conduct attributes: label: Code of Conduct - description: By submitting this issue, you agree to follow our [Code of Conduct.](https://insightsengineering.github.io/teal.modules.general/CODE_OF_CONDUCT.html) + description: By submitting this issue, you agree to follow our [Code of Conduct.](https://insightsengineering.github.io/teal.modules.general/latest-tag/CODE_OF_CONDUCT.html) options: - label: I agree to follow this project's Code of Conduct. required: true @@ -21,7 +21,7 @@ body: id: contributor-guidelines attributes: label: Contribution Guidelines - description: By submitting this issue, you agree to follow our [Contribution Guidelines.](https://insightsengineering.github.io/teal.modules.general/CONTRIBUTING.html) + description: By submitting this issue, you agree to follow our [Contribution Guidelines.](https://insightsengineering.github.io/teal.modules.general/latest-tag/CONTRIBUTING.html) options: - label: I agree to follow this project's Contribution Guidelines. required: true diff --git a/.github/ISSUE_TEMPLATE/question.yml b/.github/ISSUE_TEMPLATE/question.yml index 4c3628c1f..f6ad4b62b 100644 --- a/.github/ISSUE_TEMPLATE/question.yml +++ b/.github/ISSUE_TEMPLATE/question.yml @@ -13,7 +13,7 @@ body: id: code-of-conduct attributes: label: Code of Conduct - description: By submitting this issue, you agree to follow our [Code of Conduct.](https://insightsengineering.github.io/teal.modules.general/CODE_OF_CONDUCT.html) + description: By submitting this issue, you agree to follow our [Code of Conduct.](https://insightsengineering.github.io/teal.modules.general/latest-tag/CODE_OF_CONDUCT.html) options: - label: I agree to follow this project's Code of Conduct. required: true @@ -21,7 +21,7 @@ body: id: contributor-guidelines attributes: label: Contribution Guidelines - description: By submitting this issue, you agree to follow our [Contribution Guidelines.](https://insightsengineering.github.io/teal.modules.general/CONTRIBUTING.html) + description: By submitting this issue, you agree to follow our [Contribution Guidelines.](https://insightsengineering.github.io/teal.modules.general/latest-tag/CONTRIBUTING.html) options: - label: I agree to follow this project's Contribution Guidelines. required: true diff --git a/.lintr b/.lintr index 0a0bb22f3..b2279e658 100644 --- a/.lintr +++ b/.lintr @@ -2,5 +2,5 @@ linters: linters_with_defaults( line_length_linter = line_length_linter(120), cyclocomp_linter = NULL, object_usage_linter = NULL, - indentation_linter = NULL + object_name_linter = object_name_linter(styles = c("snake_case", "symbols"), regexes = c(ANL = "^ANL_?[0-9A-Z_]*$", ADaM = "^r?AD[A-Z]{2,3}_?[0-9]*$")) ) diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 2cef103a9..7c6a34ca8 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -18,8 +18,8 @@ repos: - ggmosaic - ggplot2 - shiny - - shinyTree - - insightsengineering/teal + - teal + - teal.transform - checkmate - dplyr - DT @@ -27,9 +27,9 @@ repos: - ggrepel - grid - logger - - magrittr - scales - shinyjs + - shinyTree - shinyvalidate - shinyWidgets - stats @@ -39,12 +39,10 @@ repos: - insightsengineering/teal.logger - insightsengineering/teal.reporter - insightsengineering/teal.slice - - insightsengineering/teal.transform - insightsengineering/teal.widgets - tern - tibble - tidyr - - tidyselect - utils - id: spell-check diff --git a/DESCRIPTION b/DESCRIPTION index 4dc7e3897..d345d5641 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Type: Package Package: teal.modules.general -Title: General Modules to Add to a `teal` Application +Title: General Modules for 'teal' Applications Version: 0.2.16.9029 Date: 2024-02-28 Authors@R: c( @@ -13,8 +13,11 @@ Authors@R: c( person("Nikolas", "Burkoff", role = "aut"), person("F. Hoffmann-La Roche AG", role = c("cph", "fnd")) ) -Description: General Purpose Teal Modules. -License: Apache License 2.0 | file LICENSE +Description: Prebuilt 'shiny' modules containing tools for viewing data, + visualizing data, understanding missing and outlier values within your + data and performing simple data analysis. This extends 'teal' + framework that supports reproducible research and analysis. +License: Apache License 2.0 URL: https://insightsengineering.github.io/teal.modules.general/, https://github.com/insightsengineering/teal.modules.general/ BugReports: @@ -24,7 +27,6 @@ Depends: ggplot2 (>= 3.4.0), R (>= 3.6), shiny (>= 1.6.0), - shinyTree, teal (>= 0.14.0.9027), teal.transform (>= 0.4.0.9011) Imports: @@ -34,21 +36,22 @@ Imports: forcats (>= 1.0.0), grid, logger (>= 0.2.0), - magrittr (>= 1.5), scales, shinyjs, + shinyTree (>= 0.2.8), shinyvalidate, shinyWidgets (>= 0.5.1), stats, stringr (>= 1.4.1), teal.code (>= 0.4.1.9009), + teal.data (>= 0.3.0.9018), teal.logger (>= 0.1.1), teal.reporter (>= 0.2.0), teal.widgets (>= 0.4.0), tern (>= 0.7.10), tibble (>= 2.0.0), tidyr (>= 0.8.3), - tidyselect, + tools, utils Suggests: broom (>= 0.7.10), @@ -64,24 +67,23 @@ Suggests: knitr (>= 1.42), lattice (>= 0.18-4), MASS, - methods, nestcolor (>= 0.1.0), rlang (>= 1.0.0), rtables (>= 0.5.1), sparkline, - teal.data (>= 0.3.0.9018), testthat (>= 3.0.4) VignetteBuilder: knitr Config/Needs/verdepcheck: haleyjeppson/ggmosaic, tidyverse/ggplot2, - rstudio/shiny, shinyTree/shinyTree, insightsengineering/teal, + rstudio/shiny, insightsengineering/teal, insightsengineering/teal.transform, mllg/checkmate, tidyverse/dplyr, rstudio/DT, tidyverse/forcats, - daroczig/logger, tidyverse/magrittr, r-lib/scales, daattali/shinyjs, + daroczig/logger, r-lib/scales, daattali/shinyjs, + shinyTree/shinyTree, rstudio/shinyvalidate, dreamRs/shinyWidgets, tidyverse/stringr, - insightsengineering/teal.code, insightsengineering/teal.logger, - insightsengineering/teal.reporter, insightsengineering/teal.transform, + insightsengineering/teal.code, insightsengineering/teal.data, + insightsengineering/teal.logger, insightsengineering/teal.reporter, insightsengineering/teal.widgets, insightsengineering/tern, - tidyverse/tibble, tidyverse/tidyr, r-lib/tidyselect, tidymodels/broom, + tidyverse/tibble, tidyverse/tidyr, tidymodels/broom, daattali/colourpicker, daattali/ggExtra, aphalo/ggpmisc, aphalo/ggpp, slowkow/ggrepel, baddstats/goftest, gridExtra, ramnathv/htmlwidgets, jeroen/jsonlite, yihui/knitr, deepayan/lattice, MASS, diff --git a/NAMESPACE b/NAMESPACE index 28e4e2d48..86c4c2a5a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,7 +28,6 @@ export(tm_variable_browser) import(ggmosaic) import(ggplot2) import(shiny) -import(shinyTree) import(teal) import(teal.transform) -importFrom(magrittr,"%>%") +importFrom(dplyr,"%>%") diff --git a/R/data.R b/R/data.R index 55670eebe..0f8a64e04 100644 --- a/R/data.R +++ b/R/data.R @@ -1,64 +1,39 @@ #' Random adverse events -#' -#' @description Random adverse events #' @docType data -#' #' @usage rADAE -#' #' @keywords datasets internal -#' #' @source internal #' @name rADAE "rADAE" #' Random lab analysis -#' -#' @description Random lab analysis #' @docType data -#' #' @usage rADLB -#' #' @keywords datasets internal -#' #' @source internal #' @name rADLB "rADLB" #' Random response -#' -#' @description Random response #' @docType data -#' #' @usage rADRS -#' #' @keywords datasets internal -#' #' @source internal #' @name rADRS "rADRS" #' Random patient listing -#' -#' @description Random patient listing #' @docType data -#' #' @usage rADSL -#' #' @keywords datasets internal -#' #' @source internal #' @name rADSL "rADSL" -#' Random Time to Event Analysis Dataset -#' -#' @description Random Time to Event Analysis Dataset +#' Random time to event analysis dataset #' @docType data -#' #' @usage rADTTE -#' #' @keywords datasets internal -#' #' @source internal #' @name rADTTE "rADTTE" diff --git a/R/teal.modules.general.R b/R/teal.modules.general.R index 74c5d52c2..82f61a562 100644 --- a/R/teal.modules.general.R +++ b/R/teal.modules.general.R @@ -1,4 +1,4 @@ -#' teal.modules.general: General modules to add to a teal application +#' `teal.modules.general`: General modules to add to a `teal` application #' #' The modules in this package are generic modules that should work with any data set #' (not necessarily for clinical trials data). @@ -6,10 +6,9 @@ #' @import ggplot2 #' @import ggmosaic #' @import shiny -#' @import shinyTree #' @import teal #' @import teal.transform -#' @importFrom magrittr %>% +#' @importFrom dplyr %>% #' #' #' @name teal.modules.general @@ -19,7 +18,7 @@ # nolint start # Note ggmosaic (version <= 0.3.3) needs to be in DEPENDS as the following does not work if it is imported # df <- data.frame(x = c("A", "B", "C", "A"), y = c("Z", "Z", "W", "W")) -# ggplot(df) + ggmosaic::geom_mosaic(aes(x = ggmosaic::product(x), fill = y)) +# ggplot(df) + ggmosaic::geom_mosaic(aes(x = ggmosaic::product(x), fill = y)) # nolint end # Needed to avoid R CMD note on no visible binding diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 8543aa66a..e629b7b25 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -1,32 +1,33 @@ -#' Principal component analysis module -#' @md +#' `teal` module: Principal component analysis +#' +#' Module conducts principal component analysis (PCA) on a given dataset and offers different +#' ways of visualizing the outcomes, including elbow plot, circle plot, biplot, and eigenvector plot. +#' Additionally, it enables dynamic customization of plot aesthetics, such as opacity, size, and +#' font size, through UI inputs. #' #' @inheritParams teal::module #' @inheritParams shared_params #' @param dat (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Columns used to compute PCA. -#' @param alpha optional, (`numeric`) If scalar then the plot points will have a fixed opacity. If a -#' slider should be presented to adjust the plot point opacity dynamically then it can be a vector of -#' length three with `c(value, min, max)`. -#' @param size optional, (`numeric`) If scalar then the plot point sizes will have a fixed size. -#' If a slider should be presented to adjust the plot point sizes dynamically then it can be a -#' vector of length three with `c(value, min, max)`. -#' @param font_size optional, (`numeric`) font size control for title, x-axis label, y-axis label and legend. -#' If scalar then the font size will have a fixed size. If a slider should be presented to adjust the plot -#' point sizes dynamically then it can be a vector of length three with `c(value, min, max)`. -#' +#' specifying columns used to compute PCA. +#' @param font_size (`numeric`) optional, specifies font size. +#' It controls the font size for plot titles, axis labels, and legends. +#' - If vector of `length == 1` then the font sizes will have a fixed size. +#' - while vector of `value`, `min`, and `max` allows dynamic adjustment. #' @templateVar ggnames "Elbow plot", "Circle plot", "Biplot", "Eigenvector plot" #' @template ggplot2_args_multi #' +#' @inherit shared_params return +#' #' @examples -#' # general data example #' library(teal.widgets) #' +#' # general data example #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' USArrests <- USArrests #' }) +#' #' datanames(data) <- "USArrests" #' #' app <- init( @@ -51,17 +52,14 @@ #' ) #' ) #' ) -#' #' if (interactive()) { #' shinyApp(app$ui, app$server) #' } #' #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' }) #' datanames(data) <- "ADSL" @@ -70,7 +68,7 @@ #' app <- init( #' data = data, #' modules = modules( -#' teal.modules.general::tm_a_pca( +#' tm_a_pca( #' "PCA", #' dat = data_extract_spec( #' dataname = "ADSL", @@ -89,7 +87,6 @@ #' ) #' ) #' ) -#' #' if (interactive()) { #' shinyApp(app$ui, app$server) #' } @@ -109,14 +106,38 @@ tm_a_pca <- function(label = "Principal Component Analysis", pre_output = NULL, post_output = NULL) { logger::log_info("Initializing tm_a_pca") + + # Normalize the parameters if (inherits(dat, "data_extract_spec")) dat <- list(dat) if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args) + # Start of assertions checkmate::assert_string(label) checkmate::assert_list(dat, types = "data_extract_spec") + + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) + checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") + checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) + checkmate::assert_numeric( + plot_width[1], + lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" + ) + ggtheme <- match.arg(ggtheme) + + plot_choices <- c("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot") + checkmate::assert_list(ggplot2_args, types = "ggplot2_args") + checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + checkmate::assert_flag(rotate_xaxis_labels) + if (length(font_size) == 1) { + checkmate::assert_numeric(font_size, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20) + } else { + checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20) + checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size") + } + if (length(alpha) == 1) { checkmate::assert_numeric(alpha, any.missing = FALSE, finite = TRUE, lower = 0, upper = 1) } else { @@ -131,25 +152,11 @@ tm_a_pca <- function(label = "Principal Component Analysis", checkmate::assert_numeric(size[1], lower = size[2], upper = size[3], .var.name = "size") } - if (length(font_size) == 1) { - checkmate::assert_numeric(font_size, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20) - } else { - checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE, lower = 8, upper = 20) - checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size") - } - - checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) - checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") - checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) - checkmate::assert_numeric( - plot_width[1], - lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" - ) - - plot_choices <- c("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot") - checkmate::assert_list(ggplot2_args, types = "ggplot2_args") - checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions + # Make UI args args <- as.list(environment()) data_extract_list <- list(dat = dat) @@ -171,7 +178,7 @@ tm_a_pca <- function(label = "Principal Component Analysis", ) } - +# UI function for the PCA module ui_a_pca <- function(id, ...) { ns <- NS(id) args <- list(...) @@ -282,6 +289,7 @@ ui_a_pca <- function(id, ...) { ) } +# Server function for the PCA module srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") @@ -383,7 +391,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl standardization <- input$standardization center <- standardization %in% c("center", "center_scale") scale <- standardization == "center_scale" - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] teal::validate_has_data(ANL, 10) validate(need( @@ -414,7 +422,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl standardization <- input$standardization center <- standardization %in% c("center", "center_scale") scale <- standardization == "center_scale" - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] qenv <- teal.code::eval_code( merged$anl_q_r(), @@ -427,7 +435,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl if (na_action == "drop") { qenv <- teal.code::eval_code( qenv, - quote(ANL <- tidyr::drop_na(ANL, keep_columns)) # nolint: object_name. + quote(ANL <- tidyr::drop_na(ANL, keep_columns)) ) } @@ -649,7 +657,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl plot_biplot <- function(base_q) { qenv <- base_q - ANL <- qenv[["ANL"]] # nolint: object_name. + ANL <- qenv[["ANL"]] resp_col <- as.character(merged$anl_input_r()$columns_source$response) dat_cols <- as.character(merged$anl_input_r()$columns_source$dat) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index e71209ce5..f2e1f8220 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1,20 +1,21 @@ -#' Scatterplot and Regression Model -#' @md +#' `teal` module: Scatterplot and regression analysis +#' +#' Module for visualizing regression analysis, including scatterplots and +#' various regression diagnostics plots. +#' It allows users to explore the relationship between a set of regressors and a response variable, +#' visualize residuals, and identify outliers. +#' +#' @note For more examples, please see the vignette "Using regression plots" via +#' `vignette("using-regression-plots", package = "teal.modules.general")`. #' #' @inheritParams teal::module #' @inheritParams shared_params #' @param regressor (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Regressor variables from an incoming dataset with filtering and selecting. +#' Regressor variables from an incoming dataset with filtering and selecting. #' @param response (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Response variables from an incoming dataset with filtering and selecting. -#' @param alpha optional, (`numeric`) If scalar then the plot points will have a fixed opacity. If a -#' slider should be presented to adjust the plot point opacity dynamically then it can be a vector of -#' length three with `c(value, min, max)`. -#' @param size optional, (`numeric`) If scalar then the plot point sizes will have a fixed size -#' If a slider should be presented to adjust the plot point sizes dynamically then it can be a -#' vector of length three with `c(value, min, max)`. -#' @param default_outlier_label optional, (`character`) The default column selected to label outliers. -#' @param default_plot_type optional, (`numeric`) Defaults to Response vs Regressor. +#' Response variables from an incoming dataset with filtering and selecting. +#' @param default_outlier_label (`character`) optional, default column selected to label outliers. +#' @param default_plot_type (`numeric`) optional, defaults to "Response vs Regressor". #' 1. Response vs Regressor #' 2. Residuals vs Fitted #' 3. Normal Q-Q @@ -39,8 +40,7 @@ #' @templateVar ggnames `r regression_names` #' @template ggplot2_args_multi #' -#' @note For more examples, please see the vignette "Using regression plots" via -#' `vignette("using-regression-plots", package = "teal.modules.general")`. +#' @inherit shared_params return #' #' @examples #' # general data example @@ -48,7 +48,7 @@ #' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' CO2 <- CO2 #' }) #' datanames(data) <- c("CO2") @@ -93,7 +93,7 @@ #' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' }) #' datanames(data) <- "ADSL" @@ -162,9 +162,7 @@ tm_a_regression <- function(label = "Regression Analysis", checkmate::assert_list(regressor, types = "data_extract_spec") checkmate::assert_list(response, types = "data_extract_spec") - if (!all(vapply(response, function(x) !(x$select$multiple), logical(1)))) { - stop("'response' should not allow multiple selection") - } + assert_single_selection(response) checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") @@ -203,7 +201,7 @@ tm_a_regression <- function(label = "Regression Analysis", checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) - checkmate::assert_integerish(default_plot_type, lower = 1, upper = 7) + checkmate::assert_choice(default_plot_type, seq.int(1L, length(plot_choices))) checkmate::assert_string(default_outlier_label) if (length(label_segment_threshold) == 1) { @@ -219,7 +217,7 @@ tm_a_regression <- function(label = "Regression Analysis", } # End of assertions - # Send ui args + # Make UI args args <- as.list(environment()) args[["plot_choices"]] <- plot_choices data_extract_list <- list( @@ -245,6 +243,7 @@ tm_a_regression <- function(label = "Regression Analysis", ) } +# UI function for the regression module ui_a_regression <- function(id, ...) { ns <- NS(id) args <- list(...) @@ -355,7 +354,7 @@ ui_a_regression <- function(id, ...) { ) } - +# Server function for the regression module srv_a_regression <- function(id, data, reporter, @@ -437,7 +436,7 @@ srv_a_regression <- function(id, # sets qenv object and populates it with data merge call and fit expression fit_r <- reactive({ - ANL <- anl_merged_q()[["ANL"]] # nolint: object_name. + ANL <- anl_merged_q()[["ANL"]] teal::validate_has_data(ANL, 10) validate(need(is.numeric(ANL[regression_var()$response][[1]]), "Response variable should be numeric.")) @@ -547,7 +546,7 @@ srv_a_regression <- function(id, plot_type_0 <- function() { fit <- fit_r()[["fit"]] - ANL <- anl_merged_q()[["ANL"]] # nolint: object_name. + ANL <- anl_merged_q()[["ANL"]] stopifnot(ncol(fit$model) == 2) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 770d6cfa2..9116fd34d 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -1,37 +1,39 @@ -#' Data Table Viewer Teal Module +#' `teal` module: Data table viewer #' -#' A data table viewer shows the data using a paginated table. -#' specifically designed for use with `data.frames`. -#' @md +#' Module provides a dynamic and interactive way to view `data.frame`s in a `teal` application. +#' It uses the `DT` package to display data tables in a paginated, searchable, and sortable format, +#' which helps to enhance data exploration and analysis. +#' +#' The `DT` package has an option `DT.TOJSON_ARGS` to show `Inf` and `NA` in data tables. +#' Configure the `DT.TOJSON_ARGS` option via +#' `options(DT.TOJSON_ARGS = list(na = "string"))` before running the module. +#' Note though that sorting of numeric columns with `NA`/`Inf` will be lexicographic not numerical. #' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param variables_selected (`list`) A named list of character vectors of the variables (i.e. columns) -#' which should be initially shown for each dataset. Names of list elements should correspond to the names -#' of the datasets available in the app. If no entry is specified for a dataset, the first six variables from that -#' dataset will initially be shown. +#' @param variables_selected (`named list`) Character vectors of the variables (i.e. columns) +#' which should be initially shown for each dataset. +#' Names of list elements should correspond to the names of the datasets available in the app. +#' If no entry is specified for a dataset, the first six variables from that +#' dataset will initially be shown. #' @param datasets_selected (`character`) A vector of datasets which should be -#' shown and in what order. Names in the vector have to correspond with datasets names. -#' If vector of length zero (default) then all datasets are shown. -#' Note: Only datasets of the `data.frame` class are compatible; -#' using other types will cause an error. -#' @param dt_args (named `list`) Additional arguments to be passed to `DT::datatable` -#' (must not include `data` or `options`). -#' @param dt_options (named `list`) The `options` argument to `DT::datatable`. By default -#' `list(searching = FALSE, pageLength = 30, lengthMenu = c(5, 15, 30, 100), scrollX = TRUE)` +#' shown and in what order. Names in the vector have to correspond with datasets names. +#' If vector of `length == 0` (default) then all datasets are shown. +#' Note: Only datasets of the `data.frame` class are compatible. +#' @param dt_args (`named list`) Additional arguments to be passed to [DT::datatable()] +#' (must not include `data` or `options`). +#' @param dt_options (`named list`) The `options` argument to `DT::datatable`. By default +#' `list(searching = FALSE, pageLength = 30, lengthMenu = c(5, 15, 30, 100), scrollX = TRUE)` #' @param server_rendering (`logical`) should the data table be rendered server side -#' (see `server` argument of `DT::renderDataTable()`) -#' @details -#' The `DT` package has an option `DT.TOJSON_ARGS` to show `Inf` and `NA` in data tables. If this is something -#' you require then set `options(DT.TOJSON_ARGS = list(na = "string"))` before running the module. -#' Note though that sorting of numeric columns with `NA`/`Inf` will be lexicographic not numerical. +#' (see `server` argument of [DT::renderDataTable()]) +#' +#' @inherit shared_params return #' #' @examples #' # general data example -#' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' iris <- iris #' }) #' datanames(data) <- c("iris") @@ -54,7 +56,7 @@ #' # CDISC data example #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' }) #' datanames(data) <- "ADSL" @@ -89,7 +91,10 @@ tm_data_table <- function(label = "Data Table", pre_output = NULL, post_output = NULL) { logger::log_info("Initializing tm_data_table") + + # Start of assertions checkmate::assert_string(label) + checkmate::assert_list(variables_selected, min.len = 0, types = "character", names = "named") if (length(variables_selected) > 0) { lapply(seq_along(variables_selected), function(i) { @@ -99,14 +104,17 @@ tm_data_table <- function(label = "Data Table", } }) } + checkmate::assert_character(datasets_selected, min.len = 0, min.chars = 1) - checkmate::assert_list(dt_options, names = "named") checkmate::assert( checkmate::check_list(dt_args, len = 0), checkmate::check_subset(names(dt_args), choices = names(formals(DT::datatable))) ) - + checkmate::assert_list(dt_options, names = "named") checkmate::assert_flag(server_rendering) + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions module( label, @@ -127,8 +135,7 @@ tm_data_table <- function(label = "Data Table", ) } - -# ui page module +# UI page module ui_page_data_table <- function(id, pre_output = NULL, post_output = NULL) { @@ -162,8 +169,7 @@ ui_page_data_table <- function(id, ) } - -# server page module +# Server page module srv_page_data_table <- function(id, data, datasets_selected, @@ -247,6 +253,7 @@ srv_page_data_table <- function(id, }) } +# UI function for the data_table module ui_data_table <- function(id, choices, selected) { @@ -276,6 +283,7 @@ ui_data_table <- function(id, ) } +# Server function for the data_table module srv_data_table <- function(id, data, dataname, @@ -301,7 +309,7 @@ srv_data_table <- function(id, teal::validate_has_data(df, min_nrow = 1L, msg = paste("data", dataname, "is empty")) dataframe_selected <- if (if_distinct()) { - dplyr::count(df, dplyr::across(tidyselect::all_of(variables))) + dplyr::count(df, dplyr::across(dplyr::all_of(variables))) } else { df[variables] } diff --git a/R/tm_file_viewer.R b/R/tm_file_viewer.R index deb5632a0..48ec04162 100644 --- a/R/tm_file_viewer.R +++ b/R/tm_file_viewer.R @@ -1,16 +1,17 @@ -#' File Viewer Teal Module +#' `teal` module: File viewer #' #' The file viewer module provides a tool to view static files. -#' Supported formats include text formats, \code{PDF}, \code{PNG}, \code{APNG}, -#' \code{JPEG}, \code{SVG}, \code{WEBP}, \code{GIF} and \code{BMP}. +#' Supported formats include text formats, `PDF`, `PNG` `APNG`, +#' `JPEG` `SVG`, `WEBP`, `GIF` and `BMP`. #' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param input_path optional, (`list`) of the input paths to either: specific files of accepted formats, -#' a directory or a URL. The paths can be specified as absolute paths or relative to the running -#' directory of the application. Will default to current working directory if not supplied. +#' @param input_path (`list`) of the input paths, optional. Each element can be: #' -#' @export +#' Paths can be specified as absolute paths or relative to the running directory of the application. +#' Default to the current working directory if not supplied. +#' +#' @inherit shared_params return #' #' @examples #' data <- teal_data() @@ -19,16 +20,15 @@ #' }) #' datanames(data) <- c("data") #' -#' app <- teal::init( +#' app <- init( #' data = data, -#' modules = teal::modules( -#' teal.modules.general::tm_file_viewer( +#' modules = modules( +#' tm_file_viewer( #' input_path = list( #' folder = system.file("sample_files", package = "teal.modules.general"), #' png = system.file("sample_files/sample_file.png", package = "teal.modules.general"), #' txt = system.file("sample_files/sample_file.txt", package = "teal.modules.general"), -#' url = -#' "https://www.fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" +#' url = "https://fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" #' ) #' ) #' ) @@ -37,28 +37,29 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @export +#' tm_file_viewer <- function(label = "File Viewer Module", input_path = list("Current Working Directory" = ".")) { logger::log_info("Initializing tm_file_viewer") - if (length(label) == 0 || identical(label, "")) { - label <- " " - } - if (length(input_path) == 0 || identical(input_path, "")) { - input_path <- list() - } + # Normalize the parameters + if (length(label) == 0 || identical(label, "")) label <- " " + if (length(input_path) == 0 || identical(input_path, "")) input_path <- list() + + # Start of assertions checkmate::assert_string(label) + checkmate::assert( checkmate::check_list(input_path, types = "character", min.len = 0), checkmate::check_character(input_path, min.len = 1) ) - if (length(input_path) > 0) { valid_url <- function(url_input, timeout = 2) { con <- try(url(url_input), silent = TRUE) check <- suppressWarnings(try(open.connection(con, open = "rt", timeout = timeout), silent = TRUE)[1]) try(close.connection(con), silent = TRUE) - ifelse(is.null(check), TRUE, FALSE) + is.null(check) } idx <- vapply(input_path, function(x) file.exists(x) || valid_url(x), logical(1)) @@ -76,8 +77,9 @@ tm_file_viewer <- function(label = "File Viewer Module", "No file or url paths were provided." ) } + # End of assertions - + # Make UI args args <- as.list(environment()) module( @@ -90,6 +92,7 @@ tm_file_viewer <- function(label = "File Viewer Module", ) } +# UI function for the file viewer module ui_viewer <- function(id, ...) { args <- list(...) ns <- NS(id) @@ -116,6 +119,7 @@ ui_viewer <- function(id, ...) { ) } +# Server function for the file viewer module srv_viewer <- function(id, input_path) { moduleServer(id, function(input, output, session) { temp_dir <- tempfile() diff --git a/R/tm_front_page.R b/R/tm_front_page.R index aa755d64f..ab251fc1d 100644 --- a/R/tm_front_page.R +++ b/R/tm_front_page.R @@ -1,31 +1,31 @@ -#' Front page module +#' `teal` module: Front page #' -#' @description This `teal` module creates a simple front page for `teal` applications +#' Creates a simple front page for `teal` applications, displaying +#' introductory text, tables, additional `html` or `shiny` tags, and footnotes. #' #' @inheritParams teal::module -#' @param header_text `character vector` text to be shown at the top of the module, for each -#' element, if named the name is shown first in bold as a header followed by the value. The first -#' element's header is displayed larger than the others -#' @param tables `named list of dataframes` tables to be shown in the module -#' @param additional_tags `shiny.tag.list` or `html` additional shiny tags or `html` to be included after the table, -#' for example to include an image, `tagList(tags$img(src = "image.png"))` or to include further `html`, -#' `HTML("html text here")` -#' @param footnotes `character vector` text to be shown at the bottom of the module, for each -#' element, if named the name is shown first in bold, followed by the value -#' @param show_metadata `logical` should the metadata of the datasets be available on the module? -#' @return A `teal` module to be used in `teal` applications -#' @export -#' @examples +#' @param header_text (`character` vector) text to be shown at the top of the module, for each +#' element, if named the name is shown first in bold as a header followed by the value. The first +#' element's header is displayed larger than the others. +#' @param tables (`named list` of `data.frame`s) tables to be shown in the module. +#' @param additional_tags (`shiny.tag.list` or `html`) additional `shiny` tags or `html` to be included after the table, +#' for example to include an image, `tagList(tags$img(src = "image.png"))` or to include further `html`, +#' `HTML("html text here")`. +#' @param footnotes (`character` vector) of text to be shown at the bottom of the module, for each +#' element, if named the name is shown first in bold, followed by the value. +#' @param show_metadata (`logical`) indicating whether the metadata of the datasets be available on the module. #' +#' @inherit shared_params return +#' +#' @examples #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) -#' ADSL <- teal.modules.general::rADSL +#' require(nestcolor) +#' ADSL <- rADSL #' attr(ADSL, "metadata") <- list("Author" = "NEST team", "data_source" = "synthetic data") #' }) -#' datanames <- c("ADSL") -#' datanames(data) <- datanames -#' join_keys(data) <- default_cdisc_join_keys[datanames] +#' datanames(data) <- "ADSL" +#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] #' #' table_1 <- data.frame(Info = c("A", "B"), Text = c("A", "B")) #' table_2 <- data.frame(`Column 1` = c("C", "D"), `Column 2` = c(5.5, 6.6), `Column 3` = c("A", "B")) @@ -37,10 +37,10 @@ #' "Table 3" = table_3 #' ) #' -#' app <- teal::init( +#' app <- init( #' data = data, -#' modules = teal::modules( -#' teal.modules.general::tm_front_page( +#' modules = modules( +#' tm_front_page( #' header_text = c( #' "Important information" = "It can go here.", #' "Other information" = "Can go here." @@ -54,23 +54,31 @@ #' header = tags$h1("Sample Application"), #' footer = tags$p("Application footer"), #' ) +#' #' if (interactive()) { #' shinyApp(app$ui, app$server) #' } +#' +#' @export +#' tm_front_page <- function(label = "Front page", header_text = character(0), tables = list(), additional_tags = tagList(), footnotes = character(0), show_metadata = FALSE) { + logger::log_info("Initializing tm_front_page") + + # Start of assertions checkmate::assert_string(label) checkmate::assert_character(header_text, min.len = 0, any.missing = FALSE) checkmate::assert_list(tables, types = "data.frame", names = "named", any.missing = FALSE) checkmate::assert_multi_class(additional_tags, classes = c("shiny.tag.list", "html")) checkmate::assert_character(footnotes, min.len = 0, any.missing = FALSE) checkmate::assert_flag(show_metadata) + # End of assertions - logger::log_info("Initializing tm_front_page") + # Make UI args args <- as.list(environment()) module( @@ -83,6 +91,7 @@ tm_front_page <- function(label = "Front page", ) } +# UI function for the front page module ui_front_page <- function(id, ...) { args <- list(...) ns <- NS(id) @@ -121,6 +130,52 @@ ui_front_page <- function(id, ...) { ) } +# Server function for the front page module +srv_front_page <- function(id, data, tables, show_metadata) { + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") + moduleServer(id, function(input, output, session) { + ns <- session$ns + + lapply(seq_along(tables), function(idx) { + output[[paste0("table_", idx)]] <- renderTable( + tables[[idx]], + bordered = TRUE, + caption = names(tables)[idx], + caption.placement = "top" + ) + }) + + if (show_metadata) { + observeEvent( + input$metadata_button, showModal( + modalDialog( + title = "Metadata", + dataTableOutput(ns("metadata_table")), + size = "l", + easyClose = TRUE + ) + ) + ) + + metadata_data_frame <- reactive({ + datanames <- teal.data::datanames(data()) + convert_metadata_to_dataframe( + lapply(datanames, function(dataname) attr(data()[[dataname]], "metadata")), + datanames + ) + }) + + output$metadata_table <- renderDataTable({ + validate(need(nrow(metadata_data_frame()) > 0, "The data has no associated metadata")) + metadata_data_frame() + }) + } + }) +} + +## utils functions + get_header_tags <- function(header_text) { if (length(header_text) == 0) { return(list()) @@ -167,49 +222,6 @@ get_footer_tags <- function(footnotes) { }, bold_text = bold_texts, value = footnotes) } -srv_front_page <- function(id, data, tables, show_metadata) { - checkmate::assert_class(data, "reactive") - checkmate::assert_class(isolate(data()), "teal_data") - moduleServer(id, function(input, output, session) { - ns <- session$ns - - lapply(seq_along(tables), function(idx) { - output[[paste0("table_", idx)]] <- renderTable( - tables[[idx]], - bordered = TRUE, - caption = names(tables)[idx], - caption.placement = "top" - ) - }) - - if (show_metadata) { - observeEvent( - input$metadata_button, showModal( - modalDialog( - title = "Metadata", - dataTableOutput(ns("metadata_table")), - size = "l", - easyClose = TRUE - ) - ) - ) - - metadata_data_frame <- reactive({ - datanames <- teal.data::datanames(data()) - convert_metadata_to_dataframe( - lapply(datanames, function(dataname) attr(data()[[dataname]], "metadata")), - datanames - ) - }) - - output$metadata_table <- renderDataTable({ - validate(need(nrow(metadata_data_frame()) > 0, "The data has no associated metadata")) - metadata_data_frame() - }) - } - }) -} - # take a list of metadata, one item per dataset (raw_metadata each element from datasets$get_metadata()) # and the corresponding datanames and output a data.frame with columns {Dataset, Name, Value}. # which are, the Dataset the metadata came from, the metadata's name and value diff --git a/R/tm_g_association.R b/R/tm_g_association.R index 64fe28ffc..f0cfc6479 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -1,30 +1,37 @@ -#' Stack Plots of variables and show association with reference variable -#' @md +#' `teal` module: Stack plots of variables and show association with reference variable +#' +#' Module provides functionality for visualizing the distribution of variables and +#' their association with a reference variable. +#' It supports configuring the appearance of the plots, including themes and whether to show associations. +#' +#' +#' @note For more examples, please see the vignette "Using association plot" via +#' `vignette("using-association-plot", package = "teal.modules.general")`. #' #' @inheritParams teal::module #' @inheritParams shared_params #' @param ref (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' reference variable, must set `multiple = FALSE`. +#' Reference variable, must accepts a `data_extract_spec` with `select_spec(multiple = FALSE)` +#' to ensure single selection option. #' @param vars (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' associated variables. -#' @param show_association optional, (`logical`) Whether show association of `vars` -#' with reference variable. Defaults to `TRUE`. -#' @param distribution_theme,association_theme optional, (`character`) `ggplot2` themes to be used by default. -#' Default to `"gray"`. +#' Variables to be associated with the reference variable. +#' @param show_association (`logical`) optional, whether show association of `vars` +#' with reference variable. Defaults to `TRUE`. +#' @param distribution_theme,association_theme (`character`) optional, `ggplot2` themes to be used by default. +#' Default to `"gray"`. #' #' @templateVar ggnames "Bivariate1", "Bivariate2" #' @template ggplot2_args_multi #' -#' @note For more examples, please see the vignette "Using association plot" via -#' \code{vignette("using-association-plot", package = "teal.modules.general")}. +#' @inherit shared_params return #' #' @examples -#' # general data exapmle #' library(teal.widgets) #' +#' # general data example #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' CO2 <- CO2 #' factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) #' CO2[factors] <- lapply(CO2[factors], as.character) @@ -65,11 +72,9 @@ #' } #' #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' }) #' datanames(data) <- "ADSL" @@ -128,17 +133,23 @@ tm_g_association <- function(label = "Association", post_output = NULL, ggplot2_args = teal.widgets::ggplot2_args()) { logger::log_info("Initializing tm_g_association") + + # Normalize the parameters if (inherits(ref, "data_extract_spec")) ref <- list(ref) if (inherits(vars, "data_extract_spec")) vars <- list(vars) if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args) + # Start of assertions checkmate::assert_string(label) + checkmate::assert_list(ref, types = "data_extract_spec") if (!all(vapply(ref, function(x) !x$select$multiple, logical(1)))) { stop("'ref' should not allow multiple selection") } + checkmate::assert_list(vars, types = "data_extract_spec") checkmate::assert_flag(show_association) + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) @@ -146,12 +157,19 @@ tm_g_association <- function(label = "Association", plot_width[1], lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" ) + distribution_theme <- match.arg(distribution_theme) association_theme <- match.arg(association_theme) + + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + plot_choices <- c("Bivariate1", "Bivariate2") checkmate::assert_list(ggplot2_args, types = "ggplot2_args") checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + # End of assertions + # Make UI args args <- as.list(environment()) data_extract_list <- list( @@ -172,6 +190,7 @@ tm_g_association <- function(label = "Association", ) } +# UI function for the association module ui_tm_g_association <- function(id, ...) { ns <- NS(id) args <- list(...) @@ -249,6 +268,7 @@ ui_tm_g_association <- function(id, ...) { ) } +# Server function for the association module srv_tm_g_association <- function(id, data, reporter, @@ -306,7 +326,7 @@ srv_tm_g_association <- function(id, output_q <- reactive({ teal::validate_inputs(iv_r()) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] teal::validate_has_data(ANL, 3) vars_names <- merged$anl_input_r()$columns_source$vars diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 963fa846c..e9a7b111b 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -1,55 +1,58 @@ -#' Univariate and bivariate visualizations -#' @md +#' `teal` module: Univariate and bivariate visualizations +#' +#' Module enables the creation of univariate and bivariate plots, +#' facilitating the exploration of data distributions and relationships between two variables. +#' +#' This is a general module to visualize 1 & 2 dimensional data. +#' +#' @note +#' For more examples, please see the vignette "Using bivariate plot" via +#' `vignette("using-bivariate-plot", package = "teal.modules.general")`. #' #' @inheritParams teal::module #' @inheritParams shared_params #' @param x (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variable names selected to plot along the x-axis by default. Variable can be numeric, factor or character. -#' No empty selections are allowed! +#' Variable names selected to plot along the x-axis by default. +#' Can be numeric, factor or character. +#' No empty selections are allowed. #' @param y (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variable names selected to plot along the y-axis by default. Variable can be numeric, factor or character. -#' @param use_density optional, (`logical`) value for whether density (`TRUE`) is plotted or -#' frequency (`FALSE`). Defaults to frequency (`FALSE`). -#' @param row_facet optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variables for row facetting. -#' @param col_facet optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variables for col facetting. -#' @param facet optional, (`logical`) to specify whether the facet encodings `ui` elements are toggled -#' on and shown to the user by default. Defaults to `TRUE` if either `row_facet` or `column_facet` -#' are supplied. +#' Variable names selected to plot along the y-axis by default. +#' Can be numeric, factor or character. +#' @param use_density (`logical`) optional, indicates whether to plot density (`TRUE`) or frequency (`FALSE`). +#' Defaults to frequency (`FALSE`). +#' @param row_facet (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specification of the data variable(s) to use for faceting rows. +#' @param col_facet (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specification of the data variable(s) to use for faceting columns. +#' @param facet (`logical`) optional, specifies whether the facet encodings `ui` elements are toggled +#' on and shown to the user by default. Defaults to `TRUE` if either `row_facet` or `column_facet` +#' are supplied. #' @param color_settings (`logical`) Whether coloring, filling and size should be applied #' and `UI` tool offered to the user. -#' @param color optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variables selected for the outline color inside the coloring settings. -#' It will be applied when `color_settings` is set to `TRUE`. -#' @param fill optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variables selected for the fill color inside the coloring settings. -#' It will be applied when `color_settings` is set to `TRUE`. -#' @param size optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variables selected for the size of `geom_point` plots inside the coloring settings. -#' It will be applied when `color_settings` is set to `TRUE`. -#' @param free_x_scales optional, (`logical`) Whether X scaling shall be changeable. -#' Does not allow scaling to be changed by default (`FALSE`). -#' @param free_y_scales optional, (`logical`) Whether Y scaling shall be changeable. -#' Does not allow scaling to be changed by default (`FALSE`). -#' @param swap_axes optional, (`logical`) Whether to swap X and Y axes. Defaults to `FALSE`. +#' @param color (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specification of the data variable(s) selected for the outline color inside the coloring settings. +#' It will be applied when `color_settings` is set to `TRUE`. +#' @param fill (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specification of the data variable(s) selected for the fill color inside the coloring settings. +#' It will be applied when `color_settings` is set to `TRUE`. +#' @param size (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specification of the data variable(s) selected for the size of `geom_point` plots inside the coloring settings. +#' It will be applied when `color_settings` is set to `TRUE`. +#' @param free_x_scales (`logical`) optional, whether X scaling shall be changeable. +#' Does not allow scaling to be changed by default (`FALSE`). +#' @param free_y_scales (`logical`) optional, whether Y scaling shall be changeable. +#' Does not allow scaling to be changed by default (`FALSE`). +#' @param swap_axes (`logical`) optional, whether to swap X and Y axes. Defaults to `FALSE`. #' -#' @details -#' This is a general module to visualize 1 & 2 dimensional data. -#' -#' @note -#' For more examples, please see the vignette "Using bivariate plot" via -#' `vignette("using-bivariate-plot", package = "teal.modules.general")`. -#' -#' @export +#' @inherit shared_params return #' #' @examples -#' # general data exapmle #' library(teal.widgets) #' +#' # general data example #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' CO2 <- data.frame(CO2) #' }) #' datanames(data) <- c("CO2") @@ -108,11 +111,9 @@ #' #' #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' }) #' datanames(data) <- c("ADSL") @@ -168,6 +169,9 @@ #' if (interactive()) { #' shinyApp(app$ui, app$server) #' } +#' +#' @export +#' tm_g_bivariate <- function(label = "Bivariate Plots", x, y, @@ -190,6 +194,8 @@ tm_g_bivariate <- function(label = "Bivariate Plots", pre_output = NULL, post_output = NULL) { logger::log_info("Initializing tm_g_bivariate") + + # Normalize the parameters if (inherits(x, "data_extract_spec")) x <- list(x) if (inherits(y, "data_extract_spec")) y <- list(y) if (inherits(row_facet, "data_extract_spec")) row_facet <- list(row_facet) @@ -198,52 +204,36 @@ tm_g_bivariate <- function(label = "Bivariate Plots", if (inherits(fill, "data_extract_spec")) fill <- list(fill) if (inherits(size, "data_extract_spec")) size <- list(size) + # Start of assertions + checkmate::assert_string(label) + checkmate::assert_list(x, types = "data_extract_spec") - if (!all(vapply(x, function(x) !x$select$multiple, logical(1)))) { - stop("'x' should not allow multiple selection") - } + assert_single_selection(x) + checkmate::assert_list(y, types = "data_extract_spec") - if (!all(vapply(y, function(x) !x$select$multiple, logical(1)))) { - stop("'y' should not allow multiple selection") - } + assert_single_selection(y) + checkmate::assert_list(row_facet, types = "data_extract_spec", null.ok = TRUE) - if (!all(vapply(row_facet, function(x) !x$select$multiple, logical(1)))) { - stop("'row_facet' should not allow multiple selection") - } + assert_single_selection(row_facet) + checkmate::assert_list(col_facet, types = "data_extract_spec", null.ok = TRUE) - if (!all(vapply(col_facet, function(x) !x$select$multiple, logical(1)))) { - stop("'col_facet' should not allow multiple selection") - } + assert_single_selection(col_facet) + + checkmate::assert_flag(facet) + checkmate::assert_list(color, types = "data_extract_spec", null.ok = TRUE) - if (!all(vapply(color, function(x) !x$select$multiple, logical(1)))) { - stop("'color' should not allow multiple selection") - } + assert_single_selection(color) + checkmate::assert_list(fill, types = "data_extract_spec", null.ok = TRUE) - if (!all(vapply(fill, function(x) !x$select$multiple, logical(1)))) { - stop("'fill' should not allow multiple selection") - } + assert_single_selection(fill) + checkmate::assert_list(size, types = "data_extract_spec", null.ok = TRUE) - if (!all(vapply(size, function(x) !x$select$multiple, logical(1)))) { - stop("'size' should not allow multiple selection") - } + assert_single_selection(size) - ggtheme <- match.arg(ggtheme) - checkmate::assert_string(label) checkmate::assert_flag(use_density) - checkmate::assert_flag(color_settings) - checkmate::assert_flag(free_x_scales) - checkmate::assert_flag(free_y_scales) - checkmate::assert_flag(rotate_xaxis_labels) - checkmate::assert_flag(swap_axes) - checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) - checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") - checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) - checkmate::assert_numeric( - plot_width[1], - lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" - ) - checkmate::assert_class(ggplot2_args, "ggplot2_args") + # Determines color, fill & size if they are not explicitly set + checkmate::assert_flag(color_settings) if (color_settings) { if (is.null(color)) { color <- x @@ -263,6 +253,28 @@ tm_g_bivariate <- function(label = "Bivariate Plots", } } + checkmate::assert_flag(free_x_scales) + checkmate::assert_flag(free_y_scales) + + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) + checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") + checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) + checkmate::assert_numeric( + plot_width[1], + lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" + ) + + checkmate::assert_flag(rotate_xaxis_labels) + checkmate::assert_flag(swap_axes) + + ggtheme <- match.arg(ggtheme) + checkmate::assert_class(ggplot2_args, "ggplot2_args") + + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions + + # Make UI args args <- as.list(environment()) data_extract_list <- list( @@ -289,6 +301,7 @@ tm_g_bivariate <- function(label = "Bivariate Plots", ) } +# UI function for the bivariate module ui_g_bivariate <- function(id, ...) { args <- list(...) is_single_dataset_value <- teal.transform::is_single_dataset( @@ -429,7 +442,7 @@ ui_g_bivariate <- function(id, ...) { ) } - +# Server function for the bivariate module srv_g_bivariate <- function(id, data, reporter, @@ -522,7 +535,7 @@ srv_g_bivariate <- function(id, output_q <- reactive({ teal::validate_inputs(iv_r()) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] teal::validate_has_data(ANL, 3) x_col_vec <- as.vector(merged$anl_input_r()$columns_source$x) @@ -581,8 +594,7 @@ srv_g_bivariate <- function(id, size <- NULL } - - teal::validate_has_data(ANL[, c(x_name, y_name)], 3, complete = TRUE, allow_inf = FALSE) + teal::validate_has_data(ANL[, c(x_name, y_name), drop = FALSE], 3, complete = TRUE, allow_inf = FALSE) cl <- bivariate_plot_call( data_name = "ANL", @@ -710,15 +722,7 @@ srv_g_bivariate <- function(id, }) } - -#' Get Substituted ggplot call -#' -#' @noRd -#' -#' @examples -#' -#' bivariate_plot_call("ANL", "BAGE", "RACE", "numeric", "factor") -#' bivariate_plot_call("ANL", "BAGE", character(0), "numeric", "NULL") +# Get Substituted ggplot call bivariate_plot_call <- function(data_name, x = character(0), y = character(0), @@ -767,36 +771,8 @@ bivariate_plot_call <- function(data_name, ) } -substitute_q <- function(x, env) { - stopifnot(is.language(x)) - call <- substitute(substitute(x, env), list(x = x)) - eval(call) -} - - -#' Create ggplot part of plot call -#' -#' Due to the type of the x and y variable the plot type is chosen -#' -#' @noRd -#' -#' @examples -#' bivariate_ggplot_call("numeric", "NULL") -#' bivariate_ggplot_call("numeric", "NULL", freq = FALSE) -#' -#' bivariate_ggplot_call("NULL", "numeric") -#' bivariate_ggplot_call("NULL", "numeric", freq = FALSE) -#' -#' bivariate_ggplot_call("NULL", "factor") -#' bivariate_ggplot_call("NULL", "factor", freq = FALSE) -#' -#' bivariate_ggplot_call("factor", "NULL") -#' bivariate_ggplot_call("factor", "NULL", freq = FALSE) -#' -#' bivariate_ggplot_call("numeric", "numeric") -#' bivariate_ggplot_call("numeric", "factor") -#' bivariate_ggplot_call("factor", "numeric") -#' bivariate_ggplot_call("factor", "factor") +# Create ggplot part of plot call +# Due to the type of the x and y variable the plot type is chosen bivariate_ggplot_call <- function(x_class, y_class, freq = TRUE, @@ -982,19 +958,10 @@ bivariate_ggplot_call <- function(x_class, plot_call <- reduce_plot_call(plot_call, quote(coord_flip())) } - return(plot_call) + plot_call } - -#' Create facet call -#' -#' @noRd -#' -#' @examples -#' -#' facet_ggplot_call(LETTERS[1:3]) -#' facet_ggplot_call(NULL, LETTERS[23:26]) -#' facet_ggplot_call(LETTERS[1:3], LETTERS[23:26]) +# Create facet call facet_ggplot_call <- function(row_facet = character(0), col_facet = character(0), free_x_scales = FALSE, @@ -1029,38 +996,67 @@ coloring_ggplot_call <- function(colour, fill, size, is_point = FALSE) { - if (!identical(colour, character(0)) && !identical(fill, character(0)) && - is_point && !identical(size, character(0))) { + if ( + !identical(colour, character(0)) && + !identical(fill, character(0)) && + is_point && + !identical(size, character(0)) + ) { substitute( expr = aes(colour = colour_name, fill = fill_name, size = size_name), env = list(colour_name = as.name(colour), fill_name = as.name(fill), size_name = as.name(size)) ) - } else if (identical(colour, character(0)) && !identical(fill, character(0)) && - is_point && identical(size, character(0))) { + } else if ( + identical(colour, character(0)) && + !identical(fill, character(0)) && + is_point && + identical(size, character(0)) + ) { substitute(expr = aes(fill = fill_name), env = list(fill_name = as.name(fill))) - } else if (!identical(colour, character(0)) && !identical(fill, character(0)) && - (!is_point || identical(size, character(0)))) { + } else if ( + !identical(colour, character(0)) && + !identical(fill, character(0)) && + (!is_point || identical(size, character(0))) + ) { substitute( expr = aes(colour = colour_name, fill = fill_name), env = list(colour_name = as.name(colour), fill_name = as.name(fill)) ) - } else if (!identical(colour, character(0)) && identical(fill, character(0)) && - (!is_point || identical(size, character(0)))) { + } else if ( + !identical(colour, character(0)) && + identical(fill, character(0)) && + (!is_point || identical(size, character(0))) + ) { substitute(expr = aes(colour = colour_name), env = list(colour_name = as.name(colour))) - } else if (identical(colour, character(0)) && !identical(fill, character(0)) && - (!is_point || identical(size, character(0)))) { + } else if ( + identical(colour, character(0)) && + !identical(fill, character(0)) && + (!is_point || identical(size, character(0))) + ) { substitute(expr = aes(fill = fill_name), env = list(fill_name = as.name(fill))) - } else if (identical(colour, character(0)) && identical(fill, character(0)) && - is_point && !identical(size, character(0))) { + } else if ( + identical(colour, character(0)) && + identical(fill, character(0)) && + is_point && + !identical(size, character(0)) + ) { substitute(expr = aes(size = size_name), env = list(size_name = as.name(size))) - } else if (!identical(colour, character(0)) && identical(fill, character(0)) && - is_point && !identical(size, character(0))) { + } else if ( + !identical(colour, character(0)) && + identical(fill, character(0)) && + is_point && + !identical(size, character(0)) + ) { substitute( expr = aes(colour = colour_name, size = size_name), env = list(colour_name = as.name(colour), size_name = as.name(size)) ) - } else if (identical(colour, character(0)) && !identical(fill, character(0)) && - is_point && !identical(size, character(0))) { + } else if ( + identical(colour, character(0)) && + !identical(fill, character(0)) && + is_point && + !identical(size, character(0)) + ) { substitute( expr = aes(colour = colour_name, fill = fill_name, size = size_name), env = list(colour_name = as.name(fill), fill_name = as.name(fill), size_name = as.name(size)) diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R index 8b603ec62..0044eafdd 100644 --- a/R/tm_g_distribution.R +++ b/R/tm_g_distribution.R @@ -1,33 +1,36 @@ -#' Distribution Module -#' @md +#' `teal` module: Distribution analysis #' -#' @details -#' Module to analyze and explore univariate variable distribution +#' Module is designed to explore the distribution of a single variable within a given dataset. +#' It offers several tools, such as histograms, Q-Q plots, and various statistical tests to +#' visually and statistically analyze the variable's distribution. #' #' @inheritParams teal::module #' @inheritParams teal.widgets::standard_layout #' @inheritParams shared_params #' #' @param dist_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Variable to consider for the distribution analysis. +#' Variable(s) for which the distribution will be analyzed. #' @param strata_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Categorical variable to split the selected distribution variable on. -#' @param group_var optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Which data columns to use for faceting rows. -#' @param freq optional, (`logical`) Whether to display frequency (`TRUE`) or density (`FALSE`). -#' Defaults to density (`FALSE`). -#' @param bins optional, (`integer(1)` or `integer(3)`) If scalar then the histogram bins will have a fixed size. -#' If a slider should be presented to adjust the number of histogram bins dynamically then it can be a -#' vector of length three with `c(value, min, max)`. -#' Defaults to `c(30L, 1L, 100L)`. +#' Categorical variable used to split the distribution analysis. +#' @param group_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) +#' Variable used for faceting plot into multiple panels. +#' @param freq (`logical`) optional, whether to display frequency (`TRUE`) or density (`FALSE`). +#' Defaults to density (`FALSE`). +#' @param bins (`integer(1)` or `integer(3)`) optional, specifies the number of bins for the histogram. +#' - When the length of `bins` is one: The histogram bins will have a fixed size based on the `bins` provided. +#' - When the length of `bins` is three: The histogram bins are dynamically adjusted based on vector of `value`, `min`, +#' and `max`. +#' Defaults to `c(30L, 1L, 100L)`. #' #' @templateVar ggnames "Histogram", "QQplot" #' @template ggplot2_args_multi #' +#' @inherit shared_params return +#' #' @examples -#' # general data example #' library(teal.widgets) #' +#' # general data example #' data <- teal_data() #' data <- within(data, { #' iris <- iris @@ -53,8 +56,6 @@ #' } #' #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { #' ADSL <- rADSL @@ -120,6 +121,7 @@ tm_g_distribution <- function(label = "Distribution Module", post_output = NULL) { logger::log_info("Initializing tm_g_distribution") + # Requires Suggested packages extra_packages <- c("ggpmisc", "ggpp", "goftest", "MASS", "broom") missing_packages <- Filter(function(x) !requireNamespace(x, quietly = TRUE), extra_packages) if (length(missing_packages) > 0L) { @@ -129,28 +131,47 @@ tm_g_distribution <- function(label = "Distribution Module", )) } + # Normalize the parameters if (inherits(dist_var, "data_extract_spec")) dist_var <- list(dist_var) if (inherits(strata_var, "data_extract_spec")) strata_var <- list(strata_var) if (inherits(group_var, "data_extract_spec")) group_var <- list(group_var) if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args) - ggtheme <- match.arg(ggtheme) - if (length(bins) == 1) { - checkmate::assert_numeric(bins, any.missing = FALSE, lower = 1) - } else { - checkmate::assert_numeric(bins, len = 3, any.missing = FALSE, lower = 1) - checkmate::assert_numeric(bins[1], lower = bins[2], upper = bins[3], .var.name = "bins") - } + # Start of assertions checkmate::assert_string(label) + checkmate::assert_list(dist_var, "data_extract_spec") - checkmate::assert_false(dist_var[[1]]$select$multiple) + checkmate::assert_false(dist_var[[1L]]$select$multiple) + checkmate::assert_list(strata_var, types = "data_extract_spec", null.ok = TRUE) checkmate::assert_list(group_var, types = "data_extract_spec", null.ok = TRUE) checkmate::assert_flag(freq) + ggtheme <- match.arg(ggtheme) + plot_choices <- c("Histogram", "QQplot") checkmate::assert_list(ggplot2_args, types = "ggplot2_args") checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + if (length(bins) == 1) { + checkmate::assert_numeric(bins, any.missing = FALSE, lower = 1) + } else { + checkmate::assert_numeric(bins, len = 3, any.missing = FALSE, lower = 1) + checkmate::assert_numeric(bins[1], lower = bins[2], upper = bins[3], .var.name = "bins") + } + + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) + checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") + checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) + checkmate::assert_numeric( + plot_width[1], + lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" + ) + + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions + + # Make UI args args <- as.list(environment()) data_extract_list <- list( @@ -172,6 +193,7 @@ tm_g_distribution <- function(label = "Distribution Module", ) } +# UI function for the distribution module ui_distribution <- function(id, ...) { args <- list(...) ns <- NS(id) @@ -317,6 +339,7 @@ ui_distribution <- function(id, ...) { ) } +# Server function for the distribution module srv_distribution <- function(id, data, reporter, @@ -495,7 +518,7 @@ srv_distribution <- function(id, ) } - ANL <- merged$anl_q_r()[[as.character(dist_var[[1]]$dataname)]] # nolint: object_name. + ANL <- merged$anl_q_r()[[as.character(dist_var[[1]]$dataname)]] params <- get_dist_params(as.numeric(stats::na.omit(ANL[[dist_var2]])), input$t_dist) params_vec <- round(unname(unlist(params)), 2) params_names <- names(params) @@ -535,7 +558,7 @@ srv_distribution <- function(id, common_q <- reactive({ # Create a private stack for this function only. - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] dist_var <- merge_vars()$dist_var s_var <- merge_vars()$s_var g_var <- merge_vars()$g_var @@ -562,7 +585,7 @@ srv_distribution <- function(id, qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL[[g_var]] <- forcats::fct_na_value_to_level(as.factor(ANL[[g_var]]), "NA"), # nolint: object_name. + expr = ANL[[g_var]] <- forcats::fct_na_value_to_level(as.factor(ANL[[g_var]]), "NA"), env = list(g_var = g_var) ) ) @@ -578,7 +601,7 @@ srv_distribution <- function(id, qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL[[s_var]] <- forcats::fct_na_value_to_level(as.factor(ANL[[s_var]]), "NA"), # nolint: object_name. + expr = ANL[[s_var]] <- forcats::fct_na_value_to_level(as.factor(ANL[[s_var]]), "NA"), env = list(s_var = s_var) ) ) @@ -804,8 +827,13 @@ srv_distribution <- function(id, ) } - if (length(s_var) == 0 && length(g_var) == 0 && main_type_var == "Density" && - length(t_dist) != 0 && main_type_var == "Density") { + if ( + length(s_var) == 0 && + length(g_var) == 0 && + main_type_var == "Density" && + length(t_dist) != 0 && + main_type_var == "Density" + ) { map_dist <- stats::setNames( c("dnorm", "dlnorm", "dgamma", "dunif"), c("normal", "lognormal", "gamma", "unif") @@ -996,7 +1024,7 @@ srv_distribution <- function(id, }, valueExpr = { # Create a private stack for this function only. - ANL <- common_q()[["ANL"]] # nolint: object_name. + ANL <- common_q()[["ANL"]] dist_var <- merge_vars()$dist_var s_var <- merge_vars()$s_var diff --git a/R/tm_g_response.R b/R/tm_g_response.R index 692f25487..f8dd3010b 100644 --- a/R/tm_g_response.R +++ b/R/tm_g_response.R @@ -1,28 +1,43 @@ -#' Response Plots -#' @md +#' `teal` module: Response plot +#' +#' Generates a response plot for a given `response` and `x` variables. +#' This module allows users customize and add annotations to the plot depending +#' on the module's arguments. +#' It supports showing the counts grouped by other variable facets (by row / column), +#' swapping the coordinates, show count annotations and displaying the response plot +#' as frequency or density. #' #' @inheritParams teal::module #' @inheritParams shared_params #' @param response (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Which variable to use as the response. You can define one fixed column by using the -#' setting `fixed = TRUE` inside the `select_spec`. -#' `data_extract_spec` must not allow multiple selection in this case. +#' Which variable to use as the response. +#' You can define one fixed column by setting `fixed = TRUE` inside the `select_spec`. +#' +#' The `data_extract_spec` must not allow multiple selection in this case. #' @param x (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Which variable to use on the X-axis of the response plot. Allow the user to select multiple -#' columns from the `data` allowed in teal. -#' `data_extract_spec` must not allow multiple selection in this case. -#' @param row_facet optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Which data columns to use for faceting rows. -#' @param col_facet optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Which data to use for faceting columns. -#' @param coord_flip optional, (`logical`) Whether to flip coordinates between `x` and `response`. -#' @param count_labels optional, (`logical`) Whether to show count labels. -#' Defaults to `TRUE`. -#' @param freq optional, (`logical`) Whether to display frequency (`TRUE`) or density (`FALSE`). -#' Defaults to density (`FALSE`). +#' Specifies which variable to use on the X-axis of the response plot. +#' Allow the user to select multiple columns from the `data` allowed in teal. +#' +#' The `data_extract_spec` must not allow multiple selection in this case. +#' @param row_facet (`data_extract_spec` or `list` of multiple `data_extract_spec`) +#' optional specification of the data variable(s) to use for faceting rows. +#' @param col_facet (`data_extract_spec` or `list` of multiple `data_extract_spec`) +#' optional specification of the data variable(s) to use for faceting columns. +#' @param coord_flip (`logical(1)`) +#' Indicates whether to flip coordinates between `x` and `response`. +#' The default value is `FALSE` and it will show the `x` variable on the x-axis +#' and the `response` variable on the y-axis. +#' @param count_labels (`logical(1)`) +#' Indicates whether to show count labels. +#' Defaults to `TRUE`. +#' @param freq (`logical(1)`) +#' Indicates whether to display frequency (`TRUE`) or density (`FALSE`). +#' Defaults to density (`FALSE`). +#' +#' @inherit shared_params return #' #' @note For more examples, please see the vignette "Using response plot" via -#' \code{vignette("using-response-plot", package = "teal.modules.general")}. +#' `vignette("using-response-plot", package = "teal.modules.general")`. #' #' @examples #' # general data example @@ -30,7 +45,7 @@ #' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' mtcars <- mtcars #' for (v in c("cyl", "vs", "am", "gear")) { #' mtcars[[v]] <- as.factor(mtcars[[v]]) @@ -78,7 +93,7 @@ #' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' }) #' datanames(data) <- c("ADSL") @@ -137,32 +152,35 @@ tm_g_response <- function(label = "Response Plot", pre_output = NULL, post_output = NULL) { logger::log_info("Initializing tm_g_response") + + # Normalize the parameters if (inherits(response, "data_extract_spec")) response <- list(response) if (inherits(x, "data_extract_spec")) x <- list(x) if (inherits(row_facet, "data_extract_spec")) row_facet <- list(row_facet) if (inherits(col_facet, "data_extract_spec")) col_facet <- list(col_facet) + + # Start of assertions checkmate::assert_string(label) - ggtheme <- match.arg(ggtheme) + checkmate::assert_list(response, types = "data_extract_spec") if (!all(vapply(response, function(x) !("" %in% x$select$choices), logical(1)))) { stop("'response' should not allow empty values") } - if (!all(vapply(response, function(x) !x$select$multiple, logical(1)))) { - stop("'response' should not allow multiple selection") - } + assert_single_selection(response) + checkmate::assert_list(x, types = "data_extract_spec") if (!all(vapply(x, function(x) !("" %in% x$select$choices), logical(1)))) { stop("'x' should not allow empty values") } - if (!all(vapply(x, function(x) !x$select$multiple, logical(1)))) { - stop("'x' should not allow multiple selection") - } + assert_single_selection(x) + checkmate::assert_list(row_facet, types = "data_extract_spec", null.ok = TRUE) checkmate::assert_list(col_facet, types = "data_extract_spec", null.ok = TRUE) checkmate::assert_flag(coord_flip) checkmate::assert_flag(count_labels) checkmate::assert_flag(rotate_xaxis_labels) checkmate::assert_flag(freq) + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) @@ -171,8 +189,14 @@ tm_g_response <- function(label = "Response Plot", lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" ) + ggtheme <- match.arg(ggtheme) checkmate::assert_class(ggplot2_args, "ggplot2_args") + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions + + # Make UI args args <- as.list(environment()) data_extract_list <- list( @@ -195,6 +219,7 @@ tm_g_response <- function(label = "Response Plot", ) } +# UI function for the response module ui_g_response <- function(id, ...) { ns <- NS(id) args <- list(...) @@ -270,6 +295,7 @@ ui_g_response <- function(id, ...) { ) } +# Server function for the response module srv_g_response <- function(id, data, reporter, @@ -346,7 +372,7 @@ srv_g_response <- function(id, teal::validate_inputs(iv_r()) qenv <- merged$anl_q_r() - ANL <- qenv[["ANL"]] # nolint: object_name. + ANL <- qenv[["ANL"]] resp_var <- as.vector(merged$anl_input_r()$columns_source$response) x <- as.vector(merged$anl_input_r()$columns_source$x) @@ -383,7 +409,7 @@ srv_g_response <- function(id, qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL[[x]] <- with(ANL, forcats::fct_rev(x_cl)), # nolint: object_name. + expr = ANL[[x]] <- with(ANL, forcats::fct_rev(x_cl)), env = list(x = x, x_cl = x_cl) ) ) @@ -392,11 +418,10 @@ srv_g_response <- function(id, qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL[[resp_var]] <- factor(ANL[[resp_var]]), # nolint: object_name. + expr = ANL[[resp_var]] <- factor(ANL[[resp_var]]), env = list(resp_var = resp_var) ) ) %>% - # nolint start # rowf and colf will be a NULL if not set by a user teal.code::eval_code( substitute( @@ -416,12 +441,10 @@ srv_g_response <- function(id, env = list(x_cl = x_cl, rowf = rowf, colf = colf) ) ) - # nolint end plot_call <- substitute( - expr = - ggplot(ANL2, aes(x = x_cl, y = ns)) + - geom_bar(aes(fill = resp_cl), stat = "identity", position = arg_position), + expr = ggplot(ANL2, aes(x = x_cl, y = ns)) + + geom_bar(aes(fill = resp_cl), stat = "identity", position = arg_position), env = list( x_cl = x_cl, resp_cl = resp_cl, diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index f42c27445..50bf2f05b 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -1,45 +1,42 @@ -#' Create a simple scatterplot +#' `teal` module: Scatterplot #' -#' Create a plot with the \code{\link{ggplot2}[geom_point]} function -#' @md +#' Generates a customizable scatterplot using `ggplot2`. +#' This module allows users to select variables for the x and y axes, +#' color and size encodings, faceting options, and more. It supports log transformations, +#' trend line additions, and dynamic adjustments of point opacity and size through UI controls. +#' +#' @note For more examples, please see the vignette "Using scatterplot" via +#' `vignette("using-scatterplot", package = "teal.modules.general")`. #' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param x (`data_extract_spec` or `list` of multiple `data_extract_spec`) Variable -#' names selected to plot along the x-axis by default. -#' @param y (`data_extract_spec` or `list` of multiple `data_extract_spec`) Variable -#' names selected to plot along the y-axis by default. -#' @param color_by optional (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Defines the color encoding. If `NULL` then no color encoding option will be displayed. -#' @param size_by optional (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Defines the point size encoding. If `NULL` then no size encoding option will be displayed. -#' @param row_facet optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Which data columns to use for faceting rows. -#' @param col_facet optional, (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Which data to use for faceting columns. -#' @param alpha optional, (`numeric`) If scalar then the plot points will have a fixed opacity. If a -#' slider should be presented to adjust the plot point opacity dynamically then it can be a vector of -#' length three with `c(value, min, max)`. -#' @param size optional, (`numeric`) If scalar then the plot point sizes will have a fixed size -#' If a slider should be presented to adjust the plot point sizes dynamically then it can be a -#' vector of length three with `c(value, min, max)`. -#' @param shape optional, (`character`) A character vector with the English names of the -#' shape, e.g. `c("triangle", "square", "circle")`. It defaults to `shape_names`. This is a complete list from -#' `vignette("ggplot2-specs", package="ggplot2")`. -#' @param max_deg optional, (`integer`) The maximum degree for the polynomial trend line. Must not be less than 1. -#' @param table_dec optional, (`integer`) Number of decimal places used to round numeric values in the table. +#' @param x (`data_extract_spec` or `list` of multiple `data_extract_spec`) Specifies +#' variable names selected to plot along the x-axis by default. +#' @param y (`data_extract_spec` or `list` of multiple `data_extract_spec`) Specifies +#' variable names selected to plot along the y-axis by default. +#' @param color_by (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' defines the color encoding. If `NULL` then no color encoding option will be displayed. +#' @param size_by (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' defines the point size encoding. If `NULL` then no size encoding option will be displayed. +#' @param row_facet (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specifies the variable(s) for faceting rows. +#' @param col_facet (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specifies the variable(s) for faceting columns. +#' @param shape (`character`) optional, character vector with the names of the +#' shape, e.g. `c("triangle", "square", "circle")`. It defaults to `shape_names`. This is a complete list from +#' `vignette("ggplot2-specs", package="ggplot2")`. +#' @param max_deg (`integer`) optional, maximum degree for the polynomial trend line. Must not be less than 1. +#' @param table_dec (`integer`) optional, number of decimal places used to round numeric values in the table. #' -#' -#' @note For more examples, please see the vignette "Using scatterplot" via -#' `vignette("using-scatterplot", package = "teal.modules.general")`. +#' @inherit shared_params return #' #' @examples -#' # general data example #' library(teal.widgets) #' +#' # general data example #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' CO2 <- CO2 #' }) #' datanames(data) <- "CO2" @@ -122,13 +119,10 @@ #' shinyApp(app$ui, app$server) #' } #' -#' #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' }) #' datanames(data) <- c("ADSL") @@ -235,6 +229,7 @@ tm_g_scatterplot <- function(label = "Scatterplot", ggplot2_args = teal.widgets::ggplot2_args()) { logger::log_info("Initializing tm_g_scatterplot") + # Requires Suggested packages extra_packages <- c("ggpmisc", "ggExtra", "colourpicker") missing_packages <- Filter(function(x) !requireNamespace(x, quietly = TRUE), extra_packages) if (length(missing_packages) > 0L) { @@ -244,6 +239,7 @@ tm_g_scatterplot <- function(label = "Scatterplot", )) } + # Normalize the parameters if (inherits(x, "data_extract_spec")) x <- list(x) if (inherits(y, "data_extract_spec")) y <- list(y) if (inherits(color_by, "data_extract_spec")) color_by <- list(color_by) @@ -252,26 +248,27 @@ tm_g_scatterplot <- function(label = "Scatterplot", if (inherits(col_facet, "data_extract_spec")) col_facet <- list(col_facet) if (is.double(max_deg)) max_deg <- as.integer(max_deg) - ggtheme <- match.arg(ggtheme) + # Start of assertions checkmate::assert_string(label) checkmate::assert_list(x, types = "data_extract_spec") checkmate::assert_list(y, types = "data_extract_spec") checkmate::assert_list(color_by, types = "data_extract_spec", null.ok = TRUE) checkmate::assert_list(size_by, types = "data_extract_spec", null.ok = TRUE) + checkmate::assert_list(row_facet, types = "data_extract_spec", null.ok = TRUE) + assert_single_selection(row_facet) + checkmate::assert_list(col_facet, types = "data_extract_spec", null.ok = TRUE) - checkmate::assert_list(row_facet, types = "data_extract_spec", null.ok = TRUE) - if (!all(vapply(row_facet, function(x) !x$select$multiple, logical(1)))) { - stop("'row_facet' should not allow multiple selection") - } - if (!all(vapply(col_facet, function(x) !x$select$multiple, logical(1)))) { - stop("'col_facet' should not allow multiple selection") - } - checkmate::assert_character(shape) + assert_single_selection(col_facet) + + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) + checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") + checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) + checkmate::assert_numeric( + plot_width[1], + lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" + ) - checkmate::assert_int(max_deg, lower = 1L) - checkmate::assert_scalar(table_dec) - checkmate::assert_flag(rotate_xaxis_labels) if (length(alpha) == 1) { checkmate::assert_numeric(alpha, any.missing = FALSE, finite = TRUE) } else { @@ -279,6 +276,8 @@ tm_g_scatterplot <- function(label = "Scatterplot", checkmate::assert_numeric(alpha[1], lower = alpha[2], upper = alpha[3], .var.name = "alpha") } + checkmate::assert_character(shape) + if (length(size) == 1) { checkmate::assert_numeric(size, any.missing = FALSE, finite = TRUE) } else { @@ -286,16 +285,18 @@ tm_g_scatterplot <- function(label = "Scatterplot", checkmate::assert_numeric(size[1], lower = size[2], upper = size[3], .var.name = "size") } - checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) - checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") - checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) - checkmate::assert_numeric( - plot_width[1], - lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" - ) + checkmate::assert_int(max_deg, lower = 1L) + checkmate::assert_flag(rotate_xaxis_labels) + ggtheme <- match.arg(ggtheme) + + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_scalar(table_dec) checkmate::assert_class(ggplot2_args, "ggplot2_args") + # End of assertions + # Make UI args args <- as.list(environment()) data_extract_list <- list( @@ -320,6 +321,7 @@ tm_g_scatterplot <- function(label = "Scatterplot", ) } +# UI function for the scatterplot module ui_g_scatterplot <- function(id, ...) { args <- list(...) ns <- NS(id) @@ -471,6 +473,7 @@ ui_g_scatterplot <- function(id, ...) { ) } +# Server function for the scatterplot module srv_g_scatterplot <- function(id, data, reporter, @@ -535,9 +538,13 @@ srv_g_scatterplot <- function(id, teal.transform::compose_and_enable_validators(iv, selector_list) }) iv_facet <- shinyvalidate::InputValidator$new() - iv_facet$add_rule("add_density", ~ if (isTRUE(.) && - (length(selector_list()$row_facet()$select) > 0L || - length(selector_list()$col_facet()$select) > 0L)) { + iv_facet$add_rule("add_density", ~ if ( + isTRUE(.) && + ( + length(selector_list()$row_facet()$select) > 0L || + length(selector_list()$col_facet()$select) > 0L + ) + ) { "Cannot add marginal density when Row or Column facetting has been selected" }) iv_facet$enable() @@ -561,7 +568,7 @@ srv_g_scatterplot <- function(id, ) trend_line_is_applicable <- reactive({ - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] x_var <- as.vector(merged$anl_input_r()$columns_source$x) y_var <- as.vector(merged$anl_input_r()$columns_source$y) length(x_var) > 0 && length(y_var) > 0 && is.numeric(ANL[[x_var]]) && is.numeric(ANL[[y_var]]) @@ -588,7 +595,7 @@ srv_g_scatterplot <- function(id, output$num_na_removed <- renderUI({ if (add_trend_line()) { - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] x_var <- as.vector(merged$anl_input_r()$columns_source$x) y_var <- as.vector(merged$anl_input_r()$columns_source$y) if ((num_total_na <- nrow(ANL) - nrow(stats::na.omit(ANL[, c(x_var, y_var)]))) > 0) { @@ -600,8 +607,10 @@ srv_g_scatterplot <- function(id, observeEvent( eventExpr = merged$anl_input_r()$columns_source[c("col_facet", "row_facet")], handlerExpr = { - if (length(merged$anl_input_r()$columns_source$col_facet) == 0 && - length(merged$anl_input_r()$columns_source$row_facet) == 0) { + if ( + length(merged$anl_input_r()$columns_source$col_facet) == 0 && + length(merged$anl_input_r()$columns_source$row_facet) == 0 + ) { shinyjs::hide("free_scales") } else { shinyjs::show("free_scales") @@ -612,7 +621,7 @@ srv_g_scatterplot <- function(id, output_q <- reactive({ teal::validate_inputs(iv_r(), iv_facet) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] x_var <- as.vector(merged$anl_input_r()$columns_source$x) y_var <- as.vector(merged$anl_input_r()$columns_source$y) @@ -658,9 +667,11 @@ srv_g_scatterplot <- function(id, \n Uncheck the 'Add marginal density' checkbox to display the plot." )) validate(need( - !(inherits(ANL[[color_by_var]], "Date") || - inherits(ANL[[color_by_var]], "POSIXct") || - inherits(ANL[[color_by_var]], "POSIXlt")), + !( + inherits(ANL[[color_by_var]], "Date") || + inherits(ANL[[color_by_var]], "POSIXct") || + inherits(ANL[[color_by_var]], "POSIXlt") + ), "Marginal plots cannot be produced when the points are colored by Date or POSIX variables. \n Uncheck the 'Add marginal density' checkbox to display the plot." )) @@ -713,7 +724,7 @@ srv_g_scatterplot <- function(id, plot_q <- teal.code::eval_code( object = plot_q, code = substitute( - expr = ANL[, log_x_var] <- log_x_fn(ANL[, x_var]), # nolint: object_name. + expr = ANL[, log_x_var] <- log_x_fn(ANL[, x_var]), env = list( x_var = x_var, log_x_fn = as.name(log_x_fn), @@ -728,7 +739,7 @@ srv_g_scatterplot <- function(id, plot_q <- teal.code::eval_code( object = plot_q, code = substitute( - expr = ANL[, log_y_var] <- log_y_fn(ANL[, y_var]), # nolint: object_name. + expr = ANL[, log_y_var] <- log_y_fn(ANL[, y_var]), env = list( y_var = y_var, log_y_fn = as.name(log_y_fn), @@ -861,7 +872,7 @@ srv_g_scatterplot <- function(id, plot_q <- teal.code::eval_code( plot_q, substitute( - expr = ANL <- dplyr::filter(ANL, !is.na(x_var) & !is.na(y_var)), # nolint: object_name. + expr = ANL <- dplyr::filter(ANL, !is.na(x_var) & !is.na(y_var)), env = list(x_var = as.name(x_var), y_var = as.name(y_var)) ) ) diff --git a/R/tm_g_scatterplotmatrix.R b/R/tm_g_scatterplotmatrix.R index 6f740f032..180b7a7bf 100644 --- a/R/tm_g_scatterplotmatrix.R +++ b/R/tm_g_scatterplotmatrix.R @@ -1,20 +1,22 @@ -#' Create a scatterplot matrix +#' `teal` module: Scatterplot matrix #' -#' The available datasets to choose from for each dataset selector is the same and -#' determined by the argument `variables`. -#' @md +#' Generates a scatterplot matrix from selected `variables` from datasets. +#' Each plot within the matrix represents the relationship between two variables, +#' providing the overview of correlations and distributions across selected data. +#' +#' @note For more examples, please see the vignette "Using scatterplot matrix" via +#' `vignette("using-scatterplot-matrix", package = "teal.modules.general")`. #' #' @inheritParams teal::module #' @inheritParams tm_g_scatterplot #' @inheritParams shared_params #' #' @param variables (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Plotting variables from an incoming dataset with filtering and selecting. In case of -#' `data_extract_spec` use `select_spec(..., ordered = TRUE)` if plot elements should be -#' rendered according to selection order. +#' Specifies plotting variables from an incoming dataset with filtering and selecting. In case of +#' `data_extract_spec` use `select_spec(..., ordered = TRUE)` if plot elements should be +#' rendered according to selection order. #' -#' @note For more examples, please see the vignette "Using scatterplot matrix" via -#' \code{vignette("using-scatterplot-matrix", package = "teal.modules.general")}. +#' @inherit shared_params return #' #' @examples #' # general data example @@ -161,13 +163,19 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix", pre_output = NULL, post_output = NULL) { logger::log_info("Initializing tm_g_scatterplotmatrix") + + # Requires Suggested packages if (!requireNamespace("lattice", quietly = TRUE)) { stop("Cannot load lattice - please install the package or restart your session.") } + + # Normalize the parameters if (inherits(variables, "data_extract_spec")) variables <- list(variables) + # Start of assertions checkmate::assert_string(label) checkmate::assert_list(variables, types = "data_extract_spec") + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) @@ -176,7 +184,13 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix", lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" ) + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions + + # Make UI args args <- as.list(environment()) + module( label = label, server = srv_g_scatterplotmatrix, @@ -187,6 +201,7 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix", ) } +# UI function for the scatterplot matrix module ui_g_scatterplotmatrix <- function(id, ...) { args <- list(...) is_single_dataset_value <- teal.transform::is_single_dataset(args$variables) @@ -243,6 +258,7 @@ ui_g_scatterplotmatrix <- function(id, ...) { ) } +# Server function for the scatterplot matrix module srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variables, plot_height, plot_width) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") @@ -283,7 +299,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab teal::validate_inputs(iv_r()) qenv <- merged$anl_q_r() - ANL <- qenv[["ANL"]] # nolint: object_name. + ANL <- qenv[["ANL"]] cols_names <- merged$anl_input_r()$columns_source$variables alpha <- input$alpha @@ -310,7 +326,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL <- ANL[, cols_names] %>% # nolint: object_name. + expr = ANL <- ANL[, cols_names] %>% dplyr::mutate_if(is.character, as.factor) %>% droplevels(), env = list(cols_names = cols_names) @@ -320,7 +336,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL <- ANL[, cols_names] %>% # nolint: object_name. + expr = ANL <- ANL[, cols_names] %>% droplevels(), env = list(cols_names = cols_names) ) @@ -405,7 +421,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab output$message <- renderText({ shiny::req(iv_r()$is_valid()) req(selector_list()$variables()) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] cols_names <- unique(unname(do.call(c, merged$anl_input_r()$columns_source))) check_char <- vapply(ANL[, cols_names], is.character, logical(1)) if (any(check_char)) { @@ -461,26 +477,30 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab } #' Get stats for x-y pairs in scatterplot matrix -#' @description uses stats::cor.test per default for all numerical input variables and converts results -#' to character vector. Could be extended if different stats for different variable -#' types are needed. Meant to be called from \code{lattice::panel.text}. -#' @param x \code{numeric} -#' @param y \code{numeric} -#' @param .f \code{function}, function that accepts x and y as formula input \code{~ x + y}. -#' Default \code{stats::cor.test} -#' @param .f_args \code{list} of arguments to be passed to \code{.f} -#' @param round_stat \code{integer} -#' @param round_pval \code{integer} -#' @details presently we need to use a formula input for \code{stats::cor.test} because -#' \code{na.fail} only gets evaluated when a formula is passed (see below). -#' \preformatted{ +#' +#' Uses [stats::cor.test()] per default for all numerical input variables and converts results +#' to character vector. +#' Could be extended if different stats for different variable types are needed. +#' Meant to be called from [lattice::panel.text()]. +#' +#' Presently we need to use a formula input for `stats::cor.test` because +#' `na.fail` only gets evaluated when a formula is passed (see below). +#' ``` #' x = c(1,3,5,7,NA) #' y = c(3,6,7,8,1) #' stats::cor.test(x, y, na.action = "na.fail") #' stats::cor.test(~ x + y, na.action = "na.fail") -#' } -#' @return \code{character} with stats. For \code{stats::cor.test} correlation coefficient and p-value. -#' @export +#' ``` +#' +#' @param x,y (`numeric`) vectors of data values. `x` and `y` must have the same length. +#' @param .f (`function`) function that accepts x and y as formula input `~ x + y`. +#' Default `stats::cor.test`. +#' @param .f_args (`list`) of arguments to be passed to `.f`. +#' @param round_stat (`integer(1)`) optional, number of decimal places to use when rounding the estimate. +#' @param round_pval (`integer(1)`) optional, number of decimal places to use when rounding the p-value. +#' +#' @return Character with stats. For [stats::cor.test()] correlation coefficient and p-value. +#' #' @examples #' set.seed(1) #' x <- runif(25, 0, 1) @@ -492,6 +512,9 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab #' method = "pearson", #' na.action = na.fail #' )) +#' +#' @export +#' get_scatterplotmatrix_stats <- function(x, y, .f = stats::cor.test, .f_args = list(), diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R index de29e0020..9e5e95229 100644 --- a/R/tm_missing_data.R +++ b/R/tm_missing_data.R @@ -1,17 +1,22 @@ -#' Missing data module +#' `teal` module: Missing data analysis #' -#' Present analysis of missing observations and patients. -#' specifically designed for use with `data.frames`. +#' This module analyzes missing data in `data.frame`s to help users explore missing observations and +#' gain insights into the completeness of their data. +#' It is useful for clinical data analysis within the context of `CDISC` standards and +#' adaptable for general data analysis purposes. #' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param parent_dataname (`character(1)`) If this `dataname` exists in then "the by subject"graph is displayed. -#' For `CDISC` data. In non `CDISC` data this can be ignored. Defaults to `"ADSL"`. -#' @param ggtheme optional, (`character`) `ggplot2` theme to be used by default. Defaults to `"classic"`. +#' @param parent_dataname (`character(1)`) Specifies the parent dataset name. Default is `ADSL` for `CDISC` data. +#' If provided and exists, enables additional analysis "by subject". For non-`CDISC` data, this parameter can be +#' ignored. +#' @param ggtheme (`character`) optional, specifies the default `ggplot2` theme for plots. Defaults to `classic`. #' #' @templateVar ggnames "Summary Obs", "Summary Patients", "Combinations Main", "Combinations Hist", "By Subject" #' @template ggplot2_args_multi #' +#' @inherit shared_params return +#' #' @examples #' library(teal.widgets) #' @@ -28,7 +33,7 @@ #' # general example data #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' #' add_nas <- function(x) { #' x[sample(seq_along(x), floor(length(x) * runif(1, .05, .17)))] <- NA @@ -56,7 +61,7 @@ #' # CDISC example data #' data <- teal_data() #' data <- within(data, { -#' library(nestcolor) +#' require(nestcolor) #' ADSL <- rADSL #' ADRS <- rADRS #' }) @@ -84,17 +89,22 @@ tm_missing_data <- function(label = "Missing data", ), pre_output = NULL, post_output = NULL) { + logger::log_info("Initializing tm_missing_data") + + # Requires Suggested packages if (!requireNamespace("gridExtra", quietly = TRUE)) { stop("Cannot load gridExtra - please install the package or restart your session.") } if (!requireNamespace("rlang", quietly = TRUE)) { stop("Cannot load rlang - please install the package or restart your session.") } - logger::log_info("Initializing tm_missing_data") + + # Normalize the parameters if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args) + # Start of assertions checkmate::assert_string(label) - checkmate::assert_character(parent_dataname, min.len = 0, max.len = 1) + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) @@ -102,11 +112,18 @@ tm_missing_data <- function(label = "Missing data", plot_width[1], lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" ) + + checkmate::assert_character(parent_dataname, min.len = 0, max.len = 1) ggtheme <- match.arg(ggtheme) + plot_choices <- c("Summary Obs", "Summary Patients", "Combinations Main", "Combinations Hist", "By Subject") checkmate::assert_list(ggplot2_args, types = "ggplot2_args") checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions + module( label, server = srv_page_missing_data, @@ -120,6 +137,7 @@ tm_missing_data <- function(label = "Missing data", ) } +# UI function for the missing data module (all datasets) ui_page_missing_data <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) shiny::tagList( @@ -144,6 +162,7 @@ ui_page_missing_data <- function(id, pre_output = NULL, post_output = NULL) { ) } +# Server function for the missing data module (all datasets) srv_page_missing_data <- function(id, data, reporter, filter_panel_api, parent_dataname, plot_height, plot_width, ggplot2_args, ggtheme) { moduleServer(id, function(input, output, session) { @@ -230,6 +249,7 @@ srv_page_missing_data <- function(id, data, reporter, filter_panel_api, parent_d }) } +# UI function for the missing data module (single dataset) ui_missing_data <- function(id, by_subject_plot = FALSE) { ns <- NS(id) @@ -299,6 +319,7 @@ ui_missing_data <- function(id, by_subject_plot = FALSE) { ) } +# UI encoding for the missing data module (all datasets) encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, datanames) { ns <- NS(id) @@ -387,6 +408,7 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data ) } +# Server function for the missing data (single dataset) srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, parent_dataname, plot_height, plot_width, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") @@ -456,14 +478,14 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par teal.code::eval_code( data(), substitute( - expr = ANL <- anl_name[, selected_vars, drop = FALSE], # nolint: object_name. + expr = ANL <- anl_name[, selected_vars, drop = FALSE], env = list(anl_name = as.name(dataname), selected_vars = selected_vars()) ) ) } else { teal.code::eval_code( data(), - substitute(expr = ANL <- anl_name, env = list(anl_name = as.name(dataname))) # nolint: object_name. + substitute(expr = ANL <- anl_name, env = list(anl_name = as.name(dataname))) ) } @@ -471,7 +493,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL[[group_var]] <- anl_name[[group_var]], # nolint: object_name. + expr = ANL[[group_var]] <- anl_name[[group_var]], env = list(group_var = group_var, anl_name = as.name(dataname)) ) ) @@ -491,7 +513,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par } else { labels <- ifelse(cols == new_col_name | cols == "", cols, paste0(column_labels[cols], " [", cols, "]")) } - return(labels) + labels }, env = list( new_col_name = new_col_name, @@ -585,9 +607,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par # display those previously selected values that are still available selected <- if (!is.null(prev_choices) && any(prev_choices %in% choices)) { prev_choices[match(choices[choices %in% prev_choices], prev_choices)] - } else if (!is.null(prev_choices) && - !any(prev_choices %in% choices) && - isolate(prev_group_by_var()) == input$group_by_var) { + } else if ( + !is.null(prev_choices) && + !any(prev_choices %in% choices) && + isolate(prev_group_by_var()) == input$group_by_var + ) { # if not any previously selected value is available and the grouping variable is the same, # then display NULL NULL @@ -621,7 +645,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL[[new_col_name]] <- ifelse(rowSums(is.na(ANL)) > 0, NA, FALSE), # nolint: object_name. + expr = ANL[[new_col_name]] <- ifelse(rowSums(is.na(ANL)) > 0, NA, FALSE), env = list(new_col_name = new_col_name) ) ) @@ -638,7 +662,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par substitute( expr = summary_plot_obs <- data_frame_call[, analysis_vars] %>% dplyr::summarise_all(list(function(x) sum(is.na(x)))) %>% - tidyr::pivot_longer(tidyselect::everything(), names_to = "col", values_to = "n_na") %>% + tidyr::pivot_longer(dplyr::everything(), names_to = "col", values_to = "n_na") %>% dplyr::mutate(n_not_na = nrow(ANL) - n_na) %>% tidyr::pivot_longer(-col, names_to = "isna", values_to = "n") %>% dplyr::mutate(isna = isna == "n_na", n_pct = n / nrow(ANL) * 100), @@ -731,7 +755,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par summary_plot_patients <- ANL[, c(parent_keys, analysis_vars)] %>% dplyr::group_by_at(parent_keys) %>% dplyr::summarise_all(anyNA) %>% - tidyr::pivot_longer(cols = !tidyselect::all_of(parent_keys), names_to = "col", values_to = "anyna") %>% + tidyr::pivot_longer(cols = !dplyr::all_of(parent_keys), names_to = "col", values_to = "anyna") %>% dplyr::group_by_at(c("col")) %>% dplyr::summarise(count_na = sum(anyna)) %>% dplyr::mutate(count_not_na = ndistinct_subjects - count_na) %>% @@ -1039,7 +1063,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par summary_data <- dplyr::summarise_all(summary_data, summ_fn) %>% dplyr::mutate(group_var_name := paste0(group_var, ":", group_var_name, "(N=", count_data$n, ")")) %>% - tidyr::pivot_longer(!tidyselect::all_of(group_var), names_to = "Variable", values_to = "out") %>% + tidyr::pivot_longer(!dplyr::all_of(group_var), names_to = "Variable", values_to = "out") %>% tidyr::pivot_wider(names_from = group_var, values_from = "out") %>% dplyr::mutate(`Variable label` = create_cols_labels(Variable, just_label = TRUE), .after = Variable) }, @@ -1054,7 +1078,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par substitute( expr = summary_data <- ANL %>% dplyr::summarise_all(summ_fn) %>% - tidyr::pivot_longer(tidyselect::everything(), + tidyr::pivot_longer(dplyr::everything(), names_to = "Variable", values_to = paste0("Missing (N=", nrow(ANL), ")") ) %>% @@ -1117,7 +1141,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par # order subjects by decreasing number of missing and then by # missingness pattern (defined using sha1) order_subjects <- summary_plot_patients %>% - dplyr::select(-"id", -tidyselect::all_of(parent_keys)) %>% + dplyr::select(-"id", -dplyr::all_of(parent_keys)) %>% dplyr::transmute( id = dplyr::row_number(), number_NA = apply(., 1, sum), @@ -1128,7 +1152,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par # order columns by decreasing percent of missing values ordered_columns <- summary_plot_patients %>% - dplyr::select(-"id", -tidyselect::all_of(parent_keys)) %>% + dplyr::select(-"id", -dplyr::all_of(parent_keys)) %>% dplyr::summarise( column = create_cols_labels(colnames(.)), na_count = apply(., MARGIN = 2, FUN = sum), @@ -1137,7 +1161,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par dplyr::arrange(na_percent, dplyr::desc(column)) summary_plot_patients <- summary_plot_patients %>% - tidyr::gather("col", "isna", -"id", -tidyselect::all_of(parent_keys)) %>% + tidyr::gather("col", "isna", -"id", -dplyr::all_of(parent_keys)) %>% dplyr::mutate(col = create_cols_labels(col)) }) ) %>% diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 62427d4b8..e484a4f4c 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -1,22 +1,26 @@ -#' Outliers Module +#' `teal` module: Outliers analysis #' #' Module to analyze and identify outliers using different methods +#' such as IQR, Z-score, and Percentiles, and offers visualizations including +#' box plots, density plots, and cumulative distribution plots to help interpret the outliers. #' #' @inheritParams teal::module #' @inheritParams shared_params #' #' @param outlier_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' variable to consider for the outliers analysis. -#' @param categorical_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' categorical factor to split the selected outlier variables on. +#' Specifies variable(s) to be analyzed for outliers. +#' @param categorical_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, +#' specifies the categorical variable(s) to split the selected outlier variables on. #' #' @templateVar ggnames "Boxplot","Density Plot","Cumulative Distribution Plot" #' @template ggplot2_args_multi #' +#' @inherit shared_params return +#' #' @examples -#' # general data example #' library(teal.widgets) #' +#' # general data example #' data <- teal_data() #' data <- within(data, { #' CO2 <- CO2 @@ -67,8 +71,6 @@ #' } #' #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { #' ADSL <- rADSL @@ -130,13 +132,16 @@ tm_outliers <- function(label = "Outliers Module", pre_output = NULL, post_output = NULL) { logger::log_info("Initializing tm_outliers") + + # Normalize the parameters if (inherits(outlier_var, "data_extract_spec")) outlier_var <- list(outlier_var) if (inherits(categorical_var, "data_extract_spec")) categorical_var <- list(categorical_var) if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args) - ggtheme <- match.arg(ggtheme) + # Start of assertions checkmate::assert_string(label) checkmate::assert_list(outlier_var, types = "data_extract_spec") + checkmate::assert_list(categorical_var, types = "data_extract_spec", null.ok = TRUE) if (is.list(categorical_var)) { lapply(categorical_var, function(x) { @@ -145,10 +150,26 @@ tm_outliers <- function(label = "Outliers Module", } }) } + + ggtheme <- match.arg(ggtheme) + plot_choices <- c("Boxplot", "Density Plot", "Cumulative Distribution Plot") checkmate::assert_list(ggplot2_args, types = "ggplot2_args") checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) + checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") + checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE) + checkmate::assert_numeric( + plot_width[1], + lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" + ) + + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + # End of assertions + + # Make UI args args <- as.list(environment()) data_extract_list <- list( @@ -169,6 +190,7 @@ tm_outliers <- function(label = "Outliers Module", ) } +# UI function for the outliers module ui_outliers <- function(id, ...) { args <- list(...) ns <- NS(id) @@ -301,6 +323,7 @@ ui_outliers <- function(id, ...) { ) } +# Server function for the outliers module srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, categorical_var, plot_height, plot_width, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") @@ -366,7 +389,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, n_outlier_missing <- reactive({ shiny::req(iv_r()$is_valid()) outlier_var <- as.vector(merged$anl_input_r()$columns_source$outlier_var) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] sum(is.na(ANL[[outlier_var]])) }) @@ -376,7 +399,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, common_code_q <- reactive({ shiny::req(iv_r()$is_valid()) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] qenv <- merged$anl_q_r() outlier_var <- as.vector(merged$anl_input_r()$columns_source$outlier_var) @@ -405,7 +428,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL <- ANL %>% dplyr::filter(!is.na(outlier_var_name)), # nolint: object_name. + expr = ANL <- ANL %>% dplyr::filter(!is.na(outlier_var_name)), env = list(outlier_var_name = as.name(outlier_var)) ) ) @@ -422,7 +445,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, qenv <- teal.code::eval_code( qenv, substitute( - expr = ANL <- ANL %>% dplyr::filter(!is.na(outlier_var_name)), # nolint: object_name. + expr = ANL <- ANL %>% dplyr::filter(!is.na(outlier_var_name)), env = list(outlier_var_name = as.name(outlier_var)) ) ) @@ -454,7 +477,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, qenv, substitute( expr = { - ANL_OUTLIER <- ANL %>% # nolint: object_name. + ANL_OUTLIER <- ANL %>% group_expr %>% # styler: off dplyr::mutate(is_outlier = { q1_q3 <- stats::quantile(outlier_var_name, probs = c(0.25, 0.75)) @@ -472,8 +495,10 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, expr = dplyr::mutate(is_outlier_selected = { q1_q3 <- stats::quantile(outlier_var_name, probs = c(0.25, 0.75)) iqr <- q1_q3[2] - q1_q3[1] - !(outlier_var_name >= q1_q3[1] - outlier_definition_param * iqr & - outlier_var_name <= q1_q3[2] + outlier_definition_param * iqr) + !( + outlier_var_name >= q1_q3[1] - outlier_definition_param * iqr & + outlier_var_name <= q1_q3[2] + outlier_definition_param * iqr + ) }), env = list( outlier_var_name = as.name(outlier_var), @@ -520,7 +545,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, qenv, substitute( expr = { - ANL_OUTLIER_EXTENDED <- dplyr::left_join( # nolint: object_name. + ANL_OUTLIER_EXTENDED <- dplyr::left_join( ANL_OUTLIER, dplyr::select( dataname, @@ -599,13 +624,13 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, # In order for geom_rug to work properly when reordering takes place inside facet_grid, # all tables must have the column used for reording. # In this case, the column used for reordering is `order`. - ANL_OUTLIER <- dplyr::left_join( # nolint: object_name. + ANL_OUTLIER <- dplyr::left_join( ANL_OUTLIER, summary_table_pre[, c("order", categorical_var)], by = categorical_var ) # so that x axis of plot aligns with columns of summary table, from most outliers to least by percentage - ANL <- ANL %>% # nolint: object_name. + ANL <- ANL %>% dplyr::left_join( dplyr::select(summary_table_pre, categorical_var_name, order), by = categorical_var @@ -660,8 +685,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, # boxplot/violinplot # nolint commented_code boxplot_q <- reactive({ req(common_code_q()) - ANL <- common_code_q()[["ANL"]] # nolint: object_name. - ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint: object_name. + ANL <- common_code_q()[["ANL"]] + ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] outlier_var <- as.vector(merged$anl_input_r()$columns_source$outlier_var) categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) @@ -752,8 +777,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, # density plot density_plot_q <- reactive({ - ANL <- common_code_q()[["ANL"]] # nolint: object_name. - ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint: object_name. + ANL <- common_code_q()[["ANL"]] + ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] outlier_var <- as.vector(merged$anl_input_r()$columns_source$outlier_var) categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) @@ -812,8 +837,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, # Cumulative distribution plot cumulative_plot_q <- reactive({ - ANL <- common_code_q()[["ANL"]] # nolint: object_name. - ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint: object_name. + ANL <- common_code_q()[["ANL"]] + ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] qenv <- common_code_q() @@ -857,7 +882,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, all_categories <- lapply( unique(ANL[[categorical_var]]), function(x) { - ANL <- ANL %>% dplyr::filter(get(categorical_var) == x) # nolint: object_name. + ANL <- ANL %>% dplyr::filter(get(categorical_var) == x) anl_outlier2 <- ANL_OUTLIER %>% dplyr::filter(get(categorical_var) == x) ecdf_df <- ANL %>% dplyr::mutate(y = stats::ecdf(ANL[[outlier_var]])(ANL[[outlier_var]])) @@ -1034,7 +1059,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, choices <- teal.transform::variable_choices(data()[[dataname_first]]) observeEvent(common_code_q(), { - ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint: object_name. + ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] teal.widgets::updateOptionalSelectInput( session, inputId = "table_ui_columns", @@ -1051,9 +1076,9 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, outlier_var <- as.vector(merged$anl_input_r()$columns_source$outlier_var) categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) - ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint: object_name. - ANL_OUTLIER_EXTENDED <- common_code_q()[["ANL_OUTLIER_EXTENDED"]] # nolint: object_name. - ANL <- common_code_q()[["ANL"]] # nolint: object_name. + ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] + ANL_OUTLIER_EXTENDED <- common_code_q()[["ANL_OUTLIER_EXTENDED"]] + ANL <- common_code_q()[["ANL"]] plot_brush <- if (tab == "Boxplot") { boxplot_r() @@ -1067,7 +1092,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, } # removing unused column ASAP - ANL_OUTLIER$order <- ANL$order <- NULL # nolint: object_name. + ANL_OUTLIER$order <- ANL$order <- NULL display_table <- if (!is.null(plot_brush)) { if (length(categorical_var) > 0) { @@ -1083,7 +1108,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, if (tab == "Boxplot") { # in boxplot with no categorical variable, there is no column in ANL that would correspond to x-axis # so a column needs to be inserted with the value "Entire dataset" because that's the label used in plot - ANL[[plot_brush$mapping$x]] <- "Entire dataset" # nolint: object_name. + ANL[[plot_brush$mapping$x]] <- "Entire dataset" } } @@ -1091,16 +1116,16 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, # so they need to be computed and attached to ANL if (tab == "Density Plot") { plot_brush$mapping$y <- "density" - ANL$density <- plot_brush$ymin # nolint: object_name. + ANL$density <- plot_brush$ymin # either ymin or ymax will work } else if (tab == "Cumulative Distribution Plot") { plot_brush$mapping$y <- "cdf" if (length(categorical_var) > 0) { - ANL <- ANL %>% # nolint: object_name. + ANL <- ANL %>% dplyr::group_by(!!as.name(plot_brush$mapping$panelvar1)) %>% dplyr::mutate(cdf = stats::ecdf(!!as.name(outlier_var))(!!as.name(outlier_var))) } else { - ANL$cdf <- stats::ecdf(ANL[[outlier_var]])(ANL[[outlier_var]]) # nolint: object_name. + ANL$cdf <- stats::ecdf(ANL[[outlier_var]])(ANL[[outlier_var]]) } } @@ -1145,10 +1170,10 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, output$total_outliers <- renderUI({ shiny::req(iv_r()$is_valid()) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. - ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] + ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] teal::validate_has_data(ANL, 1) - ANL_OUTLIER_SELECTED <- ANL_OUTLIER[ANL_OUTLIER$is_outlier_selected, ] # nolint: object_name. + ANL_OUTLIER_SELECTED <- ANL_OUTLIER[ANL_OUTLIER$is_outlier_selected, ] h5( sprintf( "%s %d / %d [%.02f%%]", @@ -1162,7 +1187,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, output$total_missing <- renderUI({ if (n_outlier_missing() > 0) { - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] helpText( sprintf( "%s %d / %d [%.02f%%]", diff --git a/R/tm_t_crosstable.R b/R/tm_t_crosstable.R index fad85693b..6859e6487 100644 --- a/R/tm_t_crosstable.R +++ b/R/tm_t_crosstable.R @@ -1,22 +1,29 @@ -#' Create a simple cross-table -#' @md +#' `teal` module: Cross-table +#' +#' Generates a simple cross-table of two variables from a dataset with custom +#' options for showing percentages and sub-totals. #' #' @inheritParams teal::module #' @inheritParams shared_params #' @param x (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Object with all available choices with pre-selected option for variable X - row values. In case -#' of `data_extract_spec` use `select_spec(..., ordered = TRUE)` if table elements should be -#' rendered according to selection order. +#' Object with all available choices with pre-selected option for variable X - row values. +#' In case of `data_extract_spec` use `select_spec(..., ordered = TRUE)` if table elements should be +#' rendered according to selection order. #' @param y (`data_extract_spec` or `list` of multiple `data_extract_spec`) -#' Object with all available choices with pre-selected option for variable Y - column values -#' \code{data_extract_spec} must not allow multiple selection in this case. +#' Object with all available choices with pre-selected option for variable Y - column values. #' -#' @param show_percentage optional, (`logical`) Whether to show percentages -#' (relevant only when `x` is a `factor`). Defaults to `TRUE`. -#' @param show_total optional, (`logical`) Whether to show total column. Defaults to `TRUE`. +#' `data_extract_spec` must not allow multiple selection in this case. +#' @param show_percentage (`logical(1)`) +#' Indicates whether to show percentages (relevant only when `x` is a `factor`). +#' Defaults to `TRUE`. +#' @param show_total (`logical(1)`) +#' Indicates whether to show total column. +#' Defaults to `TRUE`. #' #' @note For more examples, please see the vignette "Using cross table" via -#' `vignette("using-cross-table", package = "teal.modules.general")`. +#' `vignette("using-cross-table", package = "teal.modules.general")`. +#' +#' @inherit shared_params return #' #' @examples #' # general data example @@ -132,22 +139,31 @@ tm_t_crosstable <- function(label = "Cross Table", post_output = NULL, basic_table_args = teal.widgets::basic_table_args()) { logger::log_info("Initializing tm_t_crosstable") + + # Requires Suggested packages if (!requireNamespace("rtables", quietly = TRUE)) { stop("Cannot load rtables - please install the package or restart your session.") } + + # Normalize the parameters if (inherits(x, "data_extract_spec")) x <- list(x) if (inherits(y, "data_extract_spec")) y <- list(y) + # Start of assertions checkmate::assert_string(label) checkmate::assert_list(x, types = "data_extract_spec") + checkmate::assert_list(y, types = "data_extract_spec") - if (any(vapply(y, function(x) x$select$multiple, logical(1)))) { - stop("'y' should not allow multiple selection") - } + assert_single_selection(y) + checkmate::assert_flag(show_percentage) checkmate::assert_flag(show_total) + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_class(basic_table_args, classes = "basic_table_args") + # End of assertions + # Make UI args ui_args <- as.list(environment()) server_args <- list( @@ -167,6 +183,7 @@ tm_t_crosstable <- function(label = "Cross Table", ) } +# UI function for the cross-table module ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, post_output, ...) { ns <- NS(id) is_single_dataset <- teal.transform::is_single_dataset(x, y) @@ -216,6 +233,7 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p ) } +# Server function for the cross-table module srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") @@ -284,7 +302,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, output_q <- reactive({ teal::validate_inputs(iv_r()) - ANL <- merged$anl_q_r()[["ANL"]] # nolint: object_name. + ANL <- merged$anl_q_r()[["ANL"]] # As this is a summary x_name <- as.vector(merged$anl_input_r()$columns_source$x) @@ -334,7 +352,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, substitute( expr = { lyt <- basic_tables %>% - split_call %>% # styler: off + split_call %>% # styler: off rtables::add_colcounts() %>% tern::analyze_vars( vars = x_name, @@ -368,7 +386,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, teal.code::eval_code( substitute( expr = { - ANL <- tern::df_explicit_na(ANL) # nolint: object_name. + ANL <- tern::df_explicit_na(ANL) tbl <- rtables::build_table(lyt = lyt, df = ANL[order(ANL[[y_name]]), ]) tbl }, diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index 03f4a2b03..6d602bcdb 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -1,37 +1,30 @@ -#' Variable Browser Teal Module +#' `teal` module: Variable browser #' -#' The variable browser provides a table with variable names and labels and a -#' plot that visualizes the content of a particular variable. -#' specifically designed for use with `data.frames`. +#' Module provides provides a detailed summary and visualization of variable distributions +#' for `data.frame` objects, with interactive features to customize analysis. #' -#' @details Numeric columns with fewer than 30 distinct values can be treated as either factors -#' or numbers with a checkbox allowing users to switch how they are treated (if < 6 unique values -#' then the default is categorical, otherwise it is numeric). +#' Numeric columns with fewer than 30 distinct values can be treated as either discrete +#' or continuous with a checkbox allowing users to switch how they are treated(if < 6 unique values +#' then the default is discrete, otherwise it is continuous). #' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param parent_dataname (`character(1)`) If this `dataname` exists in `datasets_selected` -#' then an extra checkbox will be shown to allow users to not show variables in other datasets -#' which exist in this `dataname`. -#' This is typically used to remove `ADSL` columns in `CDISC` data. In non `CDISC` data this -#' can be ignored. Defaults to `"ADSL"`. -#' @param datasets_selected (`character`) A vector of datasets which should be -#' shown and in what order. Names in the vector have to correspond with datasets names. -#' If vector of length zero (default) then all datasets are shown. -#' Note: Only datasets of the `data.frame` class are compatible; using other types will cause an error. +#' @param parent_dataname (`character(1)`) string specifying a parent dataset. +#' If it exists in `datasets_selected`then an extra checkbox will be shown to +#' allow users to not show variables in other datasets which exist in this `dataname`. +#' This is typically used to remove `ADSL` columns in `CDISC` data. +#' In non `CDISC` data this can be ignored. Defaults to `"ADSL"`. +#' @param datasets_selected (`character`) vector of datasets which should be +#' shown, in order. Names must correspond with datasets names. +#' If vector of length zero (default) then all datasets are shown. +#' Note: Only `data.frame` objects are compatible; using other types will cause an error. #' -#' @aliases -#' tm_variable_browser_ui, -#' tm_variable_browser_srv, -#' tm_variable_browser, -#' variable_browser_ui, -#' variable_browser_srv, -#' variable_browser +#' @inherit shared_params return #' #' @examples #' library(teal.widgets) #' -#' # module specification used in apps below +#' # Module specification used in apps below #' tm_variable_browser_module <- tm_variable_browser( #' label = "Variable browser", #' ggplot2_args = ggplot2_args( @@ -84,6 +77,8 @@ tm_variable_browser <- function(label = "Variable Browser", post_output = NULL, ggplot2_args = teal.widgets::ggplot2_args()) { logger::log_info("Initializing tm_variable_browser") + + # Requires Suggested packages if (!requireNamespace("sparkline", quietly = TRUE)) { stop("Cannot load sparkline - please install the package or restart your session.") } @@ -93,10 +88,16 @@ tm_variable_browser <- function(label = "Variable Browser", if (!requireNamespace("jsonlite", quietly = TRUE)) { stop("Cannot load jsonlite - please install the package or restart your session.") } + + # Start of assertions checkmate::assert_string(label) checkmate::assert_character(datasets_selected) checkmate::assert_character(parent_dataname, min.len = 0, max.len = 1) + checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + # End of assertions + datasets_selected <- unique(datasets_selected) module( @@ -116,7 +117,7 @@ tm_variable_browser <- function(label = "Variable Browser", ) } -# ui function +# UI function for the variable browser module ui_variable_browser <- function(id, pre_output = NULL, post_output = NULL) { @@ -186,6 +187,7 @@ ui_variable_browser <- function(id, ) } +# Server function for the variable browser module srv_variable_browser <- function(id, data, reporter, @@ -537,258 +539,14 @@ srv_variable_browser <- function(id, }) } -#' Summarizes missings occurrence +#' Summarize NAs. #' -#' Summarizes missings occurrence in vector +#' Summarizes occurrence of missing values in vector. #' @param x vector of any type and length -#' @return text describing \code{NA} occurrence. +#' @return Character string describing `NA` occurrence. #' @keywords internal var_missings_info <- function(x) { - return(sprintf("%s [%s%%]", sum(is.na(x)), round(mean(is.na(x) * 100), 2))) -} - -#' S3 generic for \code{sparkline} widget HTML -#' -#' Generates the \code{sparkline} HTML code corresponding to the input array. -#' For numeric variables creates a box plot, for character and factors - bar plot. -#' Produces an empty string for variables of other types. -#' -#' @param arr vector of any type and length -#' @param width \code{numeric} the width of the \code{sparkline} widget (pixels) -#' @param ... \code{list} additional options passed to bar plots of \code{jquery.sparkline}; see -#' \href{https://omnipotent.net/jquery.sparkline/#common}{\code{jquery.sparkline docs}} -#' -#' @return character variable containing the HTML code of the \code{sparkline} HTML widget -#' @keywords internal -#' -create_sparklines <- function(arr, width = 150, ...) { - if (all(is.null(arr))) { - return("") - } - UseMethod("create_sparklines") -} - -#' Default method for \code{\link{create_sparklines}} -#' -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.default <- function(arr, width = 150, ...) { - return(as.character(tags$code("unsupported variable type", class = "text-blue"))) -} - -#' Generates the HTML code for the \code{sparkline} widget -#' -#' @param bar_spacing \code{numeric} the spacing between the bars (in pixels) -#' @param bar_width \code{numeric} the width of the bars (in pixels) -#' -#' @return \code{character} with HTML code for the \code{sparkline} widget -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.Date <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { - arr_num <- as.numeric(arr) - arr_num <- sort(arr_num, decreasing = FALSE, method = "radix") - binwidth <- get_bin_width(arr_num, 1) - bins <- floor(diff(range(arr_num)) / binwidth) + 1 - if (all(is.na(bins))) { - return(as.character(tags$code("only NA", class = "text-blue"))) - } else if (bins == 1) { - return(as.character(tags$code("one date", class = "text-blue"))) - } - counts <- as.vector(unname(base::table(cut(arr_num, breaks = bins)))) - max_value <- max(counts) - - start_bins <- as.integer(seq(1, length(arr_num), length.out = bins)) - labels_start <- as.character(as.Date(arr_num[start_bins], origin = as.Date("1970-01-01"))) - labels <- paste("Start:", labels_start) - - sparkline::spk_chr( - unname(counts), - type = "bar", - chartRangeMin = 0, - chartRangeMax = max_value, - width = width, - barWidth = bar_width, - barSpacing = bar_spacing, - tooltipFormatter = custom_sparkline_formatter(labels, counts) - ) -} - -#' Generates the HTML code for the \code{sparkline} widget -#' -#' -#' @param bar_spacing \code{numeric} the spacing between the bars (in pixels) -#' @param bar_width \code{numeric} the width of the bars (in pixels) -#' -#' @return \code{character} with HTML code for the \code{sparkline} widget -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.POSIXct <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { - arr_num <- as.numeric(arr) - arr_num <- sort(arr_num, decreasing = FALSE, method = "radix") - binwidth <- get_bin_width(arr_num, 1) - bins <- floor(diff(range(arr_num)) / binwidth) + 1 - if (all(is.na(bins))) { - return(as.character(tags$code("only NA", class = "text-blue"))) - } else if (bins == 1) { - return(as.character(tags$code("one date-time", class = "text-blue"))) - } - counts <- as.vector(unname(base::table(cut(arr_num, breaks = bins)))) - max_value <- max(counts) - - start_bins <- as.integer(seq(1, length(arr_num), length.out = bins)) - labels_start <- as.character(format(as.POSIXct(arr_num[start_bins], origin = as.Date("1970-01-01")), "%Y-%m-%d")) - labels <- paste("Start:", labels_start) - - sparkline::spk_chr( - unname(counts), - type = "bar", - chartRangeMin = 0, - chartRangeMax = max_value, - width = width, - barWidth = bar_width, - barSpacing = bar_spacing, - tooltipFormatter = custom_sparkline_formatter(labels, counts) - ) -} - -#' Generates the HTML code for the \code{sparkline} widget -#' -#' -#' @param bar_spacing \code{numeric} the spacing between the bars (in pixels) -#' @param bar_width \code{numeric} the width of the bars (in pixels) -#' -#' @return \code{character} with HTML code for the \code{sparkline} widget -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.POSIXlt <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { - arr_num <- as.numeric(arr) - arr_num <- sort(arr_num, decreasing = FALSE, method = "radix") - binwidth <- get_bin_width(arr_num, 1) - bins <- floor(diff(range(arr_num)) / binwidth) + 1 - if (all(is.na(bins))) { - return(as.character(tags$code("only NA", class = "text-blue"))) - } else if (bins == 1) { - return(as.character(tags$code("one date-time", class = "text-blue"))) - } - counts <- as.vector(unname(base::table(cut(arr_num, breaks = bins)))) - max_value <- max(counts) - - start_bins <- as.integer(seq(1, length(arr_num), length.out = bins)) - labels_start <- as.character(format(as.POSIXct(arr_num[start_bins], origin = as.Date("1970-01-01")), "%Y-%m-%d")) - labels <- paste("Start:", labels_start) - - sparkline::spk_chr( - unname(counts), - type = "bar", - chartRangeMin = 0, - chartRangeMax = max_value, - width = width, - barWidth = bar_width, - barSpacing = bar_spacing, - tooltipFormatter = custom_sparkline_formatter(labels, counts) - ) -} - - -#' Generates the HTML code for the \code{sparkline} widget -#' -#' Coerces a character vector to factor and delegates to the \code{create_sparklines.factor} -#' -#' -#' @return \code{character} with HTML code for the \code{sparkline} widget -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.character <- function(arr, ...) { - return(create_sparklines(as.factor(arr))) -} - - -#' Generates the HTML code for the \code{sparkline} widget -#' -#' Coerces logical vector to factor and delegates to the \code{create_sparklines.factor} -#' -#' -#' @return \code{character} with HTML code for the \code{sparkline} widget -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.logical <- function(arr, ...) { - return(create_sparklines(as.factor(arr))) -} - - -#' Generates the \code{sparkline} HTML code -#' -#' @param bar_spacing \code{numeric} spacing between the bars (in pixels) -#' @param bar_width \code{numeric} width of the bars (in pixels) -#' -#' @return \code{character} with HTML code for the \code{sparkline} widget -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.factor <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { - decreasing_order <- TRUE - - counts <- table(arr) - if (length(counts) >= 100) { - return(as.character(tags$code("> 99 levels", class = "text-blue"))) - } else if (length(counts) == 0) { - return(as.character(tags$code("no levels", class = "text-blue"))) - } else if (length(counts) == 1) { - return(as.character(tags$code("one level", class = "text-blue"))) - } - - # Summarize the occurences of different levels - # and get the maximum and minimum number of occurences - # This is needed for the sparkline to correctly display the bar plots - # Otherwise they are cropped - counts <- sort(counts, decreasing = decreasing_order, method = "radix") - max_value <- if (decreasing_order) counts[1] else counts[length[counts]] - max_value <- unname(max_value) - - sparkline::spk_chr( - unname(counts), - type = "bar", - chartRangeMin = 0, - chartRangeMax = max_value, - width = width, - barWidth = bar_width, - barSpacing = bar_spacing, - tooltipFormatter = custom_sparkline_formatter(names(counts), as.vector(counts)) - ) -} - -#' Generates the \code{sparkline} HTML code -#' -#' -#' @return \code{character} with HTML code for the \code{sparkline} widget -#' -#' @export -#' @keywords internal -#' @rdname create_sparklines -create_sparklines.numeric <- function(arr, width = 150, ...) { - if (any(is.infinite(arr))) { - return(as.character(tags$code("infinite values", class = "text-blue"))) - } - if (length(arr) > 100000) { - return(as.character(tags$code("Too many rows (>100000)", class = "text-blue"))) - } - - arr <- arr[!is.na(arr)] - res <- sparkline::spk_chr(unname(arr), type = "box", width = width, ...) - return(res) + sprintf("%s [%s%%]", sum(is.na(x)), round(mean(is.na(x) * 100), 2)) } #' Summarizes variable @@ -796,11 +554,12 @@ create_sparklines.numeric <- function(arr, width = 150, ...) { #' Creates html summary with statistics relevant to data type. For numeric values it returns central #' tendency measures, for factor returns level counts, for Date date range, for other just #' number of levels. +#' #' @param x vector of any type -#' @param numeric_as_factor \code{logical} should the numeric variable be treated as a factor -#' @param dt_rows \code{numeric} current/latest `DT` page length +#' @param numeric_as_factor `logical` should the numeric variable be treated as a factor +#' @param dt_rows `numeric` current/latest `DT` page length #' @param outlier_definition If 0 no outliers are removed, otherwise -#' outliers (those more than outlier_definition*IQR below/above Q1/Q3 be removed) +#' outliers (those more than `outlier_definition*IQR below/above Q1/Q3` be removed) #' @return text with simple statistics. #' @keywords internal var_summary_table <- function(x, numeric_as_factor, dt_rows, outlier_definition) { @@ -882,10 +641,10 @@ var_summary_table <- function(x, numeric_as_factor, dt_rows, outlier_definition) } } - #' Plot variable #' #' Creates summary plot with statistics relevant to data type. +#' #' @inheritParams shared_params #' @param var vector of any type to be plotted. For numeric variables it produces histogram with #' density line, for factors it creates frequency plot @@ -893,7 +652,7 @@ var_summary_table <- function(x, numeric_as_factor, dt_rows, outlier_definition) #' @param wrap_character (`numeric`) number of characters at which to wrap text values of `var` #' @param numeric_as_factor (`logical`) should the numeric variable be treated as a factor #' @param display_density (`logical`) should density estimation be displayed for numeric values -#' @param remove_NA_hist (`logical`) should (`NA`) values be removed for histogram of factor like variables +#' @param remove_NA_hist (`logical`) should `NA` values be removed for histogram of factor like variables #' @param outlier_definition if 0 no outliers are removed, otherwise #' outliers (those more than outlier_definition*IQR below/above Q1/Q3 be removed) #' @param records_for_factor (`numeric`) if the number of factor levels is >= than this value then @@ -1058,11 +817,11 @@ is_num_var_short <- function(.unique_records_for_factor, input, data_for_analysi #' Validates the variable browser inputs #' -#' @param input (`session$input`) the shiny session input +#' @param input (`session$input`) the `shiny` session input #' @param plot_var (`list`) list of a data frame and an array of variable names -#' @param data (`tdata`) the datasets passed to the module +#' @param data (`teal_data`) the datasets passed to the module #' -#' @returns `logical` TRUE if validations pass; a Shiny validation error otherwise +#' @returns `logical` TRUE if validations pass; a `shiny` validation error otherwise #' @keywords internal validate_input <- function(input, plot_var, data) { reactive({ @@ -1092,9 +851,9 @@ get_plotted_data <- function(input, plot_var, data) { #' #' @param datanames (`character`) the name of the dataset #' @param parent_dataname (`character`) the name of a parent `dataname` to filter out variables from -#' @param data (`tdata`) the object containing all datasets -#' @param input (`session$input`) the shiny session input -#' @param output (`session$output`) the shiny session output +#' @param data (`teal_data`) the object containing all datasets +#' @param input (`session$input`) the `shiny` session input +#' @param output (`session$output`) the `shiny` session output #' @param columns_names (`environment`) the environment containing bindings for each dataset #' @param plot_var (`list`) the list containing the currently selected dataset (tab) and its column names #' @keywords internal @@ -1111,7 +870,6 @@ render_tabset_panel_content <- function(datanames, parent_dataname, output, data #' Renders a single tab in the left-hand side tabset panel #' -#' @description #' Renders a single tab in the left-hand side tabset panel. The rendered tab contains #' information about one dataset out of many presented in the module. #' @@ -1158,7 +916,6 @@ render_tab_header <- function(dataset_name, output, data) { #' Renders the table for a single dataset in the left-hand side tabset panel #' -#' @description #' The table contains column names, column labels, #' small summary about NA values and `sparkline` (if appropriate). #' @@ -1277,7 +1034,6 @@ render_tab_table <- function(dataset_name, parent_dataname, output, data, input, #' Creates observers updating the currently selected column #' -#' @description #' The created observers update the column currently selected in the left-hand side #' tabset panel. #' @@ -1308,18 +1064,6 @@ get_bin_width <- function(x_vec, scaling_factor = 2) { if (isTRUE(x_span / binwidth >= 2)) binwidth else x_span / 2 } -custom_sparkline_formatter <- function(labels, counts) { - htmlwidgets::JS( - sprintf( - "function(sparkline, options, field) { - return 'ID: ' + %s[field[0].offset] + '
' + 'Count: ' + %s[field[0].offset]; - }", - jsonlite::toJSON(labels), - jsonlite::toJSON(counts) - ) - ) -} - #' Removes the outlier observation from an array #' #' @param var (`numeric`) a numeric vector @@ -1335,3 +1079,209 @@ remove_outliers_from <- function(var, outlier_definition) { iqr <- q1_q3[2] - q1_q3[1] var[var >= q1_q3[1] - outlier_definition * iqr & var <= q1_q3[2] + outlier_definition * iqr] } + + +# sparklines ---- + +#' S3 generic for `sparkline` widget HTML +#' +#' Generates the `sparkline` HTML code corresponding to the input array. +#' For numeric variables creates a box plot, for character and factors - bar plot. +#' Produces an empty string for variables of other types. +#' +#' @param arr vector of any type and length +#' @param width `numeric` the width of the `sparkline` widget (pixels) +#' @param bar_spacing `numeric` the spacing between the bars (in pixels) +#' @param bar_width `numeric` the width of the bars (in pixels) +#' @param ... `list` additional options passed to bar plots of `jquery.sparkline`; +#' see [`jquery.sparkline docs`](https://omnipotent.net/jquery.sparkline/#common) +#' +#' @return Character string containing HTML code of the `sparkline` HTML widget. +#' @keywords internal +create_sparklines <- function(arr, width = 150, ...) { + if (all(is.null(arr))) { + return("") + } + UseMethod("create_sparklines") +} + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.logical <- function(arr, ...) { + create_sparklines(as.factor(arr)) +} + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.numeric <- function(arr, width = 150, ...) { + if (any(is.infinite(arr))) { + return(as.character(tags$code("infinite values", class = "text-blue"))) + } + if (length(arr) > 100000) { + return(as.character(tags$code("Too many rows (>100000)", class = "text-blue"))) + } + + arr <- arr[!is.na(arr)] + sparkline::spk_chr(unname(arr), type = "box", width = width, ...) +} + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.character <- function(arr, ...) { + return(create_sparklines(as.factor(arr))) +} + + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.factor <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { + decreasing_order <- TRUE + + counts <- table(arr) + if (length(counts) >= 100) { + return(as.character(tags$code("> 99 levels", class = "text-blue"))) + } else if (length(counts) == 0) { + return(as.character(tags$code("no levels", class = "text-blue"))) + } else if (length(counts) == 1) { + return(as.character(tags$code("one level", class = "text-blue"))) + } + + # Summarize the occurences of different levels + # and get the maximum and minimum number of occurences + # This is needed for the sparkline to correctly display the bar plots + # Otherwise they are cropped + counts <- sort(counts, decreasing = decreasing_order, method = "radix") + max_value <- if (decreasing_order) counts[1] else counts[length[counts]] + max_value <- unname(max_value) + + sparkline::spk_chr( + unname(counts), + type = "bar", + chartRangeMin = 0, + chartRangeMax = max_value, + width = width, + barWidth = bar_width, + barSpacing = bar_spacing, + tooltipFormatter = custom_sparkline_formatter(names(counts), as.vector(counts)) + ) +} + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.Date <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { + arr_num <- as.numeric(arr) + arr_num <- sort(arr_num, decreasing = FALSE, method = "radix") + binwidth <- get_bin_width(arr_num, 1) + bins <- floor(diff(range(arr_num)) / binwidth) + 1 + if (all(is.na(bins))) { + return(as.character(tags$code("only NA", class = "text-blue"))) + } else if (bins == 1) { + return(as.character(tags$code("one date", class = "text-blue"))) + } + counts <- as.vector(unname(base::table(cut(arr_num, breaks = bins)))) + max_value <- max(counts) + + start_bins <- as.integer(seq(1, length(arr_num), length.out = bins)) + labels_start <- as.character(as.Date(arr_num[start_bins], origin = as.Date("1970-01-01"))) + labels <- paste("Start:", labels_start) + + sparkline::spk_chr( + unname(counts), + type = "bar", + chartRangeMin = 0, + chartRangeMax = max_value, + width = width, + barWidth = bar_width, + barSpacing = bar_spacing, + tooltipFormatter = custom_sparkline_formatter(labels, counts) + ) +} + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.POSIXct <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { + arr_num <- as.numeric(arr) + arr_num <- sort(arr_num, decreasing = FALSE, method = "radix") + binwidth <- get_bin_width(arr_num, 1) + bins <- floor(diff(range(arr_num)) / binwidth) + 1 + if (all(is.na(bins))) { + return(as.character(tags$code("only NA", class = "text-blue"))) + } else if (bins == 1) { + return(as.character(tags$code("one date-time", class = "text-blue"))) + } + counts <- as.vector(unname(base::table(cut(arr_num, breaks = bins)))) + max_value <- max(counts) + + start_bins <- as.integer(seq(1, length(arr_num), length.out = bins)) + labels_start <- as.character(format(as.POSIXct(arr_num[start_bins], origin = as.Date("1970-01-01")), "%Y-%m-%d")) + labels <- paste("Start:", labels_start) + + sparkline::spk_chr( + unname(counts), + type = "bar", + chartRangeMin = 0, + chartRangeMax = max_value, + width = width, + barWidth = bar_width, + barSpacing = bar_spacing, + tooltipFormatter = custom_sparkline_formatter(labels, counts) + ) +} + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.POSIXlt <- function(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) { + arr_num <- as.numeric(arr) + arr_num <- sort(arr_num, decreasing = FALSE, method = "radix") + binwidth <- get_bin_width(arr_num, 1) + bins <- floor(diff(range(arr_num)) / binwidth) + 1 + if (all(is.na(bins))) { + return(as.character(tags$code("only NA", class = "text-blue"))) + } else if (bins == 1) { + return(as.character(tags$code("one date-time", class = "text-blue"))) + } + counts <- as.vector(unname(base::table(cut(arr_num, breaks = bins)))) + max_value <- max(counts) + + start_bins <- as.integer(seq(1, length(arr_num), length.out = bins)) + labels_start <- as.character(format(as.POSIXct(arr_num[start_bins], origin = as.Date("1970-01-01")), "%Y-%m-%d")) + labels <- paste("Start:", labels_start) + + sparkline::spk_chr( + unname(counts), + type = "bar", + chartRangeMin = 0, + chartRangeMax = max_value, + width = width, + barWidth = bar_width, + barSpacing = bar_spacing, + tooltipFormatter = custom_sparkline_formatter(labels, counts) + ) +} + +#' @rdname create_sparklines +#' @keywords internal +#' @export +create_sparklines.default <- function(arr, width = 150, ...) { + as.character(tags$code("unsupported variable type", class = "text-blue")) +} + + +custom_sparkline_formatter <- function(labels, counts) { + htmlwidgets::JS( + sprintf( + "function(sparkline, options, field) { + return 'ID: ' + %s[field[0].offset] + '
' + 'Count: ' + %s[field[0].offset]; + }", + jsonlite::toJSON(labels), + jsonlite::toJSON(counts) + ) + ) +} diff --git a/R/utils.R b/R/utils.R index 87b5b9884..d4b155cf3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,51 +1,60 @@ -#' Shared Parameters +#' Shared parameters documentation #' -#' @description Contains arguments that are shared between multiple functions -#' in the package to avoid repetition using `inheritParams`. +#' Defines common arguments shared across multiple functions in the package +#' to avoid repetition by using `inheritParams`. #' -#' @param plot_height optional, (`numeric`) A vector of length three with `c(value, min and max)` -#' for a slider encoding the plot height. -#' @param plot_width optional, (`numeric`) A vector of length three with `c(value, min and max)` -#' for a slider encoding the plot width. -#' @param rotate_xaxis_labels optional, (`logical`) Whether to rotate plot X axis labels. Does not -#' rotate by default (`FALSE`). -#' @param ggtheme optional, (`character`) `ggplot2` theme to be used by default. Defaults to `"gray"`. +#' @param plot_height (`numeric`) optional, specifies the plot height as a three-element vector of +#' `value`, `min`, and `max` intended for use with a slider UI element. +#' @param plot_width (`numeric`) optional, specifies the plot width as a three-element vector of +#' `value`, `min`, and `max` for a slider encoding the plot width. +#' @param rotate_xaxis_labels (`logical`) optional, whether to rotate plot X axis labels. Does not +#' rotate by default (`FALSE`). +#' @param ggtheme (`character`) optional, `ggplot2` theme to be used by default. Defaults to `"gray"`. #' @param ggplot2_args (`ggplot2_args`) object created by [teal.widgets::ggplot2_args()] -#' with settings for the module plot. -#' The argument is merged with options variable `teal.ggplot2_args` and default module setup. +#' with settings for the module plot. +#' The argument is merged with options variable `teal.ggplot2_args` and default module setup. #' -#' For more details see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")` +#' For more details see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")` #' @param basic_table_args (`basic_table_args`) object created by [teal.widgets::basic_table_args()] -#' with settings for the module table. -#' The argument is merged with options variable `teal.basic_table_args` and default module setup. +#' with settings for the module table. +#' The argument is merged with options variable `teal.basic_table_args` and default module setup. #' -#' For more details see the vignette: `vignette("custom-basic-table-arguments", package = "teal.widgets")` -#' @param pre_output (`shiny.tag`, optional)\cr +#' For more details see the vignette: `vignette("custom-basic-table-arguments", package = "teal.widgets")` +#' @param pre_output (`shiny.tag`) optional, text or UI element to be displayed before the module's output, +#' providing context or a title. #' with text placed before the output to put the output into context. For example a title. -#' @param post_output (`shiny.tag`, optional) with text placed after the output to put the output -#' into context. For example the [shiny::helpText()] elements are useful. +#' @param post_output (`shiny.tag`) optional, text or UI element to be displayed after the module's output, +#' adding context or further instructions. Elements like `shiny::helpText()` are useful. +#' +#' @param alpha (`integer(1)` or `integer(3)`) optional, specifies point opacity. +#' - When the length of `alpha` is one: the plot points will have a fixed opacity. +#' - When the length of `alpha` is three: the plot points opacity are dynamically adjusted based on +#' vector of `value`, `min`, and `max`. +#' @param size (`integer(1)` or `integer(3)`) optional, specifies point size. +#' - When the length of `size` is one: the plot point sizes will have a fixed size. +#' - When the length of `size` is three: the plot points size are dynamically adjusted based on +#' vector of `value`, `min`, and `max`. +#' +#' @return Object of class `teal_module` to be used in `teal` applications. #' #' @name shared_params #' @keywords internal NULL -#' Add axis labels that show facetting variable +#' Add labels for facets to a `ggplot2` object #' -#' Add axis labels that show facetting variable +#' Enhances a `ggplot2` plot by adding labels that describe +#' the faceting variables along the x and y axes. #' -#' @param p `ggplot2` object to add facet labels to -#' @param xfacet_label label of facet along x axis (nothing created if NULL), -#' if vector, will be concatenated with " & " -#' @param yfacet_label label of facet along y axis (nothing created if NULL), -#' if vector, will be concatenated with " & " +#' @param p (`ggplot2`) object to which facet labels will be added. +#' @param xfacet_label (`character`) Label for the facet along the x-axis. +#' If `NULL`, no label is added. If a vector, labels are joined with " & ". +#' @param yfacet_label (`character`) Label for the facet along the y-axis. +#' Similar behavior to `xfacet_label`. #' -#' @return grid grob object (to be drawn with \code{grid.draw}) -#' -#' @export +#' @return Returns `grid` or `grob` object (to be drawn with `grid.draw`) #' #' @examples -#' # we put donttest to avoid strictr error with seq along.with argument -#' \donttest{ #' library(ggplot2) #' library(grid) #' @@ -53,7 +62,7 @@ NULL #' aes(x = mpg, y = disp) + #' geom_point() + #' facet_grid(gear ~ cyl) -#' p +#' #' xfacet_label <- "cylinders" #' yfacet_label <- "gear" #' res <- add_facet_labels(p, xfacet_label, yfacet_label) @@ -66,7 +75,8 @@ NULL #' grid.draw(add_facet_labels(p, xfacet_label, yfacet_label = NULL)) #' grid.newpage() #' grid.draw(add_facet_labels(p, xfacet_label = NULL, yfacet_label = NULL)) -#' } +#' +#' @export #' add_facet_labels <- function(p, xfacet_label = NULL, yfacet_label = NULL) { checkmate::assert_class(p, classes = "ggplot") @@ -118,48 +128,30 @@ add_facet_labels <- function(p, xfacet_label = NULL, yfacet_label = NULL) { }) } -#' Call a function with a character vector for the \code{...} argument +#' Call a function with a character vector for the `...` argument #' -#' @param fun (\code{character}) Name of a function where the \code{...} argument -#' shall be replaced by values from \code{str_args}. -#' @param str_args (\code{character}) A character vector that the function shall -#' be executed with +#' @param fun (`character`) Name of a function where the `...` argument shall be replaced by values from `str_args`. +#' @param str_args (`character`) A character vector that the function shall be executed with #' -#' @return: call (i.e. expression) of the function provided by \code{fun} -#' with arguments provided by \code{str_args}. -#' @keywords internal +#' @return +#' Value of call to `fun` with arguments specified in `str_args`. #' -#' @examples -#' \dontrun{ -#' a <- 1 -#' b <- 2 -#' call_fun_dots("sum", c("a", "b")) -#' eval(call_fun_dots("sum", c("a", "b"))) -#' } +#' @keywords internal call_fun_dots <- function(fun, str_args) { do.call("call", c(list(fun), lapply(str_args, as.name)), quote = TRUE) } -#' Get variable name with label +#' Generate a string for a variable including its label #' -#' @param var_names (\code{character}) Name of variable to extract labels from. -#' @param dataset (\code{dataset}) Name of analysis dataset. -#' @param prefix (\code{character}) String to paste to the beginning of the -#' variable name with label. -#' @param suffix (\code{character}) String to paste to the end of the variable -#' name with label. -#' @param wrap_width (\code{numeric}) Number of characters to wrap original -#' label to. Defaults to 80. +#' @param var_names (`character`) Name of variable to extract labels from. +#' @param dataset (`dataset`) Name of analysis dataset. +#' @param prefix,suffix (`character`) String to paste to the beginning/end of the variable name with label. +#' @param wrap_width (`numeric`) Number of characters to wrap original label to. Defaults to 80. #' -#' @return (\code{character}) String with variable name and label. -#' @keywords internal +#' @return (`character`) String with variable name and label. #' -#' @examples -#' \dontrun{ -#' ADSL <- teal.modules.general::rADSL +#' @keywords internal #' -#' varname_w_label("AGE", ADSL) -#' } varname_w_label <- function(var_names, dataset, wrap_width = 80, @@ -190,24 +182,6 @@ varname_w_label <- function(var_names, } } -#' Extract html id for `data_extract_ui` -#' @description The `data_extract_ui` is located under extended html id. -#' We could not use \code{ns("original id")} for reference, as it is extended with specific suffixes. -#' @param varname character original html id. -#' This will be mostly retrieved with \code{ns("original id")} in `ui` or -#' \code{session$ns("original id")} in server function. -#' @param dataname character \code{dataname} from data_extract input. -#' This might be retrieved like \code{teal.transform::data_extract_spec(...)[[1]]$dataname}. -#' @param filter logical if the connected \code{extract_data_spec} is used with \code{filter} option. -#' @keywords internal -extract_input <- function(varname, dataname, filter = FALSE) { - if (filter) { - paste0(varname, "-dataset_", dataname, "_singleextract-filter1-vals") - } else { - paste0(varname, "-dataset_", dataname, "_singleextract-select") - } -} - # see vignette("ggplot2-specs", package="ggplot2") shape_names <- c( "circle", paste("circle", c("open", "filled", "cross", "plus", "small")), "bullet", @@ -220,18 +194,9 @@ shape_names <- c( #' Get icons to represent variable types in dataset #' -#' @param var_type (`character`)\cr -#' of R internal types (classes). -#' -#' @return (`character`)\cr -#' vector of HTML icons corresponding to data type in each column. +#' @param var_type (`character`) of R internal types (classes). +#' @return (`character`) vector of HTML icons corresponding to data type in each column. #' @keywords internal -#' -#' @examples -#' teal.modules.general:::variable_type_icons(c( -#' "integer", "numeric", "logical", "Date", "POSIXct", "POSIXlt", -#' "factor", "character", "unknown", "" -#' )) variable_type_icons <- function(var_type) { checkmate::assert_character(var_type, any.missing = FALSE) @@ -249,7 +214,7 @@ variable_type_icons <- function(var_type) { ) class_to_icon <- lapply(class_to_icon, function(icon_name) toString(icon(icon_name, lib = "font-awesome"))) - res <- unname(vapply( + unname(vapply( var_type, FUN.VALUE = character(1), FUN = function(class) { @@ -262,8 +227,6 @@ variable_type_icons <- function(var_type) { } } )) - - return(res) } #' Include `CSS` files from `/inst/css/` package directory to application header @@ -272,10 +235,11 @@ variable_type_icons <- function(var_type) { #' not work with `devtools`. Therefore, we redefine this method in each package #' as needed. Thus, we do not export this method #' -#' @param pattern (`character`) pattern of files to be included +#' @param pattern (`character`) optional, regular expression to match the file names to be included. #' -#' @return HTML code that includes `CSS` files +#' @return HTML code that includes `CSS` files. #' @keywords internal +#' include_css_files <- function(pattern = "*") { css_files <- list.files( system.file("css", package = "teal.modules.general", mustWork = TRUE), @@ -284,14 +248,17 @@ include_css_files <- function(pattern = "*") { if (length(css_files) == 0) { return(NULL) } - return(shiny::singleton(shiny::tags$head(lapply(css_files, shiny::includeCSS)))) + shiny::singleton(shiny::tags$head(lapply(css_files, shiny::includeCSS))) } -#' Get a string with java-script code checking if the specific tab is clicked -#' @description will be the input for `shiny::conditionalPanel()` -#' @param id `character(1)` the id of the tab panel with tabs. -#' @param name `character(1)` the name of the tab. +#' JavaScript condition to check if a specific tab is active +#' +#' @param id (`character(1)`) the id of the tab panel with tabs. +#' @param name (`character(1)`) the name of the tab. +#' @return JavaScript expression to be used in `shiny::conditionalPanel()` to determine +#' if the specified tab is active. #' @keywords internal +#' is_tab_active_js <- function(id, name) { # supporting the bs3 and higher version at the same time sprintf( @@ -299,3 +266,15 @@ is_tab_active_js <- function(id, name) { id, name ) } + +#' Assert single selection on `data_extract_spec` object +#' Helper to reduce code in assertions +#' @noRd +#' +assert_single_selection <- function(x, + .var.name = checkmate::vname(x)) { # nolint: object_name. + if (any(vapply(x, function(.x) .x$select$multiple, logical(1)))) { + stop("'", .var.name, "' should not allow multiple selection") + } + invisible(TRUE) +} diff --git a/R/zzz.R b/R/zzz.R index f9db273c7..88430df7b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -2,4 +2,5 @@ teal.logger::register_logger(namespace = "teal.modules.general") } +### global variables ggplot_themes <- c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void") diff --git a/README.md b/README.md index 3c9b1fffb..ef66a1ece 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,11 @@ # teal.modules.general +[![CRAN Version](https://www.r-pkg.org/badges/version/teal.modules.general?color=green)](https://cran.r-project.org/package=teal.modules.general) +[![Total Downloads](http://cranlogs.r-pkg.org/badges/grand-total/teal.modules.general?color=green)](https://cran.r-project.org/package=teal.modules.general) +[![Last Month Downloads](http://cranlogs.r-pkg.org/badges/last-month/teal.modules.general?color=green)](https://cran.r-project.org/package=teal.modules.general) +[![Last Week Downloads](http://cranlogs.r-pkg.org/badges/last-week/teal.modules.general?color=green)](https://cran.r-project.org/package=teal.modules.general) + [![Check 🛠](https://github.com/insightsengineering/teal.modules.general/actions/workflows/check.yaml/badge.svg)](https://insightsengineering.github.io/teal.modules.general/main/unit-test-report/) [![Docs 📚](https://github.com/insightsengineering/teal.modules.general/actions/workflows/docs.yaml/badge.svg)](https://insightsengineering.github.io/teal.modules.general/) [![Code Coverage 📔](https://raw.githubusercontent.com/insightsengineering/teal.modules.general/_xml_coverage_reports/data/main/badge.svg)](https://insightsengineering.github.io/teal.modules.general/main/coverage-report/) @@ -35,17 +40,31 @@ Please see [`teal` gallery](https://github.com/insightsengineering/teal.gallery) ## Installation -From July 2023 `insightsengineering` packages are available on [r-universe](https://r-universe.dev/). - ```r # stable versions -install.packages('teal.modules.general', repos = c('https://insightsengineering.r-universe.dev', 'https://cloud.r-project.org')) +install.packages('teal.modules.general') + +# install.packages("pak") +pak::pak("insightsengineering/teal.modules.general@*release") +``` + +Alternatively, you might want to use the development version available on [r-universe](https://r-universe.dev/). +```r # beta versions -install.packages('teal.modules.general', repos = c('https://pharmaverse.r-universe.dev', 'https://cloud.r-project.org')) +install.packages('teal.modules.general', repos = c('https://pharmaverse.r-universe.dev', getOption('repos'))) + +# install.packages("pak") +pak::pak("insightsengineering/teal.modules.general") ``` -See package vignettes `browseVignettes(package = "teal.modules.general")` for usage of this package. +## Usage + +See package vignettes `browseVignettes(package = "teal.modules.general")` for usage of this package or visit [Package Website](https://insightsengineering.github.io/teal.modules.general/latest-tag/). + +## Getting help + +If you encounter a bug or have a feature request, please file an issue. For questions, discussions, and staying up to date, please use the `teal` channel in the [`pharmaverse` slack workspace](https://pharmaverse.slack.com). ## Acknowledgment diff --git a/data-raw/data.R b/data-raw/data.R index 10d16120e..37c73cef8 100644 --- a/data-raw/data.R +++ b/data-raw/data.R @@ -1,16 +1,16 @@ ## code to prepare `data` for testing examples library(scda) -rADAE <- synthetic_cdisc_data("latest")$adae # nolint: object_name. +rADAE <- synthetic_cdisc_data("latest")$adae usethis::use_data(rADAE) -rADLB <- synthetic_cdisc_data("latest")$adlb # nolint: object_name. +rADLB <- synthetic_cdisc_data("latest")$adlb usethis::use_data(rADLB) -rADRS <- synthetic_cdisc_data("latest")$adrs # nolint: object_name. +rADRS <- synthetic_cdisc_data("latest")$adrs usethis::use_data(rADRS) -rADSL <- synthetic_cdisc_data("latest")$adsl # nolint: object_name. +rADSL <- synthetic_cdisc_data("latest")$adsl usethis::use_data(rADSL) -rADTTE <- synthetic_cdisc_data("latest")$adtte # nolint: object_name. +rADTTE <- synthetic_cdisc_data("latest")$adtte usethis::use_data(rADTTE) diff --git a/inst/WORDLIST b/inst/WORDLIST index a521b3097..f2eca510a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,3 +1,4 @@ +customizable Forkers Hoffmann TLG @@ -5,6 +6,9 @@ UI facetting funder pre +Prebuilt repo reproducibility +sortable tabset +UI diff --git a/man-roxygen/ggplot2_args_multi.R b/man-roxygen/ggplot2_args_multi.R index 332f0084d..dc0497942 100644 --- a/man-roxygen/ggplot2_args_multi.R +++ b/man-roxygen/ggplot2_args_multi.R @@ -1,4 +1,4 @@ -#' @param ggplot2_args optional, (`ggplot2_args`) object created by [`teal.widgets::ggplot2_args()`] +#' @param ggplot2_args (`ggplot2_args`) optional, object created by [`teal.widgets::ggplot2_args()`] #' with settings for all the plots or named list of `ggplot2_args` objects for plot-specific settings. #' The argument is merged with options variable `teal.ggplot2_args` and default module setup. #' diff --git a/man/add_facet_labels.Rd b/man/add_facet_labels.Rd index 00dffea1b..439b43998 100644 --- a/man/add_facet_labels.Rd +++ b/man/add_facet_labels.Rd @@ -2,28 +2,27 @@ % Please edit documentation in R/utils.R \name{add_facet_labels} \alias{add_facet_labels} -\title{Add axis labels that show facetting variable} +\title{Add labels for facets to a \code{ggplot2} object} \usage{ add_facet_labels(p, xfacet_label = NULL, yfacet_label = NULL) } \arguments{ -\item{p}{\code{ggplot2} object to add facet labels to} +\item{p}{(\code{ggplot2}) object to which facet labels will be added.} -\item{xfacet_label}{label of facet along x axis (nothing created if NULL), -if vector, will be concatenated with " & "} +\item{xfacet_label}{(\code{character}) Label for the facet along the x-axis. +If \code{NULL}, no label is added. If a vector, labels are joined with " & ".} -\item{yfacet_label}{label of facet along y axis (nothing created if NULL), -if vector, will be concatenated with " & "} +\item{yfacet_label}{(\code{character}) Label for the facet along the y-axis. +Similar behavior to \code{xfacet_label}.} } \value{ -grid grob object (to be drawn with \code{grid.draw}) +Returns \code{grid} or \code{grob} object (to be drawn with \code{grid.draw}) } \description{ -Add axis labels that show facetting variable +Enhances a \code{ggplot2} plot by adding labels that describe +the faceting variables along the x and y axes. } \examples{ -# we put donttest to avoid strictr error with seq along.with argument -\donttest{ library(ggplot2) library(grid) @@ -31,7 +30,7 @@ p <- ggplot(mtcars) + aes(x = mpg, y = disp) + geom_point() + facet_grid(gear ~ cyl) -p + xfacet_label <- "cylinders" yfacet_label <- "gear" res <- add_facet_labels(p, xfacet_label, yfacet_label) @@ -44,6 +43,5 @@ grid.newpage() grid.draw(add_facet_labels(p, xfacet_label, yfacet_label = NULL)) grid.newpage() grid.draw(add_facet_labels(p, xfacet_label = NULL, yfacet_label = NULL)) -} } diff --git a/man/call_fun_dots.Rd b/man/call_fun_dots.Rd index 001a654b2..7905870da 100644 --- a/man/call_fun_dots.Rd +++ b/man/call_fun_dots.Rd @@ -7,25 +7,14 @@ call_fun_dots(fun, str_args) } \arguments{ -\item{fun}{(\code{character}) Name of a function where the \code{...} argument -shall be replaced by values from \code{str_args}.} +\item{fun}{(\code{character}) Name of a function where the \code{...} argument shall be replaced by values from \code{str_args}.} -\item{str_args}{(\code{character}) A character vector that the function shall -be executed with} +\item{str_args}{(\code{character}) A character vector that the function shall be executed with} } \value{ -: call (i.e. expression) of the function provided by \code{fun} -with arguments provided by \code{str_args}. +Value of call to \code{fun} with arguments specified in \code{str_args}. } \description{ Call a function with a character vector for the \code{...} argument } -\examples{ -\dontrun{ -a <- 1 -b <- 2 -call_fun_dots("sum", c("a", "b")) -eval(call_fun_dots("sum", c("a", "b"))) -} -} \keyword{internal} diff --git a/man/create_sparklines.Rd b/man/create_sparklines.Rd index 2d7be08ce..e269ffb51 100644 --- a/man/create_sparklines.Rd +++ b/man/create_sparklines.Rd @@ -2,70 +2,52 @@ % Please edit documentation in R/tm_variable_browser.R \name{create_sparklines} \alias{create_sparklines} -\alias{create_sparklines.default} +\alias{create_sparklines.logical} +\alias{create_sparklines.numeric} +\alias{create_sparklines.character} +\alias{create_sparklines.factor} \alias{create_sparklines.Date} \alias{create_sparklines.POSIXct} \alias{create_sparklines.POSIXlt} -\alias{create_sparklines.character} -\alias{create_sparklines.logical} -\alias{create_sparklines.factor} -\alias{create_sparklines.numeric} +\alias{create_sparklines.default} \title{S3 generic for \code{sparkline} widget HTML} \usage{ create_sparklines(arr, width = 150, ...) -\method{create_sparklines}{default}(arr, width = 150, ...) +\method{create_sparklines}{logical}(arr, ...) -\method{create_sparklines}{Date}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) +\method{create_sparklines}{numeric}(arr, width = 150, ...) -\method{create_sparklines}{POSIXct}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) +\method{create_sparklines}{character}(arr, ...) -\method{create_sparklines}{POSIXlt}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) +\method{create_sparklines}{factor}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) -\method{create_sparklines}{character}(arr, ...) +\method{create_sparklines}{Date}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) -\method{create_sparklines}{logical}(arr, ...) +\method{create_sparklines}{POSIXct}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) -\method{create_sparklines}{factor}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) +\method{create_sparklines}{POSIXlt}(arr, width = 150, bar_spacing = 5, bar_width = 20, ...) -\method{create_sparklines}{numeric}(arr, width = 150, ...) +\method{create_sparklines}{default}(arr, width = 150, ...) } \arguments{ \item{arr}{vector of any type and length} \item{width}{\code{numeric} the width of the \code{sparkline} widget (pixels)} -\item{...}{\code{list} additional options passed to bar plots of \code{jquery.sparkline}; see -\href{https://omnipotent.net/jquery.sparkline/#common}{\code{jquery.sparkline docs}}} +\item{...}{\code{list} additional options passed to bar plots of \code{jquery.sparkline}; +see \href{https://omnipotent.net/jquery.sparkline/#common}{\verb{jquery.sparkline docs}}} -\item{bar_spacing}{\code{numeric} spacing between the bars (in pixels)} +\item{bar_spacing}{\code{numeric} the spacing between the bars (in pixels)} -\item{bar_width}{\code{numeric} width of the bars (in pixels)} +\item{bar_width}{\code{numeric} the width of the bars (in pixels)} } \value{ -character variable containing the HTML code of the \code{sparkline} HTML widget - -\code{character} with HTML code for the \code{sparkline} widget - -\code{character} with HTML code for the \code{sparkline} widget - -\code{character} with HTML code for the \code{sparkline} widget - -\code{character} with HTML code for the \code{sparkline} widget - -\code{character} with HTML code for the \code{sparkline} widget - -\code{character} with HTML code for the \code{sparkline} widget - -\code{character} with HTML code for the \code{sparkline} widget +Character string containing HTML code of the \code{sparkline} HTML widget. } \description{ Generates the \code{sparkline} HTML code corresponding to the input array. For numeric variables creates a box plot, for character and factors - bar plot. Produces an empty string for variables of other types. - -Coerces a character vector to factor and delegates to the \code{create_sparklines.factor} - -Coerces logical vector to factor and delegates to the \code{create_sparklines.factor} } \keyword{internal} diff --git a/man/establish_updating_selection.Rd b/man/establish_updating_selection.Rd index d4ed4f7f3..112001743 100644 --- a/man/establish_updating_selection.Rd +++ b/man/establish_updating_selection.Rd @@ -9,7 +9,7 @@ establish_updating_selection(datanames, input, plot_var, columns_names) \arguments{ \item{datanames}{(\code{character}) the name of the dataset} -\item{input}{(\code{session$input}) the shiny session input} +\item{input}{(\code{session$input}) the \code{shiny} session input} \item{plot_var}{(\code{list}) the list containing the currently selected dataset (tab) and its column names} diff --git a/man/extract_input.Rd b/man/extract_input.Rd deleted file mode 100644 index 5847b36fa..000000000 --- a/man/extract_input.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{extract_input} -\alias{extract_input} -\title{Extract html id for \code{data_extract_ui}} -\usage{ -extract_input(varname, dataname, filter = FALSE) -} -\arguments{ -\item{varname}{character original html id. -This will be mostly retrieved with \code{ns("original id")} in \code{ui} or -\code{session$ns("original id")} in server function.} - -\item{dataname}{character \code{dataname} from data_extract input. -This might be retrieved like \code{teal.transform::data_extract_spec(...)[[1]]$dataname}.} - -\item{filter}{logical if the connected \code{extract_data_spec} is used with \code{filter} option.} -} -\description{ -The \code{data_extract_ui} is located under extended html id. -We could not use \code{ns("original id")} for reference, as it is extended with specific suffixes. -} -\keyword{internal} diff --git a/man/get_scatterplotmatrix_stats.Rd b/man/get_scatterplotmatrix_stats.Rd index 514c70f43..176b24cb1 100644 --- a/man/get_scatterplotmatrix_stats.Rd +++ b/man/get_scatterplotmatrix_stats.Rd @@ -14,36 +14,35 @@ get_scatterplotmatrix_stats( ) } \arguments{ -\item{x}{\code{numeric}} +\item{x, y}{(\code{numeric}) vectors of data values. \code{x} and \code{y} must have the same length.} -\item{y}{\code{numeric}} +\item{.f}{(\code{function}) function that accepts x and y as formula input \code{~ x + y}. +Default \code{stats::cor.test}.} -\item{.f}{\code{function}, function that accepts x and y as formula input \code{~ x + y}. -Default \code{stats::cor.test}} +\item{.f_args}{(\code{list}) of arguments to be passed to \code{.f}.} -\item{.f_args}{\code{list} of arguments to be passed to \code{.f}} +\item{round_stat}{(\code{integer(1)}) optional, number of decimal places to use when rounding the estimate.} -\item{round_stat}{\code{integer}} - -\item{round_pval}{\code{integer}} +\item{round_pval}{(\code{integer(1)}) optional, number of decimal places to use when rounding the p-value.} } \value{ -\code{character} with stats. For \code{stats::cor.test} correlation coefficient and p-value. +Character with stats. For \code{\link[stats:cor.test]{stats::cor.test()}} correlation coefficient and p-value. } \description{ -uses stats::cor.test per default for all numerical input variables and converts results -to character vector. Could be extended if different stats for different variable -types are needed. Meant to be called from \code{lattice::panel.text}. +Uses \code{\link[stats:cor.test]{stats::cor.test()}} per default for all numerical input variables and converts results +to character vector. +Could be extended if different stats for different variable types are needed. +Meant to be called from \code{\link[lattice:llines]{lattice::panel.text()}}. } \details{ -presently we need to use a formula input for \code{stats::cor.test} because +Presently we need to use a formula input for \code{stats::cor.test} because \code{na.fail} only gets evaluated when a formula is passed (see below). -\preformatted{ -x = c(1,3,5,7,NA) + +\if{html}{\out{
}}\preformatted{x = c(1,3,5,7,NA) y = c(3,6,7,8,1) stats::cor.test(x, y, na.action = "na.fail") stats::cor.test(~ x + y, na.action = "na.fail") -} +}\if{html}{\out{
}} } \examples{ set.seed(1) @@ -56,4 +55,5 @@ get_scatterplotmatrix_stats(x, y, .f = stats::cor.test, .f_args = list( method = "pearson", na.action = na.fail )) + } diff --git a/man/include_css_files.Rd b/man/include_css_files.Rd index dad825f75..5065250b3 100644 --- a/man/include_css_files.Rd +++ b/man/include_css_files.Rd @@ -7,10 +7,10 @@ include_css_files(pattern = "*") } \arguments{ -\item{pattern}{(\code{character}) pattern of files to be included} +\item{pattern}{(\code{character}) optional, regular expression to match the file names to be included.} } \value{ -HTML code that includes \code{CSS} files +HTML code that includes \code{CSS} files. } \description{ \code{system.file} should not be used to access files in other packages, it does diff --git a/man/is_tab_active_js.Rd b/man/is_tab_active_js.Rd index 05b67aa04..1d8031073 100644 --- a/man/is_tab_active_js.Rd +++ b/man/is_tab_active_js.Rd @@ -2,16 +2,20 @@ % Please edit documentation in R/utils.R \name{is_tab_active_js} \alias{is_tab_active_js} -\title{Get a string with java-script code checking if the specific tab is clicked} +\title{JavaScript condition to check if a specific tab is active} \usage{ is_tab_active_js(id, name) } \arguments{ -\item{id}{\code{character(1)} the id of the tab panel with tabs.} +\item{id}{(\code{character(1)}) the id of the tab panel with tabs.} -\item{name}{\code{character(1)} the name of the tab.} +\item{name}{(\code{character(1)}) the name of the tab.} +} +\value{ +JavaScript expression to be used in \code{shiny::conditionalPanel()} to determine +if the specified tab is active. } \description{ -will be the input for \code{shiny::conditionalPanel()} +JavaScript condition to check if a specific tab is active } \keyword{internal} diff --git a/man/plot_var_summary.Rd b/man/plot_var_summary.Rd index 423c9297c..0b36bba23 100644 --- a/man/plot_var_summary.Rd +++ b/man/plot_var_summary.Rd @@ -28,7 +28,7 @@ density line, for factors it creates frequency plot} \item{display_density}{(\code{logical}) should density estimation be displayed for numeric values} -\item{remove_NA_hist}{(\code{logical}) should (\code{NA}) values be removed for histogram of factor like variables} +\item{remove_NA_hist}{(\code{logical}) should \code{NA} values be removed for histogram of factor like variables} \item{outlier_definition}{if 0 no outliers are removed, otherwise outliers (those more than outlier_definition*IQR below/above Q1/Q3 be removed)} diff --git a/man/rADTTE.Rd b/man/rADTTE.Rd index 56d859833..185d391d9 100644 --- a/man/rADTTE.Rd +++ b/man/rADTTE.Rd @@ -3,7 +3,7 @@ \docType{data} \name{rADTTE} \alias{rADTTE} -\title{Random Time to Event Analysis Dataset} +\title{Random time to event analysis dataset} \format{ An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 2000 rows and 67 columns. } @@ -14,7 +14,7 @@ internal rADTTE } \description{ -Random Time to Event Analysis Dataset +Random time to event analysis dataset } \keyword{datasets} \keyword{internal} diff --git a/man/render_single_tab.Rd b/man/render_single_tab.Rd index c4a98765a..015539a1d 100644 --- a/man/render_single_tab.Rd +++ b/man/render_single_tab.Rd @@ -19,11 +19,11 @@ render_single_tab( \item{parent_dataname}{(\code{character}) the name of a parent \code{dataname} to filter out variables from} -\item{output}{(\code{session$output}) the shiny session output} +\item{output}{(\code{session$output}) the \code{shiny} session output} -\item{data}{(\code{tdata}) the object containing all datasets} +\item{data}{(\code{teal_data}) the object containing all datasets} -\item{input}{(\code{session$input}) the shiny session input} +\item{input}{(\code{session$input}) the \code{shiny} session input} \item{columns_names}{(\code{environment}) the environment containing bindings for each dataset} diff --git a/man/render_tab_header.Rd b/man/render_tab_header.Rd index 25321a6ba..a78896088 100644 --- a/man/render_tab_header.Rd +++ b/man/render_tab_header.Rd @@ -9,9 +9,9 @@ render_tab_header(dataset_name, output, data) \arguments{ \item{dataset_name}{(\code{character}) the name of the dataset of the tab} -\item{output}{(\code{session$output}) the shiny session output} +\item{output}{(\code{session$output}) the \code{shiny} session output} -\item{data}{(\code{tdata}) the object containing all datasets} +\item{data}{(\code{teal_data}) the object containing all datasets} } \description{ Renders the text headlining a single tab in the left-hand side tabset panel diff --git a/man/render_tab_table.Rd b/man/render_tab_table.Rd index 152860aa6..c5eebb929 100644 --- a/man/render_tab_table.Rd +++ b/man/render_tab_table.Rd @@ -19,11 +19,11 @@ render_tab_table( \item{parent_dataname}{(\code{character}) the name of a parent \code{dataname} to filter out variables from} -\item{output}{(\code{session$output}) the shiny session output} +\item{output}{(\code{session$output}) the \code{shiny} session output} -\item{data}{(\code{tdata}) the object containing all datasets} +\item{data}{(\code{teal_data}) the object containing all datasets} -\item{input}{(\code{session$input}) the shiny session input} +\item{input}{(\code{session$input}) the \code{shiny} session input} \item{columns_names}{(\code{environment}) the environment containing bindings for each dataset} diff --git a/man/render_tabset_panel_content.Rd b/man/render_tabset_panel_content.Rd index 95c160eb3..b28a95c90 100644 --- a/man/render_tabset_panel_content.Rd +++ b/man/render_tabset_panel_content.Rd @@ -19,11 +19,11 @@ render_tabset_panel_content( \item{parent_dataname}{(\code{character}) the name of a parent \code{dataname} to filter out variables from} -\item{output}{(\code{session$output}) the shiny session output} +\item{output}{(\code{session$output}) the \code{shiny} session output} -\item{data}{(\code{tdata}) the object containing all datasets} +\item{data}{(\code{teal_data}) the object containing all datasets} -\item{input}{(\code{session$input}) the shiny session input} +\item{input}{(\code{session$input}) the \code{shiny} session input} \item{columns_names}{(\code{environment}) the environment containing bindings for each dataset} diff --git a/man/shared_params.Rd b/man/shared_params.Rd index f7fb3ffac..1ea6b7094 100644 --- a/man/shared_params.Rd +++ b/man/shared_params.Rd @@ -2,18 +2,18 @@ % Please edit documentation in R/utils.R \name{shared_params} \alias{shared_params} -\title{Shared Parameters} +\title{Shared parameters documentation} \arguments{ -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{rotate_xaxis_labels}{optional, (\code{logical}) Whether to rotate plot X axis labels. Does not +\item{rotate_xaxis_labels}{(\code{logical}) optional, whether to rotate plot X axis labels. Does not rotate by default (\code{FALSE}).} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} \item{ggplot2_args}{(\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for the module plot. @@ -27,14 +27,32 @@ The argument is merged with options variable \code{teal.basic_table_args} and de For more details see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} + +\item{alpha}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point opacity. +\itemize{ +\item When the length of \code{alpha} is one: the plot points will have a fixed opacity. +\item When the length of \code{alpha} is three: the plot points opacity are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} + +\item{size}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point size. +\itemize{ +\item When the length of \code{size} is one: the plot point sizes will have a fixed size. +\item When the length of \code{size} is three: the plot points size are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -Contains arguments that are shared between multiple functions -in the package to avoid repetition using \code{inheritParams}. +Defines common arguments shared across multiple functions in the package +to avoid repetition by using \code{inheritParams}. } \keyword{internal} diff --git a/man/teal.modules.general.Rd b/man/teal.modules.general.Rd index 4a9330dab..718d336fd 100644 --- a/man/teal.modules.general.Rd +++ b/man/teal.modules.general.Rd @@ -4,7 +4,7 @@ \name{teal.modules.general} \alias{teal.modules.general-package} \alias{teal.modules.general} -\title{teal.modules.general: General modules to add to a teal application} +\title{\code{teal.modules.general}: General modules to add to a \code{teal} application} \description{ The modules in this package are generic modules that should work with any data set (not necessarily for clinical trials data). diff --git a/man/tm_a_pca.Rd b/man/tm_a_pca.Rd index 0242a7910..a4fa1e679 100644 --- a/man/tm_a_pca.Rd +++ b/man/tm_a_pca.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_a_pca.R \name{tm_a_pca} \alias{tm_a_pca} -\title{Principal component analysis module} +\title{\code{teal} module: Principal component analysis} \usage{ tm_a_pca( label = "Principal Component Analysis", @@ -24,17 +24,17 @@ tm_a_pca( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{dat}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Columns used to compute PCA.} +specifying columns used to compute PCA.} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\item{ggplot2_args}{optional, (\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} +\item{ggplot2_args}{(\code{ggplot2_args}) optional, object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for all the plots or named list of \code{ggplot2_args} objects for plot-specific settings. The argument is merged with options variable \code{teal.ggplot2_args} and default module setup. @@ -42,39 +42,56 @@ List names should match the following: \code{c("default", "Elbow plot", "Circle For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} -\item{rotate_xaxis_labels}{optional, (\code{logical}) Whether to rotate plot X axis labels. Does not +\item{rotate_xaxis_labels}{(\code{logical}) optional, whether to rotate plot X axis labels. Does not rotate by default (\code{FALSE}).} -\item{font_size}{optional, (\code{numeric}) font size control for title, x-axis label, y-axis label and legend. -If scalar then the font size will have a fixed size. If a slider should be presented to adjust the plot -point sizes dynamically then it can be a vector of length three with \code{c(value, min, max)}.} - -\item{alpha}{optional, (\code{numeric}) If scalar then the plot points will have a fixed opacity. If a -slider should be presented to adjust the plot point opacity dynamically then it can be a vector of -length three with \code{c(value, min, max)}.} - -\item{size}{optional, (\code{numeric}) If scalar then the plot point sizes will have a fixed size. -If a slider should be presented to adjust the plot point sizes dynamically then it can be a -vector of length three with \code{c(value, min, max)}.} - -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{font_size}{(\code{numeric}) optional, specifies font size. +It controls the font size for plot titles, axis labels, and legends. +\itemize{ +\item If vector of \code{length == 1} then the font sizes will have a fixed size. +\item while vector of \code{value}, \code{min}, and \code{max} allows dynamic adjustment. +}} + +\item{alpha}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point opacity. +\itemize{ +\item When the length of \code{alpha} is one: the plot points will have a fixed opacity. +\item When the length of \code{alpha} is three: the plot points opacity are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} + +\item{size}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point size. +\itemize{ +\item When the length of \code{size} is one: the plot point sizes will have a fixed size. +\item When the length of \code{size} is three: the plot points size are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} + +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -Principal component analysis module +Module conducts principal component analysis (PCA) on a given dataset and offers different +ways of visualizing the outcomes, including elbow plot, circle plot, biplot, and eigenvector plot. +Additionally, it enables dynamic customization of plot aesthetics, such as opacity, size, and +font size, through UI inputs. } \examples{ -# general data example library(teal.widgets) +# general data example data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) USArrests <- USArrests }) + datanames(data) <- "USArrests" app <- init( @@ -99,17 +116,14 @@ app <- init( ) ) ) - if (interactive()) { shinyApp(app$ui, app$server) } # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL }) datanames(data) <- "ADSL" @@ -118,7 +132,7 @@ join_keys(data) <- default_cdisc_join_keys[datanames(data)] app <- init( data = data, modules = modules( - teal.modules.general::tm_a_pca( + tm_a_pca( "PCA", dat = data_extract_spec( dataname = "ADSL", @@ -137,7 +151,6 @@ app <- init( ) ) ) - if (interactive()) { shinyApp(app$ui, app$server) } diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd index 17caf06a9..dc4f458f3 100644 --- a/man/tm_a_regression.Rd +++ b/man/tm_a_regression.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_a_regression.R \name{tm_a_regression} \alias{tm_a_regression} -\title{Scatterplot and Regression Model} +\title{\code{teal} module: Scatterplot and regression analysis} \usage{ tm_a_regression( label = "Regression Analysis", @@ -31,23 +31,29 @@ Regressor variables from an incoming dataset with filtering and selecting.} \item{response}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) Response variables from an incoming dataset with filtering and selecting.} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{alpha}{optional, (\code{numeric}) If scalar then the plot points will have a fixed opacity. If a -slider should be presented to adjust the plot point opacity dynamically then it can be a vector of -length three with \code{c(value, min, max)}.} +\item{alpha}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point opacity. +\itemize{ +\item When the length of \code{alpha} is one: the plot points will have a fixed opacity. +\item When the length of \code{alpha} is three: the plot points opacity are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} -\item{size}{optional, (\code{numeric}) If scalar then the plot point sizes will have a fixed size -If a slider should be presented to adjust the plot point sizes dynamically then it can be a -vector of length three with \code{c(value, min, max)}.} +\item{size}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point size. +\itemize{ +\item When the length of \code{size} is one: the plot point sizes will have a fixed size. +\item When the length of \code{size} is three: the plot points size are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\item{ggplot2_args}{optional, (\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} +\item{ggplot2_args}{(\code{ggplot2_args}) optional, object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for all the plots or named list of \code{ggplot2_args} objects for plot-specific settings. The argument is merged with options variable \code{teal.ggplot2_args} and default module setup. @@ -55,13 +61,14 @@ List names should match the following: \verb{c("default", "Response vs Regressor For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{default_plot_type}{optional, (\code{numeric}) Defaults to Response vs Regressor. +\item{default_plot_type}{(\code{numeric}) optional, defaults to "Response vs Regressor". \enumerate{ \item Response vs Regressor \item Residuals vs Fitted @@ -72,7 +79,7 @@ into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} el \item Cook's dist vs Leverage }} -\item{default_outlier_label}{optional, (\code{character}) The default column selected to label outliers.} +\item{default_outlier_label}{(\code{character}) optional, default column selected to label outliers.} \item{label_segment_threshold}{(\code{numeric(1)} or \code{numeric(3)}) Minimum distance between label and point on the plot that triggers the creation of @@ -90,8 +97,14 @@ It takes the form of \code{c(value, min, max)} and it is passed to the \code{val argument in \code{teal.widgets::optionalSliderInputValMinMax}. }} } +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. +} \description{ -Scatterplot and Regression Model +Module for visualizing regression analysis, including scatterplots and +various regression diagnostics plots. +It allows users to explore the relationship between a set of regressors and a response variable, +visualize residuals, and identify outliers. } \note{ For more examples, please see the vignette "Using regression plots" via @@ -103,7 +116,7 @@ library(teal.widgets) data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) CO2 <- CO2 }) datanames(data) <- c("CO2") @@ -148,7 +161,7 @@ library(teal.widgets) data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL }) datanames(data) <- "ADSL" diff --git a/man/tm_data_table.Rd b/man/tm_data_table.Rd index ab6e5ad09..f9e799750 100644 --- a/man/tm_data_table.Rd +++ b/man/tm_data_table.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_data_table.R \name{tm_data_table} \alias{tm_data_table} -\title{Data Table Viewer Teal Module} +\title{\code{teal} module: Data table viewer} \usage{ tm_data_table( label = "Data Table", @@ -20,47 +20,52 @@ tm_data_table( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{variables_selected}{(\code{list}) A named list of character vectors of the variables (i.e. columns) -which should be initially shown for each dataset. Names of list elements should correspond to the names -of the datasets available in the app. If no entry is specified for a dataset, the first six variables from that +\item{variables_selected}{(\verb{named list}) Character vectors of the variables (i.e. columns) +which should be initially shown for each dataset. +Names of list elements should correspond to the names of the datasets available in the app. +If no entry is specified for a dataset, the first six variables from that dataset will initially be shown.} \item{datasets_selected}{(\code{character}) A vector of datasets which should be shown and in what order. Names in the vector have to correspond with datasets names. -If vector of length zero (default) then all datasets are shown. -Note: Only datasets of the \code{data.frame} class are compatible; -using other types will cause an error.} +If vector of \code{length == 0} (default) then all datasets are shown. +Note: Only datasets of the \code{data.frame} class are compatible.} -\item{dt_args}{(named \code{list}) Additional arguments to be passed to \code{DT::datatable} +\item{dt_args}{(\verb{named list}) Additional arguments to be passed to \code{\link[DT:datatable]{DT::datatable()}} (must not include \code{data} or \code{options}).} -\item{dt_options}{(named \code{list}) The \code{options} argument to \code{DT::datatable}. By default +\item{dt_options}{(\verb{named list}) The \code{options} argument to \code{DT::datatable}. By default \code{list(searching = FALSE, pageLength = 30, lengthMenu = c(5, 15, 30, 100), scrollX = TRUE)}} \item{server_rendering}{(\code{logical}) should the data table be rendered server side -(see \code{server} argument of \code{DT::renderDataTable()})} +(see \code{server} argument of \code{\link[DT:dataTableOutput]{DT::renderDataTable()}})} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -A data table viewer shows the data using a paginated table. -specifically designed for use with \code{data.frames}. +Module provides a dynamic and interactive way to view \code{data.frame}s in a \code{teal} application. +It uses the \code{DT} package to display data tables in a paginated, searchable, and sortable format, +which helps to enhance data exploration and analysis. } \details{ -The \code{DT} package has an option \code{DT.TOJSON_ARGS} to show \code{Inf} and \code{NA} in data tables. If this is something -you require then set \code{options(DT.TOJSON_ARGS = list(na = "string"))} before running the module. +The \code{DT} package has an option \code{DT.TOJSON_ARGS} to show \code{Inf} and \code{NA} in data tables. +Configure the \code{DT.TOJSON_ARGS} option via +\code{options(DT.TOJSON_ARGS = list(na = "string"))} before running the module. Note though that sorting of numeric columns with \code{NA}/\code{Inf} will be lexicographic not numerical. } \examples{ # general data example - data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) iris <- iris }) datanames(data) <- c("iris") @@ -83,7 +88,7 @@ if (interactive()) { # CDISC data example data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL }) datanames(data) <- "ADSL" diff --git a/man/tm_file_viewer.Rd b/man/tm_file_viewer.Rd index a1be536fb..c04f73a2e 100644 --- a/man/tm_file_viewer.Rd +++ b/man/tm_file_viewer.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_file_viewer.R \name{tm_file_viewer} \alias{tm_file_viewer} -\title{File Viewer Teal Module} +\title{\code{teal} module: File viewer} \usage{ tm_file_viewer( label = "File Viewer Module", @@ -13,14 +13,18 @@ tm_file_viewer( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{input_path}{optional, (\code{list}) of the input paths to either: specific files of accepted formats, -a directory or a URL. The paths can be specified as absolute paths or relative to the running -directory of the application. Will default to current working directory if not supplied.} +\item{input_path}{(\code{list}) of the input paths, optional. Each element can be: + +Paths can be specified as absolute paths or relative to the running directory of the application. +Default to the current working directory if not supplied.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ The file viewer module provides a tool to view static files. -Supported formats include text formats, \code{PDF}, \code{PNG}, \code{APNG}, -\code{JPEG}, \code{SVG}, \code{WEBP}, \code{GIF} and \code{BMP}. +Supported formats include text formats, \code{PDF}, \code{PNG} \code{APNG}, +\code{JPEG} \code{SVG}, \code{WEBP}, \code{GIF} and \code{BMP}. } \examples{ data <- teal_data() @@ -29,16 +33,15 @@ data <- within(data, { }) datanames(data) <- c("data") -app <- teal::init( +app <- init( data = data, - modules = teal::modules( - teal.modules.general::tm_file_viewer( + modules = modules( + tm_file_viewer( input_path = list( folder = system.file("sample_files", package = "teal.modules.general"), png = system.file("sample_files/sample_file.png", package = "teal.modules.general"), txt = system.file("sample_files/sample_file.txt", package = "teal.modules.general"), - url = - "https://www.fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" + url = "https://fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" ) ) ) diff --git a/man/tm_front_page.Rd b/man/tm_front_page.Rd index 0efa390d0..801bbd00e 100644 --- a/man/tm_front_page.Rd +++ b/man/tm_front_page.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_front_page.R \name{tm_front_page} \alias{tm_front_page} -\title{Front page module} +\title{\code{teal} module: Front page} \usage{ tm_front_page( label = "Front page", @@ -17,38 +17,37 @@ tm_front_page( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{header_text}{\verb{character vector} text to be shown at the top of the module, for each +\item{header_text}{(\code{character} vector) text to be shown at the top of the module, for each element, if named the name is shown first in bold as a header followed by the value. The first -element's header is displayed larger than the others} +element's header is displayed larger than the others.} -\item{tables}{\verb{named list of dataframes} tables to be shown in the module} +\item{tables}{(\verb{named list} of \code{data.frame}s) tables to be shown in the module.} -\item{additional_tags}{\code{shiny.tag.list} or \code{html} additional shiny tags or \code{html} to be included after the table, +\item{additional_tags}{(\code{shiny.tag.list} or \code{html}) additional \code{shiny} tags or \code{html} to be included after the table, for example to include an image, \code{tagList(tags$img(src = "image.png"))} or to include further \code{html}, -\code{HTML("html text here")}} +\code{HTML("html text here")}.} -\item{footnotes}{\verb{character vector} text to be shown at the bottom of the module, for each -element, if named the name is shown first in bold, followed by the value} +\item{footnotes}{(\code{character} vector) of text to be shown at the bottom of the module, for each +element, if named the name is shown first in bold, followed by the value.} -\item{show_metadata}{\code{logical} should the metadata of the datasets be available on the module?} +\item{show_metadata}{(\code{logical}) indicating whether the metadata of the datasets be available on the module.} } \value{ -A \code{teal} module to be used in \code{teal} applications +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -This \code{teal} module creates a simple front page for \code{teal} applications +Creates a simple front page for \code{teal} applications, displaying +introductory text, tables, additional \code{html} or \code{shiny} tags, and footnotes. } \examples{ - data <- teal_data() data <- within(data, { - library(nestcolor) - ADSL <- teal.modules.general::rADSL + require(nestcolor) + ADSL <- rADSL attr(ADSL, "metadata") <- list("Author" = "NEST team", "data_source" = "synthetic data") }) -datanames <- c("ADSL") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +datanames(data) <- "ADSL" +join_keys(data) <- default_cdisc_join_keys[datanames(data)] table_1 <- data.frame(Info = c("A", "B"), Text = c("A", "B")) table_2 <- data.frame(`Column 1` = c("C", "D"), `Column 2` = c(5.5, 6.6), `Column 3` = c("A", "B")) @@ -60,10 +59,10 @@ table_input <- list( "Table 3" = table_3 ) -app <- teal::init( +app <- init( data = data, - modules = teal::modules( - teal.modules.general::tm_front_page( + modules = modules( + tm_front_page( header_text = c( "Important information" = "It can go here.", "Other information" = "Can go here." @@ -77,7 +76,9 @@ app <- teal::init( header = tags$h1("Sample Application"), footer = tags$p("Application footer"), ) + if (interactive()) { shinyApp(app$ui, app$server) } + } diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index d5182e335..ef47169a7 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_g_association.R \name{tm_g_association} \alias{tm_g_association} -\title{Stack Plots of variables and show association with reference variable} +\title{\code{teal} module: Stack plots of variables and show association with reference variable} \usage{ tm_g_association( label = "Association", @@ -25,30 +25,32 @@ tm_g_association( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{ref}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -reference variable, must set \code{multiple = FALSE}.} +Reference variable, must accepts a \code{data_extract_spec} with \code{select_spec(multiple = FALSE)} +to ensure single selection option.} \item{vars}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -associated variables.} +Variables to be associated with the reference variable.} -\item{show_association}{optional, (\code{logical}) Whether show association of \code{vars} +\item{show_association}{(\code{logical}) optional, whether show association of \code{vars} with reference variable. Defaults to \code{TRUE}.} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{distribution_theme, association_theme}{optional, (\code{character}) \code{ggplot2} themes to be used by default. +\item{distribution_theme, association_theme}{(\code{character}) optional, \code{ggplot2} themes to be used by default. Default to \code{"gray"}.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{ggplot2_args}{optional, (\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} +\item{ggplot2_args}{(\code{ggplot2_args}) optional, object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for all the plots or named list of \code{ggplot2_args} objects for plot-specific settings. The argument is merged with options variable \code{teal.ggplot2_args} and default module setup. @@ -56,20 +58,25 @@ List names should match the following: \code{c("default", "Bivariate1", "Bivaria For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} } +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. +} \description{ -Stack Plots of variables and show association with reference variable +Module provides functionality for visualizing the distribution of variables and +their association with a reference variable. +It supports configuring the appearance of the plots, including themes and whether to show associations. } \note{ For more examples, please see the vignette "Using association plot" via \code{vignette("using-association-plot", package = "teal.modules.general")}. } \examples{ -# general data exapmle library(teal.widgets) +# general data example data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) CO2 <- CO2 factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) CO2[factors] <- lapply(CO2[factors], as.character) @@ -110,11 +117,9 @@ if (interactive()) { } # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL }) datanames(data) <- "ADSL" diff --git a/man/tm_g_bivariate.Rd b/man/tm_g_bivariate.Rd index f1d0398d6..a88344f08 100644 --- a/man/tm_g_bivariate.Rd +++ b/man/tm_g_bivariate.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_g_bivariate.R \name{tm_g_bivariate} \alias{tm_g_bivariate} -\title{Univariate and bivariate visualizations} +\title{\code{teal} module: Univariate and bivariate visualizations} \usage{ tm_g_bivariate( label = "Bivariate Plots", @@ -33,58 +33,60 @@ tm_g_bivariate( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{x}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variable names selected to plot along the x-axis by default. Variable can be numeric, factor or character. -No empty selections are allowed!} +Variable names selected to plot along the x-axis by default. +Can be numeric, factor or character. +No empty selections are allowed.} \item{y}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variable names selected to plot along the y-axis by default. Variable can be numeric, factor or character.} +Variable names selected to plot along the y-axis by default. +Can be numeric, factor or character.} -\item{row_facet}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variables for row facetting.} +\item{row_facet}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specification of the data variable(s) to use for faceting rows.} -\item{col_facet}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variables for col facetting.} +\item{col_facet}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specification of the data variable(s) to use for faceting columns.} -\item{facet}{optional, (\code{logical}) to specify whether the facet encodings \code{ui} elements are toggled +\item{facet}{(\code{logical}) optional, specifies whether the facet encodings \code{ui} elements are toggled on and shown to the user by default. Defaults to \code{TRUE} if either \code{row_facet} or \code{column_facet} are supplied.} -\item{color}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variables selected for the outline color inside the coloring settings. +\item{color}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specification of the data variable(s) selected for the outline color inside the coloring settings. It will be applied when \code{color_settings} is set to \code{TRUE}.} -\item{fill}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variables selected for the fill color inside the coloring settings. +\item{fill}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specification of the data variable(s) selected for the fill color inside the coloring settings. It will be applied when \code{color_settings} is set to \code{TRUE}.} -\item{size}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variables selected for the size of \code{geom_point} plots inside the coloring settings. +\item{size}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specification of the data variable(s) selected for the size of \code{geom_point} plots inside the coloring settings. It will be applied when \code{color_settings} is set to \code{TRUE}.} -\item{use_density}{optional, (\code{logical}) value for whether density (\code{TRUE}) is plotted or -frequency (\code{FALSE}). Defaults to frequency (\code{FALSE}).} +\item{use_density}{(\code{logical}) optional, indicates whether to plot density (\code{TRUE}) or frequency (\code{FALSE}). +Defaults to frequency (\code{FALSE}).} \item{color_settings}{(\code{logical}) Whether coloring, filling and size should be applied and \code{UI} tool offered to the user.} -\item{free_x_scales}{optional, (\code{logical}) Whether X scaling shall be changeable. +\item{free_x_scales}{(\code{logical}) optional, whether X scaling shall be changeable. Does not allow scaling to be changed by default (\code{FALSE}).} -\item{free_y_scales}{optional, (\code{logical}) Whether Y scaling shall be changeable. +\item{free_y_scales}{(\code{logical}) optional, whether Y scaling shall be changeable. Does not allow scaling to be changed by default (\code{FALSE}).} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{rotate_xaxis_labels}{optional, (\code{logical}) Whether to rotate plot X axis labels. Does not +\item{rotate_xaxis_labels}{(\code{logical}) optional, whether to rotate plot X axis labels. Does not rotate by default (\code{FALSE}).} -\item{swap_axes}{optional, (\code{logical}) Whether to swap X and Y axes. Defaults to \code{FALSE}.} +\item{swap_axes}{(\code{logical}) optional, whether to swap X and Y axes. Defaults to \code{FALSE}.} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} \item{ggplot2_args}{(\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for the module plot. @@ -92,14 +94,19 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -Univariate and bivariate visualizations +Module enables the creation of univariate and bivariate plots, +facilitating the exploration of data distributions and relationships between two variables. } \details{ This is a general module to visualize 1 & 2 dimensional data. @@ -109,12 +116,12 @@ For more examples, please see the vignette "Using bivariate plot" via \code{vignette("using-bivariate-plot", package = "teal.modules.general")}. } \examples{ -# general data exapmle library(teal.widgets) +# general data example data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) CO2 <- data.frame(CO2) }) datanames(data) <- c("CO2") @@ -173,11 +180,9 @@ if (interactive()) { # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL }) datanames(data) <- c("ADSL") @@ -233,4 +238,5 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } + } diff --git a/man/tm_g_distribution.Rd b/man/tm_g_distribution.Rd index a359f7333..df5c8775d 100644 --- a/man/tm_g_distribution.Rd +++ b/man/tm_g_distribution.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_g_distribution.R \name{tm_g_distribution} \alias{tm_g_distribution} -\title{Distribution Module} +\title{\code{teal} module: Distribution analysis} \usage{ tm_g_distribution( label = "Distribution Module", @@ -24,20 +24,20 @@ tm_g_distribution( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{dist_var}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Variable to consider for the distribution analysis.} +Variable(s) for which the distribution will be analyzed.} \item{strata_var}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Categorical variable to split the selected distribution variable on.} +Categorical variable used to split the distribution analysis.} -\item{group_var}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Which data columns to use for faceting rows.} +\item{group_var}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) +Variable used for faceting plot into multiple panels.} -\item{freq}{optional, (\code{logical}) Whether to display frequency (\code{TRUE}) or density (\code{FALSE}). +\item{freq}{(\code{logical}) optional, whether to display frequency (\code{TRUE}) or density (\code{FALSE}). Defaults to density (\code{FALSE}).} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\item{ggplot2_args}{optional, (\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} +\item{ggplot2_args}{(\code{ggplot2_args}) optional, object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for all the plots or named list of \code{ggplot2_args} objects for plot-specific settings. The argument is merged with options variable \code{teal.ggplot2_args} and default module setup. @@ -45,16 +45,19 @@ List names should match the following: \code{c("default", "Histogram", "QQplot") For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} -\item{bins}{optional, (\code{integer(1)} or \code{integer(3)}) If scalar then the histogram bins will have a fixed size. -If a slider should be presented to adjust the number of histogram bins dynamically then it can be a -vector of length three with \code{c(value, min, max)}. -Defaults to \code{c(30L, 1L, 100L)}.} +\item{bins}{(\code{integer(1)} or \code{integer(3)}) optional, specifies the number of bins for the histogram. +\itemize{ +\item When the length of \code{bins} is one: The histogram bins will have a fixed size based on the \code{bins} provided. +\item When the length of \code{bins} is three: The histogram bins are dynamically adjusted based on vector of \code{value}, \code{min}, +and \code{max}. +Defaults to \code{c(30L, 1L, 100L)}. +}} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} \item{pre_output}{(\code{shiny.tag}, optional)\cr with text placed before the output to put the output into context. For example a title.} @@ -62,16 +65,18 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} } -\description{ -Distribution Module +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } -\details{ -Module to analyze and explore univariate variable distribution +\description{ +Module is designed to explore the distribution of a single variable within a given dataset. +It offers several tools, such as histograms, Q-Q plots, and various statistical tests to +visually and statistically analyze the variable's distribution. } \examples{ -# general data example library(teal.widgets) +# general data example data <- teal_data() data <- within(data, { iris <- iris @@ -97,8 +102,6 @@ if (interactive()) { } # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { ADSL <- rADSL diff --git a/man/tm_g_response.Rd b/man/tm_g_response.Rd index 71d994bb6..6e9e1e93c 100644 --- a/man/tm_g_response.Rd +++ b/man/tm_g_response.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_g_response.R \name{tm_g_response} \alias{tm_g_response} -\title{Response Plots} +\title{\code{teal} module: Response plot} \usage{ tm_g_response( label = "Response Plot", @@ -27,39 +27,46 @@ tm_g_response( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{response}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Which variable to use as the response. You can define one fixed column by using the -setting \code{fixed = TRUE} inside the \code{select_spec}. -\code{data_extract_spec} must not allow multiple selection in this case.} +Which variable to use as the response. +You can define one fixed column by setting \code{fixed = TRUE} inside the \code{select_spec}. + +The \code{data_extract_spec} must not allow multiple selection in this case.} \item{x}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Which variable to use on the X-axis of the response plot. Allow the user to select multiple -columns from the \code{data} allowed in teal. -\code{data_extract_spec} must not allow multiple selection in this case.} +Specifies which variable to use on the X-axis of the response plot. +Allow the user to select multiple columns from the \code{data} allowed in teal. + +The \code{data_extract_spec} must not allow multiple selection in this case.} -\item{row_facet}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Which data columns to use for faceting rows.} +\item{row_facet}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) +optional specification of the data variable(s) to use for faceting rows.} -\item{col_facet}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Which data to use for faceting columns.} +\item{col_facet}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) +optional specification of the data variable(s) to use for faceting columns.} -\item{coord_flip}{optional, (\code{logical}) Whether to flip coordinates between \code{x} and \code{response}.} +\item{coord_flip}{(\code{logical(1)}) +Indicates whether to flip coordinates between \code{x} and \code{response}. +The default value is \code{FALSE} and it will show the \code{x} variable on the x-axis +and the \code{response} variable on the y-axis.} -\item{count_labels}{optional, (\code{logical}) Whether to show count labels. +\item{count_labels}{(\code{logical(1)}) +Indicates whether to show count labels. Defaults to \code{TRUE}.} -\item{rotate_xaxis_labels}{optional, (\code{logical}) Whether to rotate plot X axis labels. Does not +\item{rotate_xaxis_labels}{(\code{logical}) optional, whether to rotate plot X axis labels. Does not rotate by default (\code{FALSE}).} -\item{freq}{optional, (\code{logical}) Whether to display frequency (\code{TRUE}) or density (\code{FALSE}). +\item{freq}{(\code{logical(1)}) +Indicates whether to display frequency (\code{TRUE}) or density (\code{FALSE}). Defaults to density (\code{FALSE}).} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} \item{ggplot2_args}{(\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for the module plot. @@ -67,14 +74,23 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -Response Plots +Generates a response plot for a given \code{response} and \code{x} variables. +This module allows users customize and add annotations to the plot depending +on the module's arguments. +It supports showing the counts grouped by other variable facets (by row / column), +swapping the coordinates, show count annotations and displaying the response plot +as frequency or density. } \note{ For more examples, please see the vignette "Using response plot" via @@ -86,7 +102,7 @@ library(teal.widgets) data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) mtcars <- mtcars for (v in c("cyl", "vs", "am", "gear")) { mtcars[[v]] <- as.factor(mtcars[[v]]) @@ -134,7 +150,7 @@ library(teal.widgets) data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL }) datanames(data) <- c("ADSL") diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index 16d14c6b0..466294031 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_g_scatterplot.R \name{tm_g_scatterplot} \alias{tm_g_scatterplot} -\title{Create a simple scatterplot} +\title{\code{teal} module: Scatterplot} \usage{ tm_g_scatterplot( label = "Scatterplot", @@ -30,56 +30,63 @@ tm_g_scatterplot( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{x}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) Variable -names selected to plot along the x-axis by default.} +\item{x}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) Specifies +variable names selected to plot along the x-axis by default.} -\item{y}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) Variable -names selected to plot along the y-axis by default.} +\item{y}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) Specifies +variable names selected to plot along the y-axis by default.} -\item{color_by}{optional (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Defines the color encoding. If \code{NULL} then no color encoding option will be displayed.} +\item{color_by}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +defines the color encoding. If \code{NULL} then no color encoding option will be displayed.} -\item{size_by}{optional (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Defines the point size encoding. If \code{NULL} then no size encoding option will be displayed.} +\item{size_by}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +defines the point size encoding. If \code{NULL} then no size encoding option will be displayed.} -\item{row_facet}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Which data columns to use for faceting rows.} +\item{row_facet}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specifies the variable(s) for faceting rows.} -\item{col_facet}{optional, (\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Which data to use for faceting columns.} +\item{col_facet}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specifies the variable(s) for faceting columns.} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{alpha}{optional, (\code{numeric}) If scalar then the plot points will have a fixed opacity. If a -slider should be presented to adjust the plot point opacity dynamically then it can be a vector of -length three with \code{c(value, min, max)}.} +\item{alpha}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point opacity. +\itemize{ +\item When the length of \code{alpha} is one: the plot points will have a fixed opacity. +\item When the length of \code{alpha} is three: the plot points opacity are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} -\item{shape}{optional, (\code{character}) A character vector with the English names of the +\item{shape}{(\code{character}) optional, character vector with the names of the shape, e.g. \code{c("triangle", "square", "circle")}. It defaults to \code{shape_names}. This is a complete list from \code{vignette("ggplot2-specs", package="ggplot2")}.} -\item{size}{optional, (\code{numeric}) If scalar then the plot point sizes will have a fixed size -If a slider should be presented to adjust the plot point sizes dynamically then it can be a -vector of length three with \code{c(value, min, max)}.} +\item{size}{(\code{integer(1)} or \code{integer(3)}) optional, specifies point size. +\itemize{ +\item When the length of \code{size} is one: the plot point sizes will have a fixed size. +\item When the length of \code{size} is three: the plot points size are dynamically adjusted based on +vector of \code{value}, \code{min}, and \code{max}. +}} -\item{max_deg}{optional, (\code{integer}) The maximum degree for the polynomial trend line. Must not be less than 1.} +\item{max_deg}{(\code{integer}) optional, maximum degree for the polynomial trend line. Must not be less than 1.} -\item{rotate_xaxis_labels}{optional, (\code{logical}) Whether to rotate plot X axis labels. Does not +\item{rotate_xaxis_labels}{(\code{logical}) optional, whether to rotate plot X axis labels. Does not rotate by default (\code{FALSE}).} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{table_dec}{optional, (\code{integer}) Number of decimal places used to round numeric values in the table.} +\item{table_dec}{(\code{integer}) optional, number of decimal places used to round numeric values in the table.} \item{ggplot2_args}{(\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for the module plot. @@ -87,20 +94,26 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} } +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. +} \description{ -Create a plot with the \code{\link{ggplot2}[geom_point]} function +Generates a customizable scatterplot using \code{ggplot2}. +This module allows users to select variables for the x and y axes, +color and size encodings, faceting options, and more. It supports log transformations, +trend line additions, and dynamic adjustments of point opacity and size through UI controls. } \note{ For more examples, please see the vignette "Using scatterplot" via \code{vignette("using-scatterplot", package = "teal.modules.general")}. } \examples{ -# general data example library(teal.widgets) +# general data example data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) CO2 <- CO2 }) datanames(data) <- "CO2" @@ -183,13 +196,10 @@ if (interactive()) { shinyApp(app$ui, app$server) } - # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL }) datanames(data) <- c("ADSL") diff --git a/man/tm_g_scatterplotmatrix.Rd b/man/tm_g_scatterplotmatrix.Rd index 071175f9d..65672cb11 100644 --- a/man/tm_g_scatterplotmatrix.Rd +++ b/man/tm_g_scatterplotmatrix.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_g_scatterplotmatrix.R \name{tm_g_scatterplotmatrix} \alias{tm_g_scatterplotmatrix} -\title{Create a scatterplot matrix} +\title{\code{teal} module: Scatterplot matrix} \usage{ tm_g_scatterplotmatrix( label = "Scatterplot Matrix", @@ -18,25 +18,30 @@ tm_g_scatterplotmatrix( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{variables}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Plotting variables from an incoming dataset with filtering and selecting. In case of +Specifies plotting variables from an incoming dataset with filtering and selecting. In case of \code{data_extract_spec} use \code{select_spec(..., ordered = TRUE)} if plot elements should be rendered according to selection order.} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -The available datasets to choose from for each dataset selector is the same and -determined by the argument \code{variables}. +Generates a scatterplot matrix from selected \code{variables} from datasets. +Each plot within the matrix represents the relationship between two variables, +providing the overview of correlations and distributions across selected data. } \note{ For more examples, please see the vignette "Using scatterplot matrix" via diff --git a/man/tm_missing_data.Rd b/man/tm_missing_data.Rd index 9460399f5..878adeb14 100644 --- a/man/tm_missing_data.Rd +++ b/man/tm_missing_data.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_missing_data.R \name{tm_missing_data} \alias{tm_missing_data} -\title{Missing data module} +\title{\code{teal} module: Missing data analysis} \usage{ tm_missing_data( label = "Missing data", @@ -21,18 +21,19 @@ tm_missing_data( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{parent_dataname}{(\code{character(1)}) If this \code{dataname} exists in then "the by subject"graph is displayed. -For \code{CDISC} data. In non \code{CDISC} data this can be ignored. Defaults to \code{"ADSL"}.} +\item{parent_dataname}{(\code{character(1)}) Specifies the parent dataset name. Default is \code{ADSL} for \code{CDISC} data. +If provided and exists, enables additional analysis "by subject". For non-\code{CDISC} data, this parameter can be +ignored.} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"classic"}.} +\item{ggtheme}{(\code{character}) optional, specifies the default \code{ggplot2} theme for plots. Defaults to \code{classic}.} -\item{ggplot2_args}{optional, (\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} +\item{ggplot2_args}{(\code{ggplot2_args}) optional, object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for all the plots or named list of \code{ggplot2_args} objects for plot-specific settings. The argument is merged with options variable \code{teal.ggplot2_args} and default module setup. @@ -40,15 +41,21 @@ List names should match the following: \code{c("default", "Summary Obs", "Summar For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ -Present analysis of missing observations and patients. -specifically designed for use with \code{data.frames}. +This module analyzes missing data in \code{data.frame}s to help users explore missing observations and +gain insights into the completeness of their data. +It is useful for clinical data analysis within the context of \code{CDISC} standards and +adaptable for general data analysis purposes. } \examples{ library(teal.widgets) @@ -66,7 +73,7 @@ tm_missing_data_module <- tm_missing_data( # general example data data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) add_nas <- function(x) { x[sample(seq_along(x), floor(length(x) * runif(1, .05, .17)))] <- NA @@ -94,7 +101,7 @@ if (interactive()) { # CDISC example data data <- teal_data() data <- within(data, { - library(nestcolor) + require(nestcolor) ADSL <- rADSL ADRS <- rADRS }) diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index d6efe45fa..4ca23deeb 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_outliers.R \name{tm_outliers} \alias{tm_outliers} -\title{Outliers Module} +\title{\code{teal} module: Outliers analysis} \usage{ tm_outliers( label = "Outliers Module", @@ -21,14 +21,14 @@ tm_outliers( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{outlier_var}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -variable to consider for the outliers analysis.} +Specifies variable(s) to be analyzed for outliers.} -\item{categorical_var}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -categorical factor to split the selected outlier variables on.} +\item{categorical_var}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) optional, +specifies the categorical variable(s) to split the selected outlier variables on.} -\item{ggtheme}{optional, (\code{character}) \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} +\item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\item{ggplot2_args}{optional, (\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} +\item{ggplot2_args}{(\code{ggplot2_args}) optional, object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for all the plots or named list of \code{ggplot2_args} objects for plot-specific settings. The argument is merged with options variable \code{teal.ggplot2_args} and default module setup. @@ -36,25 +36,31 @@ List names should match the following: \code{c("default", "Boxplot","Density Plo For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} -\item{plot_height}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot height.} +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{plot_width}{optional, (\code{numeric}) A vector of length three with \verb{c(value, min and max)} -for a slider encoding the plot width.} +\item{plot_width}{(\code{numeric}) optional, specifies the plot width as a three-element vector of +\code{value}, \code{min}, and \code{max} for a slider encoding the plot width.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. } \description{ Module to analyze and identify outliers using different methods +such as IQR, Z-score, and Percentiles, and offers visualizations including +box plots, density plots, and cumulative distribution plots to help interpret the outliers. } \examples{ -# general data example library(teal.widgets) +# general data example data <- teal_data() data <- within(data, { CO2 <- CO2 @@ -105,8 +111,6 @@ if (interactive()) { } # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { ADSL <- rADSL diff --git a/man/tm_t_crosstable.Rd b/man/tm_t_crosstable.Rd index 155f6bc90..54b96b06e 100644 --- a/man/tm_t_crosstable.Rd +++ b/man/tm_t_crosstable.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_t_crosstable.R \name{tm_t_crosstable} \alias{tm_t_crosstable} -\title{Create a simple cross-table} +\title{\code{teal} module: Cross-table} \usage{ tm_t_crosstable( label = "Cross Table", @@ -20,24 +20,29 @@ tm_t_crosstable( For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{x}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Object with all available choices with pre-selected option for variable X - row values. In case -of \code{data_extract_spec} use \code{select_spec(..., ordered = TRUE)} if table elements should be +Object with all available choices with pre-selected option for variable X - row values. +In case of \code{data_extract_spec} use \code{select_spec(..., ordered = TRUE)} if table elements should be rendered according to selection order.} \item{y}{(\code{data_extract_spec} or \code{list} of multiple \code{data_extract_spec}) -Object with all available choices with pre-selected option for variable Y - column values +Object with all available choices with pre-selected option for variable Y - column values. + \code{data_extract_spec} must not allow multiple selection in this case.} -\item{show_percentage}{optional, (\code{logical}) Whether to show percentages -(relevant only when \code{x} is a \code{factor}). Defaults to \code{TRUE}.} +\item{show_percentage}{(\code{logical(1)}) +Indicates whether to show percentages (relevant only when \code{x} is a \code{factor}). +Defaults to \code{TRUE}.} -\item{show_total}{optional, (\code{logical}) Whether to show total column. Defaults to \code{TRUE}.} +\item{show_total}{(\code{logical(1)}) +Indicates whether to show total column. +Defaults to \code{TRUE}.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{basic_table_args}{(\code{basic_table_args}) object created by \code{\link[teal.widgets:basic_table_args]{teal.widgets::basic_table_args()}} with settings for the module table. @@ -45,8 +50,12 @@ The argument is merged with options variable \code{teal.basic_table_args} and de For more details see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}} } +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. +} \description{ -Create a simple cross-table +Generates a simple cross-table of two variables from a dataset with custom +options for showing percentages and sub-totals. } \note{ For more examples, please see the vignette "Using cross table" via diff --git a/man/tm_variable_browser.Rd b/man/tm_variable_browser.Rd index 8ed80bb46..00d3548b7 100644 --- a/man/tm_variable_browser.Rd +++ b/man/tm_variable_browser.Rd @@ -2,13 +2,7 @@ % Please edit documentation in R/tm_variable_browser.R \name{tm_variable_browser} \alias{tm_variable_browser} -\alias{tm_variable_browser_ui,} -\alias{tm_variable_browser_srv,} -\alias{tm_variable_browser,} -\alias{variable_browser_ui,} -\alias{variable_browser_srv,} -\alias{variable_browser} -\title{Variable Browser Teal Module} +\title{\code{teal} module: Variable browser} \usage{ tm_variable_browser( label = "Variable Browser", @@ -23,22 +17,23 @@ tm_variable_browser( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{datasets_selected}{(\code{character}) A vector of datasets which should be -shown and in what order. Names in the vector have to correspond with datasets names. +\item{datasets_selected}{(\code{character}) vector of datasets which should be +shown, in order. Names must correspond with datasets names. If vector of length zero (default) then all datasets are shown. -Note: Only datasets of the \code{data.frame} class are compatible; using other types will cause an error.} +Note: Only \code{data.frame} objects are compatible; using other types will cause an error.} -\item{parent_dataname}{(\code{character(1)}) If this \code{dataname} exists in \code{datasets_selected} -then an extra checkbox will be shown to allow users to not show variables in other datasets -which exist in this \code{dataname}. -This is typically used to remove \code{ADSL} columns in \code{CDISC} data. In non \code{CDISC} data this -can be ignored. Defaults to \code{"ADSL"}.} +\item{parent_dataname}{(\code{character(1)}) string specifying a parent dataset. +If it exists in \code{datasets_selected}then an extra checkbox will be shown to +allow users to not show variables in other datasets which exist in this \code{dataname}. +This is typically used to remove \code{ADSL} columns in \code{CDISC} data. +In non \code{CDISC} data this can be ignored. Defaults to \code{"ADSL"}.} -\item{pre_output}{(\code{shiny.tag}, optional)\cr +\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output, +providing context or a title. with text placed before the output to put the output into context. For example a title.} -\item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output -into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} +\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, +adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{ggplot2_args}{(\code{ggplot2_args}) object created by \code{\link[teal.widgets:ggplot2_args]{teal.widgets::ggplot2_args()}} with settings for the module plot. @@ -46,20 +41,22 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} } +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. +} \description{ -The variable browser provides a table with variable names and labels and a -plot that visualizes the content of a particular variable. -specifically designed for use with \code{data.frames}. +Module provides provides a detailed summary and visualization of variable distributions +for \code{data.frame} objects, with interactive features to customize analysis. } \details{ -Numeric columns with fewer than 30 distinct values can be treated as either factors -or numbers with a checkbox allowing users to switch how they are treated (if < 6 unique values -then the default is categorical, otherwise it is numeric). +Numeric columns with fewer than 30 distinct values can be treated as either discrete +or continuous with a checkbox allowing users to switch how they are treated(if < 6 unique values +then the default is discrete, otherwise it is continuous). } \examples{ library(teal.widgets) -# module specification used in apps below +# Module specification used in apps below tm_variable_browser_module <- tm_variable_browser( label = "Variable browser", ggplot2_args = ggplot2_args( diff --git a/man/validate_input.Rd b/man/validate_input.Rd index d1872efcf..e9c21581e 100644 --- a/man/validate_input.Rd +++ b/man/validate_input.Rd @@ -7,14 +7,14 @@ validate_input(input, plot_var, data) } \arguments{ -\item{input}{(\code{session$input}) the shiny session input} +\item{input}{(\code{session$input}) the \code{shiny} session input} \item{plot_var}{(\code{list}) list of a data frame and an array of variable names} -\item{data}{(\code{tdata}) the datasets passed to the module} +\item{data}{(\code{teal_data}) the datasets passed to the module} } \value{ -\code{logical} TRUE if validations pass; a Shiny validation error otherwise +\code{logical} TRUE if validations pass; a \code{shiny} validation error otherwise } \description{ Validates the variable browser inputs diff --git a/man/var_missings_info.Rd b/man/var_missings_info.Rd index c814a510c..d675c99a3 100644 --- a/man/var_missings_info.Rd +++ b/man/var_missings_info.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tm_variable_browser.R \name{var_missings_info} \alias{var_missings_info} -\title{Summarizes missings occurrence} +\title{Summarize NAs.} \usage{ var_missings_info(x) } @@ -10,9 +10,9 @@ var_missings_info(x) \item{x}{vector of any type and length} } \value{ -text describing \code{NA} occurrence. +Character string describing \code{NA} occurrence. } \description{ -Summarizes missings occurrence in vector +Summarizes occurrence of missing values in vector. } \keyword{internal} diff --git a/man/var_summary_table.Rd b/man/var_summary_table.Rd index 99cd3d26d..f13ceef22 100644 --- a/man/var_summary_table.Rd +++ b/man/var_summary_table.Rd @@ -14,7 +14,7 @@ var_summary_table(x, numeric_as_factor, dt_rows, outlier_definition) \item{dt_rows}{\code{numeric} current/latest \code{DT} page length} \item{outlier_definition}{If 0 no outliers are removed, otherwise -outliers (those more than outlier_definition*IQR below/above Q1/Q3 be removed)} +outliers (those more than \verb{outlier_definition*IQR below/above Q1/Q3} be removed)} } \value{ text with simple statistics. diff --git a/man/variable_type_icons.Rd b/man/variable_type_icons.Rd index 1b7150e9d..22591bded 100644 --- a/man/variable_type_icons.Rd +++ b/man/variable_type_icons.Rd @@ -7,20 +7,12 @@ variable_type_icons(var_type) } \arguments{ -\item{var_type}{(\code{character})\cr -of R internal types (classes).} +\item{var_type}{(\code{character}) of R internal types (classes).} } \value{ -(\code{character})\cr -vector of HTML icons corresponding to data type in each column. +(\code{character}) vector of HTML icons corresponding to data type in each column. } \description{ Get icons to represent variable types in dataset } -\examples{ -teal.modules.general:::variable_type_icons(c( - "integer", "numeric", "logical", "Date", "POSIXct", "POSIXlt", - "factor", "character", "unknown", "" -)) -} \keyword{internal} diff --git a/man/varname_w_label.Rd b/man/varname_w_label.Rd index 6e241bf42..92bcc5c97 100644 --- a/man/varname_w_label.Rd +++ b/man/varname_w_label.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/utils.R \name{varname_w_label} \alias{varname_w_label} -\title{Get variable name with label} +\title{Generate a string for a variable including its label} \usage{ varname_w_label( var_names, @@ -17,26 +17,14 @@ varname_w_label( \item{dataset}{(\code{dataset}) Name of analysis dataset.} -\item{wrap_width}{(\code{numeric}) Number of characters to wrap original -label to. Defaults to 80.} +\item{wrap_width}{(\code{numeric}) Number of characters to wrap original label to. Defaults to 80.} -\item{prefix}{(\code{character}) String to paste to the beginning of the -variable name with label.} - -\item{suffix}{(\code{character}) String to paste to the end of the variable -name with label.} +\item{prefix, suffix}{(\code{character}) String to paste to the beginning/end of the variable name with label.} } \value{ (\code{character}) String with variable name and label. } \description{ -Get variable name with label -} -\examples{ -\dontrun{ -ADSL <- teal.modules.general::rADSL - -varname_w_label("AGE", ADSL) -} +Generate a string for a variable including its label } \keyword{internal} diff --git a/teal.modules.general.Rproj b/teal.modules.general.Rproj index ea83efd3c..4713d6572 100644 --- a/teal.modules.general.Rproj +++ b/teal.modules.general.Rproj @@ -18,4 +18,5 @@ StripTrailingWhitespace: Yes BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source +PackageCheckArgs: --as-cran PackageRoxygenize: rd,collate,namespace diff --git a/tests/testthat/helper-functions.R b/tests/testthat/helper-functions.R new file mode 100644 index 000000000..8ae39cb2a --- /dev/null +++ b/tests/testthat/helper-functions.R @@ -0,0 +1,22 @@ +local_logger_threshold <- function(threshold, envir = parent.frame()) { + old <- logger::log_threshold(namespace = "teal.modules.general") + + # Equivalent to withr::defer + thunk <- as.call(list(function() logger::log_threshold(old, namespace = "teal.modules.general"))) + do.call(base::on.exit, list(thunk, TRUE, FALSE), envir = envir) + logger::log_threshold(threshold, namespace = "teal.modules.general") + invisible(old) +} + +# Create a mock data extact spec for tests +mock_data_extract_spec <- function(dataname = "MOCK_DATASET", + select_choices = sample(LETTERS, sample(2:10, 1)), + select_multiple = FALSE) { + teal.transform::data_extract_spec( + dataname = dataname, + select = teal.transform::select_spec( + choices = select_choices, + multiple = select_multiple + ) + ) +} diff --git a/tests/testthat/test-tm_g_bivariate.R b/tests/testthat/test-tm_g_bivariate.R new file mode 100644 index 000000000..1d97a37fc --- /dev/null +++ b/tests/testthat/test-tm_g_bivariate.R @@ -0,0 +1,287 @@ +testthat::test_that("tm_g_bivariate creates a `teal_module` object", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_s3_class( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + row_facet = mock_data_extract_spec(select_multiple = FALSE), + col_facet = mock_data_extract_spec(select_multiple = FALSE), + facet = TRUE, + color_setting = TRUE, + use_density = TRUE, + free_x_scales = TRUE, + free_y_scales = TRUE, + plot_height = c(400, 100, 600), + plot_width = c(600, 100, 600), + rotate_xaxis_labels = TRUE, + swap_axes = TRUE + ), + "teal_module" + ) +}) + +testthat::test_that("tm_g_bivariate creates a `teal_module` object with default options", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_s3_class( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE) + ), + "teal_module" + ) +}) + +testthat::test_that("tm_g_bivariate creates a `teal_module` object with multiple data extract specs", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_s3_class( + tm_g_bivariate( + "a label", + list(mock_data_extract_spec(select_multiple = FALSE), mock_data_extract_spec(select_multiple = FALSE)), + list(mock_data_extract_spec(select_multiple = FALSE), mock_data_extract_spec(select_multiple = FALSE)), + plot_height = c(400, 100, 600), + plot_width = c(600, 100, 600) + ), + "teal_module" + ) +}) + +testthat::test_that("tm_g_bivariate creates a module with datanames taken from data extracts", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + mod <- tm_g_bivariate( + "a label", + list( + mock_data_extract_spec(dataname = "A", select_multiple = FALSE), + mock_data_extract_spec(dataname = "B", select_multiple = FALSE) + ), + mock_data_extract_spec(dataname = "C", select_multiple = FALSE) + ) + + expect_setequal( + mod$datanames, + c("A", "B", "C") + ) +}) + +# Test `x` and `y` arguments with invalid data_extract_spec + +testthat::test_that("tm_g_bivariate fails when `x` contains a spec with multiple selection", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + list( + mock_data_extract_spec(select_multiple = TRUE) + ), + list() + ), + "'x' should not allow multiple selection" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `x` contains multiple spec with (at least one ) multiple selection", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + list( + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = TRUE) + ), + list(mock_data_extract_spec(select_multiple = FALSE)) + ), + "'x' should not allow multiple selection" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `x` contains multiple spec with (at least one ) multiple selection", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + list( + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = TRUE) + ) + ), + "'y' should not allow multiple selection" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `y` contains multiple spec with (at least one ) multiple selection", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + list( + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = TRUE) + ) + ), + "'y' should not allow multiple selection" + ) +}) + +# Test `plot_height` and `plot_width` arguments + +testthat::test_that("tm_g_bivariate fails when `plot_height` is not valid", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + plot_height = c(100, 10, 20) + ), + "Assertion on 'plot_height' failed: Element 1 is not <= 20" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `plot_height` is not valid", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + plot_height = c(1, 10, 20) + ), + "Assertion on 'plot_height' failed: Element 1 is not >= 10" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `plot_height` is not valid", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + plot_height = 100 + ), + "Assertion on 'plot_height' failed: Must have length 3, but has length 1" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `plot_width` is not valid", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + plot_width = c(100, 10, 20) + ), + "Assertion on 'plot_width' failed: Element 1 is not <= 20" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `plot_width` is not valid", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + plot_width = c(1, 10, 20) + ), + "Assertion on 'plot_width' failed: Element 1 is not >= 10" + ) +}) + +testthat::test_that("tm_g_bivariate fails when `plot_width` is not valid", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + plot_width = 100 + ), + "Assertion on 'plot_width' failed: Must have length 3, but has length 1" + ) +}) + +# Test `color_settings` argument + +testthat::test_that("tm_g_bivariate fails when `color_setting` is FALSE and `color` is supplied", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + color_setting = FALSE, + color = mock_data_extract_spec() + ), + "'color_settings' argument needs to be set to TRUE if 'color', 'fill', and/or 'size' is/are supplied." + ) +}) + +testthat::test_that("tm_g_bivariate fails when `color_setting` is FALSE and `size` is supplied", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + color_setting = FALSE, + size = mock_data_extract_spec() + ), + "'color_settings' argument needs to be set to TRUE if 'color', 'fill', and/or 'size' is/are supplied." + ) +}) + +testthat::test_that("tm_g_bivariate fails when `color_setting` is FALSE and `fill` is supplied", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + testthat::expect_error( + tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + color_setting = FALSE, + fill = mock_data_extract_spec() + ), + "'color_settings' argument needs to be set to TRUE if 'color', 'fill', and/or 'size' is/are supplied." + ) +}) + +testthat::test_that("tm_g_bivariate determines `color`, `size` and `fill` when `color_setting` is TRUE", { + local_logger_threshold(logger::FATAL) # Suppress logger messages + + mod <- tm_g_bivariate( + "a label", + mock_data_extract_spec(select_multiple = FALSE), + mock_data_extract_spec(select_multiple = FALSE), + color_setting = TRUE + ) + + testthat::expect_contains( + vapply( + unlist(mod$ui_args[c("color", "size", "fill")], recursive = FALSE), + class, + character(1) + ), + "data_extract_spec" + ) +}) diff --git a/vignettes/images/app-teal-modules-general.png b/vignettes/images/app-teal-modules-general.png new file mode 100644 index 000000000..e48bcc989 Binary files /dev/null and b/vignettes/images/app-teal-modules-general.png differ diff --git a/vignettes/images/app-using-association-plot.png b/vignettes/images/app-using-association-plot.png new file mode 100644 index 000000000..682c1d659 Binary files /dev/null and b/vignettes/images/app-using-association-plot.png differ diff --git a/vignettes/images/app-using-bivariate-plot.png b/vignettes/images/app-using-bivariate-plot.png new file mode 100644 index 000000000..4b66e480c Binary files /dev/null and b/vignettes/images/app-using-bivariate-plot.png differ diff --git a/vignettes/images/app-using-cross-table.png b/vignettes/images/app-using-cross-table.png new file mode 100644 index 000000000..3dcc0f976 Binary files /dev/null and b/vignettes/images/app-using-cross-table.png differ diff --git a/vignettes/images/app-using-data-table.png b/vignettes/images/app-using-data-table.png new file mode 100644 index 000000000..9baec5584 Binary files /dev/null and b/vignettes/images/app-using-data-table.png differ diff --git a/vignettes/images/app-using-outliers-module.png b/vignettes/images/app-using-outliers-module.png new file mode 100644 index 000000000..998b9f0f3 Binary files /dev/null and b/vignettes/images/app-using-outliers-module.png differ diff --git a/vignettes/images/app-using-regression-plots.png b/vignettes/images/app-using-regression-plots.png new file mode 100644 index 000000000..e66bd0546 Binary files /dev/null and b/vignettes/images/app-using-regression-plots.png differ diff --git a/vignettes/images/app-using-response-plot.png b/vignettes/images/app-using-response-plot.png new file mode 100644 index 000000000..d53fe5740 Binary files /dev/null and b/vignettes/images/app-using-response-plot.png differ diff --git a/vignettes/images/app-using-scatterplot-matrix.png b/vignettes/images/app-using-scatterplot-matrix.png new file mode 100644 index 000000000..703677109 Binary files /dev/null and b/vignettes/images/app-using-scatterplot-matrix.png differ diff --git a/vignettes/images/app-using-scatterplot.png b/vignettes/images/app-using-scatterplot.png new file mode 100644 index 000000000..b2e4d92b3 Binary files /dev/null and b/vignettes/images/app-using-scatterplot.png differ diff --git a/vignettes/teal-modules-general.Rmd b/vignettes/teal-modules-general.Rmd index 588639320..3d8c9a007 100644 --- a/vignettes/teal-modules-general.Rmd +++ b/vignettes/teal-modules-general.Rmd @@ -1,7 +1,6 @@ --- title: "Getting started with teal.modules.general" -author: "NEST CoreDev Team" -date: "01.04.2022" +author: "NEST CoreDev" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Getting started with teal.modules.general} @@ -11,39 +10,41 @@ vignette: > ### Introduction -`teal` is a package that extends the `shiny` framework to build interactive GUI applications using the R programming -language. `shiny`, and hence `teal`, are implemented to allow the building of large applications by combining small, -decoupled modules. `teal.modules.general` is a package consisting of a set of modules that are used to build `teal` -applications. It is "general" in the sense that the intended functions of these modules are more fundamental. This is -in contrast to the intended functions of its sister package, `teal.modules.clinical`, which is more specialized around -clinical data. The modules of `teal.modules.general` can be combined with modules of `teal.modules.clinical` and / or +`teal` extends the `shiny` framework, enabling the creation of interactive GUI applications using the `R`. +`shiny`, and `teal`facilitate the development of extensive applications through combining small, decoupled modules. +The `teal.modules.general` package consist of collection of modules essential for developing `teal` applications. +It is "general" in the sense that the intended functions of these modules are more fundamental. This contrasts with the more specialized focus on clinical data found in the `teal.modules.clinical` package. +The modules from `teal.modules.general` can be used in conjunction with modules from `teal.modules.clinical` and / or other `shiny` modules to build a large `teal` / `shiny` app. + The concepts presented here require knowledge about the core features of `teal`, specifically on how to launch a `teal` application and how to pass data into it. Therefore, it is highly recommended to refer to the [`README`](https://insightsengineering.github.io/teal/index.html) file and -the introductory [vignette](https://insightsengineering.github.io/teal/articles/teal.html) of the `teal` package. +the introductory [vignette](https://insightsengineering.github.io/teal/latest-tag/articles/getting-started-with-teal.html) of the `teal` package. -See also `teal.modules.clinical's` [`README`](https://insightsengineering.github.io/teal.modules.clinical/index.html). +See also `teal.modules.clinical`'s [`README`](https://insightsengineering.github.io/teal.modules.clinical/latest-tag/index.html). ### Main features There are five areas of data science that `teal.modules.general` provides tools and solutions (modules) for: -- viewing data in tabular form +- viewing data in tabular formats - visualizing data in plots and graphs - viewing data and files in a directory - examining missing and extreme values in data - performing data analysis -See [package functions / modules](https://insightsengineering.github.io/teal.modules.general/reference/index.html). +See [package functions / modules](https://insightsengineering.github.io/teal.modules.general/latest-tag/reference/index.html). ### Example application -A simple application including a `tm_variable_browser` module could look like this: +A simple application featuring the `tm_variable_browser()` module: ```{r, message = FALSE, results = "hide"} +# load libraries library(teal.modules.general) +library(teal.widgets) -# nolint start +# teal_data object data <- teal_data() data <- within(data, { ADSL <- teal.modules.general::rADSL @@ -52,40 +53,42 @@ data <- within(data, { datanames <- c("ADSL", "ADTTE") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] -# nolint end -app <- teal::init( - data = data, - modules = teal::modules( - tm_variable_browser( - label = "Variable browser", - ggplot2_args = teal.widgets::ggplot2_args( - labs = list(subtitle = "Plot generated by Variable Browser Module") - ), - ) +# tm_variable_browser module +tm_variable_browser_module <- tm_variable_browser( + label = "Variable browser", + ggplot2_args = ggplot2_args( + labs = list(subtitle = "Plot generated by Variable Browser Module") ) ) + +# initialize the app +app <- init( + data = data, + modules = modules(tm_variable_browser_module) +) ``` ```{r, eval = FALSE} shinyApp(app$ui, app$server) ``` + + Let's break the above app into pieces: + +1: Load the necessary libraries and data. ```r library(teal.modules.general) +library(teal.widgets) ``` -The line mentioned above imports the library required for this example and loads data from within that library. +2: Construct a `teal_data` object containing that will serve as the source of data for the `teal` app. `teal_data` not only encapsulates the data for the app, but it also houses the code required to create the data to maintain reproducibility. -Now, we are building a `teal_data` object that will serve as the source of data for the teal app. -`teal_data` not only encapsulates the data for the app, but it also houses the code required to create the data to maintain reproducibility. -To do this, we create an empty `teal_data` object and evaluate code to produce the data within the `teal_data` object, -so both the code and data are stored together. +To do this, we create an empty `teal_data` object and evaluate code to produce the data within the `teal_data` object, so both the code and data are stored together. Following this, we set the `datanames` and `join_keys`. ```r -# nolint start data <- teal_data() data <- within(data, { ADSL <- teal.modules.general::rADSL @@ -94,49 +97,40 @@ data <- within(data, { datanames <- c("ADSL", "ADTTE") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] -# nolint end ``` -There is no need to load `teal` as `teal.modules.general` already depends on it. +3: Initialize a `teal` application with specified data and modules, in this case, the module: `tm_variable_browser`, datasets:`ADSL` and `ADTTE`. -In the next step, we use `teal` to create `shiny` `ui` and `server` functions so we can launch using `shiny`. The `data` -argument tells `teal` about the input data - the two datasets `ADSL` and `ADTTE` - and the `modules` -argument indicates the modules included in the application. Here, we include only one - `tm_variable_browser`. +`shiny::shinyApp()` use the `ui` and `server` component to initialize the `teal` app. -```{r, results = "hide"} -app <- teal::init( - data = data, - modules = teal::modules( - tm_variable_browser( - # module name to display in the GUI - label = "Variable browser", - # this argument takes a set of arguments to pass to ggplot2. - # the arguments must have the same names as its ggplot2 counterpart, e.g. `subtitle` - ggplot2_args = teal.widgets::ggplot2_args( - labs = list(subtitle = "Plot generated by Variable Browser Module") - ), - ) + +```r +tm_variable_browser_module <- tm_variable_browser( + # module name to display in the GUI + label = "Variable browser", + # this argument takes a set of arguments to pass to ggplot2. + # the arguments must have the same names as its ggplot2 counterpart, e.g. `subtitle` + ggplot2_args = ggplot2_args( + labs = list(subtitle = "Plot generated by Variable Browser Module") ) ) -``` -The `shiny` function `shinyApp` used the `ui` and `server` objects to initialize the `teal` app. +app <- init( + data = data, + modules = modules(tm_variable_browser_module) +) -```{r, eval = FALSE} -shiny::shinyApp(app$ui, app$server) +shinyApp(app$ui, app$server) ``` In a `teal` app, data and modules are decoupled. In the app above: - The app developer specified the data and assigned it to the `data` argument. - The app developer specified the module and assigned it to the `modules` argument. -- The `init` function took these arguments and returned a list, which can be demonstrated by running: +- The `init` function took these arguments and returned a list containing `ui` and `server` object, which can be demonstrated by running: ```{r, indent = " "} class(app) -``` -This list contains two R objects named `ui` and `server`. -```{r, indent = " "} names(app) ``` diff --git a/vignettes/using-association-plot.Rmd b/vignettes/using-association-plot.Rmd index 8921c79d1..c1f439e69 100644 --- a/vignettes/using-association-plot.Rmd +++ b/vignettes/using-association-plot.Rmd @@ -1,7 +1,6 @@ --- title: "Using association plot" -author: "Dawid Kałędkowski" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -10,62 +9,35 @@ vignette: > %\VignetteEncoding{UTF-8} --- -# Teal application to use association plot with various datasets types +# `teal` application to use association plot with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside an association plot module: +This vignette will guide you through the four parts to create a `teal` application using various types of datasets using the association plot module `tm_g_association()`: -1. Load Libraries -2. Create data sets -3. Create an `app` variable -4. Run the App +1. Load libraries +2. Create data sets +3. Create an `app` variable +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets -Inside this app 5 datasets will be used +Inside this app 4 datasets will be used -1. `ADSL` A wide data set with subject data -2. `ADSL2` A wide data set with subject data -3. `ADRS` A long data set with response data for subjects at different time points of the study -4. `ADTTE` A long data set with time to event data -5. `ADLB` A long data set with lab measurements for each subject +1. `ADSL` A wide data set with subject data +2. `ADRS` A long data set with response data for subjects at different time points of the study +3. `ADTTE` A long data set with time to event data +4. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start -ADSL <- teal.modules.general::rADSL -ADSL2 <- teal.modules.general::rADSL %>% - mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) -ADRS <- teal.modules.general::rADRS -ADTTE <- teal.modules.general::rADTTE -ADLB <- teal.modules.general::rADLB %>% - mutate(CHGC = as.factor(case_when( - CHG < 1 ~ "N", - CHG > 1 ~ "P", - TRUE ~ "-" - ))) -# nolint end -``` - -## Create an `app` variable - -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_g_association` using different -combinations of data sets. - -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADSL2 <- ADSL %>% + ADSL <- teal.modules.general::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) ADRS <- teal.modules.general::rADRS ADTTE <- teal.modules.general::rADTTE @@ -76,238 +48,257 @@ data <- within(data, { TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADSL2", "ADRS", "ADTTE", "ADLB") +datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") datanames(data) <- datanames -jk <- default_cdisc_join_keys[datanames] -jk_adsl2 <- jk -names(jk_adsl2)[names(jk_adsl2) == "ADSL"] <- "ADSL2" -jk <- c(jk, jk_adsl2) -jk["ADSL2", "ADSL"] <- c("USUBJID", "STUDYID") +join_keys(data) <- default_cdisc_join_keys[datanames] +``` -# nolint end +## 3 - Create an `app` variable -app <- teal::init( - data = data, - modules = teal::modules( - # tm_g_association ---- - modules( - label = "Association plot", - tm_g_association( - label = "Single wide dataset", - ref = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]]), - selected = "AGE", - fixed = FALSE - ) - ), - vars = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]]), - selected = "BMRKR1", - multiple = TRUE, - fixed = FALSE - ) - ) - ), - tm_g_association( - label = "Two wide datasets", - ref = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "STRATA1", "RACE")), - selected = "STRATA1", - multiple = FALSE, - fixed = FALSE - ) - ), - vars = teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL2"]], c("AGE", "SEX", "RACE", "COUNTRY")), - selected = c("AGE", "COUNTRY", "RACE"), - multiple = TRUE, - fixed = FALSE - ) - ) +This is the most important section. We will use the `teal::init()` function to create an app. The data will be handed over using `teal.data::teal_data()`. The app itself will be constructed by multiple calls of `tm_g_association()` using different combinations of data sets. + +```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +# configuration for a single wide dataset +mod1 <- tm_g_association( + label = "Single wide dataset", + ref = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]]), + selected = "AGE", + fixed = FALSE + ) + ), + vars = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]]), + selected = "BMRKR1", + multiple = TRUE, + fixed = FALSE + ) + ) +) + +# configuration for two wide datasets +mod2 <- tm_g_association( + label = "Two wide datasets", + ref = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "STRATA1", "RACE")), + selected = "STRATA1", + multiple = FALSE, + fixed = FALSE + ) + ), + vars = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE", "COUNTRY")), + selected = c("AGE", "COUNTRY", "RACE"), + multiple = TRUE, + fixed = FALSE + ) + ) +) + +# configuration for multiple long datasets +mod3 <- tm_g_association( + label = "Multiple different long datasets", + ref = data_extract_spec( + dataname = "ADTTE", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADTTE"]]), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ), + filter = filter_spec( + label = "Select endpoint:", + vars = "PARAMCD", + choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + selected = c("PFS", "EFS"), + multiple = TRUE + ) + ), + vars = data_extract_spec( + dataname = "ADRS", + reshape = TRUE, + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADRS"]], c("AVALC", "BMRKR1", "BMRKR2", "ARM")), + selected = "AVALC", + multiple = TRUE, + fixed = FALSE + ), + filter = list( + filter_spec( + label = "Select endpoints:", + vars = "PARAMCD", + choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), + selected = "BESRSPI", + multiple = TRUE ), - tm_g_association( - label = "Multiple different long datasets", - ref = teal.transform::data_extract_spec( - dataname = "ADTTE", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADTTE"]]), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE - ), - filter = teal.transform::filter_spec( - label = "Select endpoint:", - vars = "PARAMCD", - choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), - selected = c("PFS", "EFS"), - multiple = TRUE - ) - ), - vars = teal.transform::data_extract_spec( - dataname = "ADRS", - reshape = TRUE, - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADRS"]], c("AVALC", "BMRKR1", "BMRKR2", "ARM")), - selected = "AVALC", - multiple = TRUE, - fixed = FALSE - ), - filter = list( - filter_spec( - label = "Select endpoints:", - vars = "PARAMCD", - choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), - selected = "BESRSPI", - multiple = TRUE - ), - filter_spec( - label = "Select endpoints:", - vars = "AVISIT", - choices = levels(data[["ADRS"]]$AVISIT), - selected = "SCREENING", - multiple = TRUE - ) - ) - ) + filter_spec( + label = "Select endpoints:", + vars = "AVISIT", + choices = levels(data[["ADRS"]]$AVISIT), + selected = "SCREENING", + multiple = TRUE + ) + ) + ) +) + +# configuration for wide and long datasets +mod4 <- tm_g_association( + label = "Wide and long datasets", + ref = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVAL", "AVALC")), + selected = "AVALC", + multiple = FALSE, + fixed = FALSE, + label = "Selected variable:" + ), + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADRS"]]$PARAMCD), + multiple = TRUE, + label = "Select response" ), - tm_g_association( - label = "Wide and long datasets", - ref = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVAL", "AVALC")), - selected = "AVALC", - multiple = FALSE, - fixed = FALSE, - label = "Selected variable:" - ), - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADRS"]]$PARAMCD), - multiple = TRUE, - label = "Select response" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADRS"]]$AVISIT), - selected = levels(data[["ADRS"]]$AVISIT), - multiple = TRUE, - label = "Select visit:" - ) - ) - ), - vars = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "RACE", "COUNTRY", "BMRKR1", "STRATA1", "ARM")), - selected = "AGE", - multiple = TRUE, - fixed = FALSE, - label = "Select variable:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADRS"]]$AVISIT), + selected = levels(data[["ADRS"]]$AVISIT), + multiple = TRUE, + label = "Select visit:" + ) + ) + ), + vars = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "RACE", "COUNTRY", "BMRKR1", "STRATA1", "ARM")), + selected = "AGE", + multiple = TRUE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# configuration for the same long dataset (same subsets) +mod5 <- tm_g_association( + label = "Same long datasets (same subsets)", + ref = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]]), + selected = "AVALC", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + vars = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]]), + selected = "PARAMCD", + multiple = TRUE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# configuration for the same long dataset (different subsets) +mod6 <- tm_g_association( + label = "Same long datasets (different subsets)", + ref = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_association( - label = "Same long datasets (same subsets)", - ref = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]]), - selected = "AVALC", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - vars = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]]), - selected = "PARAMCD", - multiple = TRUE, - fixed = FALSE, - label = "Select variable:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("AVAL", "CHG2", "PCHG2")), + selected = "AVAL", + multiple = FALSE + ) + ), + vars = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select labs:" ), - tm_g_association( - label = "Same long datasets (different subsets)", - ref = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("AVAL", "CHG2", "PCHG2")), - selected = "AVAL", - multiple = FALSE - ) - ), - vars = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select labs:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]]), - selected = "STRATA1", - multiple = TRUE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]]), + selected = "STRATA1", + multiple = TRUE + ) + ) +) + +# initialize the app +app <- init( + data = data, + modules = modules( + # tm_g_association ---- + modules( + label = "Association plot", + mod1, + mod2, + mod3, + mod4, + mod5, + mod6 ) ) ) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + diff --git a/vignettes/using-bivariate-plot.Rmd b/vignettes/using-bivariate-plot.Rmd index ed09e6c78..3c94cd857 100644 --- a/vignettes/using-bivariate-plot.Rmd +++ b/vignettes/using-bivariate-plot.Rmd @@ -1,7 +1,6 @@ --- title: "Using bivariate plot" -author: "Dawid Kałędkowski" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -10,19 +9,17 @@ vignette: > %\VignetteEncoding{UTF-8} --- -# Teal application to use bivariate plot with various datasets types +# `teal` application to use bivariate plot with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside an bivariate plot module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the bivariate plot module `tm_g_bivariate()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app - - -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app @@ -30,22 +27,19 @@ library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets -Inside this app 5 datasets will be used +Inside this app 4 datasets will be used 1. `ADSL` A wide data set with subject data -2. `ADSL2` A wide data set with subject data -3. `ADRS` A long data set with response data for subjects at different time points of the study -4. `ADTTE` A long data set with time to event data -5. `ADLB` A long data set with lab measurements for each subject +2. `ADRS` A long data set with response data for subjects at different time points of the study +3. `ADTTE` A long data set with time to event data +4. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADSL2 <- teal.modules.general::rADSL %>% + ADSL <- teal.modules.general::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) ADRS <- teal.modules.general::rADRS ADTTE <- teal.modules.general::rADTTE @@ -56,562 +50,581 @@ data <- within(data, { TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADSL2", "ADRS", "ADTTE", "ADLB") +datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") datanames(data) <- datanames -jk <- default_cdisc_join_keys[datanames] -jk_adsl2 <- jk -names(jk_adsl2)[names(jk_adsl2) == "ADSL"] <- "ADSL2" -jk <- c(jk, jk_adsl2) -jk["ADSL2", "ADSL"] <- c("USUBJID", "STUDYID") -# nolint end +join_keys(data) <- default_cdisc_join_keys[datanames] ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_g_bivariate` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. The app +itself will be constructed by multiple calls of `tm_g_bivariate()` using different combinations of data sets. ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( - data = data, - modules = teal::modules( - # tm_g_bivariate ------ - modules( - label = "Bivariate plot", - tm_g_bivariate( - label = "Single wide dataset", - x = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]]), - selected = "BMRKR1", - fixed = FALSE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]]), - selected = "SEX", - multiple = FALSE, - fixed = FALSE - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]]), - selected = NULL, - multiple = FALSE, - fixed = FALSE - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]]), - selected = NULL, - multiple = FALSE, - fixed = FALSE - ) - ) +# configuration for the single wide dataset +mod1 <- tm_g_bivariate( + label = "Single wide dataset", + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]]), + selected = "BMRKR1", + fixed = FALSE + ) + ), + y = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]]), + selected = "SEX", + multiple = FALSE, + fixed = FALSE + ) + ), + row_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]]), + selected = NULL, + multiple = FALSE, + fixed = FALSE + ) + ), + col_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]]), + selected = NULL, + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the two wide datasets +mod2 <- tm_g_bivariate( + label = "Two wide datasets", + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("BMRKR1", "AGE", "SEX", "STRATA1", "RACE")), + selected = c("BMRKR1"), + multiple = FALSE + ) + ), + y = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]], c("COUNTRY", "AGE", "RACE")), + selected = "RACE", + multiple = FALSE + ) + ), + row_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]]), + selected = NULL, + multiple = FALSE, + fixed = FALSE + ) + ), + col_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]]), + selected = NULL, + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the multiple different long datasets +mod3 <- tm_g_bivariate( + label = "Multiple different long datasets", + x = data_extract_spec( + dataname = "ADRS", + filter = filter_spec( + label = "Select endpoints:", + vars = c("PARAMCD", "AVISIT"), + choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), + selected = "OVRINV - END OF INDUCTION", + multiple = TRUE + ), + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), + selected = "AVALC", + multiple = FALSE + ) + ), + y = data_extract_spec( + dataname = "ADTTE", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADTTE"]], c("AVAL", "CNSR")), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ), + filter = filter_spec( + label = "Select endpoint:", + vars = c("PARAMCD"), + choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + selected = "OS", + multiple = FALSE + ) + ), + row_facet = data_extract_spec( + dataname = "ADRS", + filter = filter_spec( + label = "Select endpoints:", + vars = c("PARAMCD", "AVISIT"), + choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), + selected = "OVRINV - SCREENING", + multiple = TRUE + ), + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "COUNTRY", "ARM", "PARAMCD", "AVISIT")), + selected = "SEX", + multiple = FALSE, + fixed = FALSE + ) + ), + col_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")), + selected = NULL, + multiple = FALSE, + fixed = FALSE + ) + ), + color_settings = TRUE, + color = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + fill = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + size = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + plot_height = c(600, 200, 2000), + ggtheme = "gray" +) + +# configuration for the wide and long datasets +mod4 <- tm_g_bivariate( + label = "Wide and long datasets", + x = data_extract_spec( + dataname = "ADRS", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADRS"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select response:" ), - tm_g_bivariate( - label = "Two wide datasets", - x = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("BMRKR1", "AGE", "SEX", "STRATA1", "RACE")), - selected = c("BMRKR1"), - multiple = FALSE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL2"]], c("COUNTRY", "AGE", "RACE")), - selected = "RACE", - multiple = FALSE - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]]), - selected = NULL, - multiple = FALSE, - fixed = FALSE - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL2"]]), - selected = NULL, - multiple = FALSE, - fixed = FALSE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADRS"]]$AVISIT), + selected = levels(data[["ADRS"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), + selected = "AVALC", + multiple = FALSE, + label = "Select variable:" + ) + ), + y = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("BMRKR1", "SEX", "AGE", "RACE", "COUNTRY")), + selected = "BMRKR1", + multiple = FALSE, + label = "Select variable:", + fixed = FALSE + ) + ), + row_facet = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "ARMCD", "PARAMCD")), + selected = "SEX", + multiple = FALSE, + label = "Select variable:" + ) + ), + col_facet = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "ARMCD", "PARAMCD", "AVISIT")), + selected = "ARMCD", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# configuration for the wide and multiple long datasets +mod5 <- tm_g_bivariate( + label = "Wide and multiple long datasets", + x = data_extract_spec( + dataname = "ADRS", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADRS"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select response:" ), - tm_g_bivariate( - label = "Multiple different long datasets", - x = teal.transform::data_extract_spec( - dataname = "ADRS", - filter = teal.transform::filter_spec( - label = "Select endpoints:", - vars = c("PARAMCD", "AVISIT"), - choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), - selected = "OVRINV - END OF INDUCTION", - multiple = TRUE - ), - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), - selected = "AVALC", - multiple = FALSE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADTTE", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADTTE"]], c("AVAL", "CNSR")), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE - ), - filter = teal.transform::filter_spec( - label = "Select endpoint:", - vars = c("PARAMCD"), - choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), - selected = "OS", - multiple = FALSE - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADRS", - filter = teal.transform::filter_spec( - label = "Select endpoints:", - vars = c("PARAMCD", "AVISIT"), - choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), - selected = "OVRINV - SCREENING", - multiple = TRUE - ), - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "COUNTRY", "ARM", "PARAMCD", "AVISIT")), - selected = "SEX", - multiple = FALSE, - fixed = FALSE - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")), - selected = NULL, - multiple = FALSE, - fixed = FALSE - ) - ), - color_settings = TRUE, - color = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - fill = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - size = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - plot_height = c(600, 200, 2000), - ggtheme = "gray" + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADRS"]]$AVISIT), + selected = levels(data[["ADRS"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), + selected = "AVALC", + multiple = FALSE, + label = "Select variable:" + ) + ), + y = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("BMRKR1", "SEX", "AGE", "RACE", "COUNTRY")), + selected = "BMRKR1", + multiple = FALSE, + fixed = FALSE + ) + ), + row_facet = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select measurement:" + ), + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = "ARMCD", + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + col_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + color_settings = TRUE, + color = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + fill = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + size = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + plot_height = c(600, 200, 2000), + ggtheme = "gray" +) + +# Configuration for the same long datasets (same subset) +mod6 <- tm_g_bivariate( + label = "Same long datasets (same subset)", + x = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), + selected = "AVALC", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + y = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "COUNTRY", "ARMCD", "BMRKR1", "BMRKR2")), + selected = "BMRKR1", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + row_facet = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVISIT", "PARAMCD")), + selected = "PARAMCD", + multiple = FALSE, + label = "Select variables:" + ) + ), + col_facet = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVISIT", "PARAMCD")), + selected = "AVISIT", + multiple = FALSE, + label = "Select variables:" + ) + ) +) + +# Configuration for the same datasets (different subsets) +mod7 <- tm_g_bivariate( + label = "Same datasets (different subsets)", + x = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_bivariate( - label = "Wide and long datasets", - x = teal.transform::data_extract_spec( - dataname = "ADRS", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADRS"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select response:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADRS"]]$AVISIT), - selected = levels(data[["ADRS"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), - selected = "AVALC", - multiple = FALSE, - label = "Select variable:" - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("BMRKR1", "SEX", "AGE", "RACE", "COUNTRY")), - selected = "BMRKR1", - multiple = FALSE, - label = "Select variable:", - fixed = FALSE - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "ARMCD", "PARAMCD")), - selected = "SEX", - multiple = FALSE, - label = "Select variable:" - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "ARMCD", "PARAMCD", "AVISIT")), - selected = "ARMCD", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = "AVAL", + selected = "AVAL", + multiple = FALSE, + fixed = TRUE + ) + ), + y = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_bivariate( - label = "Wide and multiple long datasets", - x = teal.transform::data_extract_spec( - dataname = "ADRS", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADRS"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADRS"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select response:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADRS"]]$AVISIT), - selected = levels(data[["ADRS"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), - selected = "AVALC", - multiple = FALSE, - label = "Select variable:" - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("BMRKR1", "SEX", "AGE", "RACE", "COUNTRY")), - selected = "BMRKR1", - multiple = FALSE, - fixed = FALSE - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select measurement:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = "ARMCD", - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - color_settings = TRUE, - color = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - fill = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - size = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - plot_height = c(600, 200, 2000), - ggtheme = "gray" + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = "AVAL", + selected = "AVAL", + multiple = FALSE, + fixed = TRUE + ) + ), + use_density = FALSE, + row_facet = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_bivariate( - label = "Same long datasets (same subset)", - x = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVALC", "AVAL")), - selected = "AVALC", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("SEX", "RACE", "COUNTRY", "ARMCD", "BMRKR1", "BMRKR2")), - selected = "BMRKR1", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVISIT", "PARAMCD")), - selected = "PARAMCD", - multiple = FALSE, - label = "Select variables:" - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVISIT", "PARAMCD")), - selected = "AVISIT", - multiple = FALSE, - label = "Select variables:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select category:" + ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("RACE", "SEX", "ARMCD", "ACTARMCD")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + col_facet = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_bivariate( - label = "Same datasets (different subsets)", - x = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = "AVAL", - selected = "AVAL", - multiple = FALSE, - fixed = TRUE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = "AVAL", - selected = "AVAL", - multiple = FALSE, - fixed = TRUE - ) - ), - use_density = FALSE, - row_facet = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select category:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("RACE", "SEX", "ARMCD", "ACTARMCD")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select category:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("RACE", "SEX", "ARMCD", "ACTARMCD")), - selected = "ARMCD", - multiple = FALSE, - fixed = FALSE, - label = "Select variables:" - ) - ), - color_settings = TRUE, - color = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - fill = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - size = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - plot_height = c(600, 200, 2000), - ggtheme = "gray" + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select category:" ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("RACE", "SEX", "ARMCD", "ACTARMCD")), + selected = "ARMCD", + multiple = FALSE, + fixed = FALSE, + label = "Select variables:" + ) + ), + color_settings = TRUE, + color = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + fill = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + size = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + plot_height = c(600, 200, 2000), + ggtheme = "gray" +) + +# initialize the app +app <- init( + data = data, + modules = modules( + # tm_g_bivariate ------ + modules( + label = "Bivariate plot", + mod1, + mod2, + mod3, + mod4, + mod5, + mod6, + mod7 ) ) ) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + + diff --git a/vignettes/using-cross-table.Rmd b/vignettes/using-cross-table.Rmd index 2ab93bd9a..ab21b88c0 100644 --- a/vignettes/using-cross-table.Rmd +++ b/vignettes/using-cross-table.Rmd @@ -1,7 +1,6 @@ --- title: "Using cross table" -author: "Dawid Kałędkowski" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -10,24 +9,24 @@ vignette: > %\VignetteEncoding{UTF-8} --- -# Teal application to use cross table with various datasets types +# `teal` application to use cross table with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside an cross table module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the cross table module `tm_t_crosstable()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets Inside this app 2 datasets will be used @@ -35,7 +34,6 @@ Inside this app 2 datasets will be used 2. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide", echo=2:6} -# nolint start data <- teal_data() data <- within(data, { ADSL <- teal.modules.general::rADSL @@ -49,92 +47,100 @@ data <- within(data, { datanames <- c("ADSL", "ADLB") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] -# nolint end ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_t_crosstable` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. The app +itself will be constructed by multiple calls of `tm_t_crosstable()` using different combinations of data sets. ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( +# configuration for the single wide dataset +mod1 <- tm_t_crosstable( + label = "Single wide dataset", + x = data_extract_spec( + "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]]), + selected = names(data[["ADSL"]])[5], + multiple = TRUE, + fixed = FALSE, + ordered = TRUE + ) + ), + y = data_extract_spec( + "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]]), + selected = names(data[["ADSL"]])[6], + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the same long datasets (different subsets) +mod2 <- tm_t_crosstable( + label = "Same long datasets (different subsets)", + x = data_extract_spec( + dataname = "ADLB", + filter = filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]]), + selected = "AVISIT", + multiple = TRUE, + fixed = FALSE, + ordered = TRUE, + label = "Select variable:" + ) + ), + y = data_extract_spec( + dataname = "ADLB", + filter = filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]]), + selected = "LOQFL", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# initialize the app +app <- init( data = data, - modules = teal::modules( + modules = modules( modules( label = "Cross table", - tm_t_crosstable( - label = "Single wide dataset", - x = teal.transform::data_extract_spec( - "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]]), - selected = names(data[["ADSL"]])[5], - multiple = TRUE, - fixed = FALSE, - ordered = TRUE - ) - ), - y = teal.transform::data_extract_spec( - "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]]), - selected = names(data[["ADSL"]])[6], - multiple = FALSE, - fixed = FALSE - ) - ) - ), - tm_t_crosstable( - label = "Same long datasets (different subsets)", - x = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = teal.transform::filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]]), - selected = "AVISIT", - multiple = TRUE, - fixed = FALSE, - ordered = TRUE, - label = "Select variable:" - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = teal.transform::filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]]), - selected = "LOQFL", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ) - ) + mod1, + mod2 ) ) ) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + + diff --git a/vignettes/using-data-table.Rmd b/vignettes/using-data-table.Rmd index 77b8d4eb7..3d0cc2516 100644 --- a/vignettes/using-data-table.Rmd +++ b/vignettes/using-data-table.Rmd @@ -1,7 +1,6 @@ --- title: "Using data table" -author: "coreDev team" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -10,23 +9,23 @@ vignette: > %\VignetteEncoding{UTF-8} --- -# Teal application to use association plot with various datasets types +# `teal` application to display data table with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside a data table module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the data table module `tm_data_table()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app ``` -## Create data sets +## 2 - Create data sets Inside this app 3 datasets will be used @@ -35,7 +34,6 @@ Inside this app 3 datasets will be used 3. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { ADSL <- teal.modules.general::rADSL @@ -45,67 +43,75 @@ data <- within(data, { datanames <- c("ADSL", "ADTTE", "ADLB") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] -# nolint end ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app itself will be constructed by multiple calls of `tm_data_table` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. +The app itself will be constructed by multiple calls of `tm_data_table()` using different combinations of data sets. ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( - data = data, - modules = teal::modules( - # two-datasets example - tm_data_table( - label = "Two datasets", - variables_selected = list( - ADSL = c("STUDYID", "USUBJID", "SUBJID", "SITEID", "AGE", "SEX"), - ADTTE = c( - "STUDYID", "USUBJID", "SUBJID", "SITEID", - "PARAM", "PARAMCD", "ARM", "ARMCD", "AVAL", "CNSR" - ) - ) - ), - # subsetting or changing order of datasets - tm_data_table( - label = "Datasets order", - variables_selected = list( - ADSL = c("STUDYID", "USUBJID", "SUBJID", "SITEID", "AGE", "SEX"), - ADLB = c( - "STUDYID", "USUBJID", "SUBJID", "SITEID", - "PARAM", "PARAMCD", "AVISIT", "AVISITN", "AVAL", "CHG" - ) - ), - datasets_selected = c("ADTTE", "ADLB", "ADSL") - ), - # advanced usage of DT options and extensions - tm_data_table( - label = "Advanced DT usage", - dt_args = list(extensions = c("Buttons", "ColReorder", "FixedHeader")), - dt_options = list( - searching = FALSE, - pageLength = 30, - lengthMenu = c(5, 15, 25, 50, 100), - scrollX = FALSE, - dom = "lBrtip", - buttons = c("copy", "csv", "excel", "pdf", "print"), - colReorder = TRUE, - fixedHeader = TRUE - ) +# configuration for the two-datasets example +mod1 <- tm_data_table( + label = "Two datasets", + variables_selected = list( + ADSL = c("STUDYID", "USUBJID", "SUBJID", "SITEID", "AGE", "SEX"), + ADTTE = c( + "STUDYID", "USUBJID", "SUBJID", "SITEID", + "PARAM", "PARAMCD", "ARM", "ARMCD", "AVAL", "CNSR" + ) + ) +) + +# configuration for the subsetting or changing order of datasets +mod2 <- tm_data_table( + label = "Datasets order", + variables_selected = list( + ADSL = c("STUDYID", "USUBJID", "SUBJID", "SITEID", "AGE", "SEX"), + ADLB = c( + "STUDYID", "USUBJID", "SUBJID", "SITEID", + "PARAM", "PARAMCD", "AVISIT", "AVISITN", "AVAL", "CHG" ) + ), + datasets_selected = c("ADTTE", "ADLB", "ADSL") +) + +# configuration for the advanced usage of DT options and extensions +mod3 <- tm_data_table( + label = "Advanced DT usage", + dt_args = list(extensions = c("Buttons", "ColReorder", "FixedHeader")), + dt_options = list( + searching = FALSE, + pageLength = 30, + lengthMenu = c(5, 15, 25, 50, 100), + scrollX = FALSE, + dom = "lBrtip", + buttons = c("copy", "csv", "excel", "pdf", "print"), + colReorder = TRUE, + fixedHeader = TRUE + ) +) + +# initialize the app +app <- init( + data = data, + modules = modules( + mod1, + mod2, + mod3 ) ) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + diff --git a/vignettes/using-outliers-module.Rmd b/vignettes/using-outliers-module.Rmd index be6c2325f..59e745bde 100644 --- a/vignettes/using-outliers-module.Rmd +++ b/vignettes/using-outliers-module.Rmd @@ -1,7 +1,6 @@ --- title: "Using outliers module" -author: "Mahmoud Hallal" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -10,33 +9,32 @@ vignette: > %\VignetteEncoding{UTF-8} --- -# Teal application to analyze and report outliers with various datasets types. +# `teal` application to analyze and report outliers with various datasets types. -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside the outliers module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the outliers module `tm_outliers()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets -Inside this app 5 datasets will be used +Inside this app 3 datasets will be used 1. `ADSL` A wide data set with subject data 2. `ADRS` A long data set with response data for subjects at different time points of the study 3. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { ADSL <- teal.modules.general::rADSL @@ -46,144 +44,155 @@ data <- within(data, { datanames <- c("ADSL", "ADRS", "ADLB") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] -# nolint end ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_outliers` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. The app +itself will be constructed by multiple calls of `tm_outliers()` using different combinations of data sets. ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( - data = data, - modules = teal::modules( - # tm_outliers ---- - modules( - label = "Outliers module", - tm_outliers( - label = "Single wide dataset", - outlier_var = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), - selected = "AGE", - fixed = FALSE - ) - ), - categorical_var = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices( - data[["ADSL"]], - subset = names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) - ), - selected = "RACE", - multiple = FALSE, - fixed = FALSE - ) - ) +# configuration for the single wide dataset +mod1 <- tm_outliers( + label = "Single wide dataset", + outlier_var = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), + selected = "AGE", + fixed = FALSE + ) + ), + categorical_var = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices( + data[["ADSL"]], + subset = names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) ), - tm_outliers( - label = "Wide and long datasets", - outlier_var = list( - teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), - selected = "AGE", - fixed = FALSE - ) - ), - teal.transform::data_extract_spec( - dataname = "ADLB", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADLB"]], c("AVAL", "CHG2")), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE - ) - ) + selected = "RACE", + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the wide and long datasets +mod2 <- tm_outliers( + label = "Wide and long datasets", + outlier_var = list( + data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), + selected = "AGE", + fixed = FALSE + ) + ), + data_extract_spec( + dataname = "ADLB", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADLB"]], c("AVAL", "CHG2")), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ) + ) + ), + categorical_var = + data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices( + data[["ADSL"]], + subset = names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) ), - categorical_var = - teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices( - data[["ADSL"]], - subset = names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) - ), - selected = "RACE", - multiple = FALSE, - fixed = FALSE - ) - ) - ), - tm_outliers( - label = "Multiple long datasets", - outlier_var = list( - teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADRS"]], c("ADY", "EOSDY")), - selected = "ADY", - fixed = FALSE - ) - ), - teal.transform::data_extract_spec( - dataname = "ADLB", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADLB"]], c("AVAL", "CHG2")), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE - ) - ) + selected = "RACE", + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the multiple long datasets +mod3 <- tm_outliers( + label = "Multiple long datasets", + outlier_var = list( + data_extract_spec( + dataname = "ADRS", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADRS"]], c("ADY", "EOSDY")), + selected = "ADY", + fixed = FALSE + ) + ), + data_extract_spec( + dataname = "ADLB", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADLB"]], c("AVAL", "CHG2")), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ) + ) + ), + categorical_var = list( + data_extract_spec( + dataname = "ADRS", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADRS"]], c("ARM", "ACTARM")), + selected = "ARM", + multiple = FALSE, + fixed = FALSE + ) + ), + data_extract_spec( + dataname = "ADLB", + select = select_spec( + label = "Select variables:", + choices = variable_choices( + data[["ADLB"]], + subset = names(Filter(isTRUE, sapply(data[["ADLB"]], is.factor))) ), - categorical_var = list( - teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADRS"]], c("ARM", "ACTARM")), - selected = "ARM", - multiple = FALSE, - fixed = FALSE - ) - ), - teal.transform::data_extract_spec( - dataname = "ADLB", - select = select_spec( - label = "Select variables:", - choices = variable_choices( - data[["ADLB"]], - subset = names(Filter(isTRUE, sapply(data[["ADLB"]], is.factor))) - ), - selected = "RACE", - multiple = FALSE, - fixed = FALSE - ) - ) - ) + selected = "RACE", + multiple = FALSE, + fixed = FALSE ) ) ) ) + +# initialize the app +app <- init( + data = data, + modules = modules( + # tm_outliers ---- + modules( + label = "Outliers module", + mod1, + mod2, + mod3 + ) + ) +) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + + diff --git a/vignettes/using-regression-plots.Rmd b/vignettes/using-regression-plots.Rmd index c409775a3..ea17dcee5 100644 --- a/vignettes/using-regression-plots.Rmd +++ b/vignettes/using-regression-plots.Rmd @@ -1,7 +1,6 @@ --- title: "Using regression plots" -author: "Dawid Kałędkowski" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -11,39 +10,36 @@ vignette: > --- -# Teal application to use regression plot with various datasets types +# `teal` application to use regression plot with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside an regression plot module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the regression plot module `tm_a_regression()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets -Inside this app 5 datasets will be used +Inside this app 4 datasets will be used 1. `ADSL` A wide data set with subject data -2. `ADSL2` A wide data set with subject data -3. `ADRS` A long data set with response data for subjects at different time points of the study -4. `ADTTE` A long data set with time to event data -5. `ADLB` A long data set with lab measurements for each subject +2. `ADRS` A long data set with response data for subjects at different time points of the study +3. `ADTTE` A long data set with time to event data +4. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADSL2 <- teal.modules.general::rADSL %>% + ADSL <- teal.modules.general::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) ADRS <- teal.modules.general::rADRS ADTTE <- teal.modules.general::rADTTE @@ -54,216 +50,228 @@ data <- within(data, { TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADSL2", "ADRS", "ADTTE", "ADLB") +datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") datanames(data) <- datanames -jk <- default_cdisc_join_keys[datanames] -jk_adsl2 <- jk -names(jk_adsl2)[names(jk_adsl2) == "ADSL"] <- "ADSL2" -jk <- c(jk, jk_adsl2) -jk["ADSL2", "ADSL"] <- c("USUBJID", "STUDYID") -# nolint end +join_keys(data) <- default_cdisc_join_keys[datanames] ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_a_regression` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. The app +itself will be constructed by multiple calls of `tm_a_regression()` using different combinations of data sets. ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( - data = data, - modules = teal::modules( - modules( - label = "Regression plots", - tm_a_regression( - label = "Single wide dataset", - response = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2")), - selected = "BMRKR1", - multiple = FALSE, - fixed = FALSE - ) - ), - regressor = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")), - selected = "AGE", - multiple = TRUE, - fixed = FALSE - ) - ) - ), - tm_a_regression( - label = "Two wide datasets", - default_plot_type = 2, - response = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2")), - selected = "BMRKR1", - multiple = FALSE, - fixed = FALSE - ) - ), - regressor = teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL2"]], c("AGE", "SEX", "RACE")), - selected = c("AGE", "RACE"), - multiple = TRUE, - fixed = FALSE - ) - ) +# configuration for the single wide dataset +mod1 <- tm_a_regression( + label = "Single wide dataset", + response = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2")), + selected = "BMRKR1", + multiple = FALSE, + fixed = FALSE + ) + ), + regressor = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")), + selected = "AGE", + multiple = TRUE, + fixed = FALSE + ) + ) +) + +# configuration for the two wide datasets +mod2 <- tm_a_regression( + label = "Two wide datasets", + default_plot_type = 2, + response = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2")), + selected = "BMRKR1", + multiple = FALSE, + fixed = FALSE + ) + ), + regressor = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")), + selected = c("AGE", "RACE"), + multiple = TRUE, + fixed = FALSE + ) + ) +) + +# configuration for the same long datasets (same subset) +mod3 <- tm_a_regression( + label = "Same long datasets (same subset)", + default_plot_type = 2, + response = data_extract_spec( + dataname = "ADTTE", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADTTE"]], c("AVAL", "CNSR")), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ), + filter = filter_spec( + label = "Select parameter:", + vars = "PARAMCD", + choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + selected = "PFS", + multiple = FALSE + ) + ), + regressor = data_extract_spec( + dataname = "ADTTE", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADTTE"]], c("AGE", "CNSR", "SEX")), + selected = c("AGE", "CNSR", "SEX"), + multiple = TRUE + ), + filter = filter_spec( + label = "Select parameter:", + vars = "PARAMCD", + choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + selected = "PFS", + multiple = FALSE + ) + ) +) + +# configuration for the wide and long datasets +mod4 <- tm_a_regression( + label = "Wide and long datasets", + response = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[2], + multiple = TRUE, + label = "Select measurement:" ), - tm_a_regression( - label = "Same long datasets (same subset)", - default_plot_type = 2, - response = teal.transform::data_extract_spec( - dataname = "ADTTE", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADTTE"]], c("AVAL", "CNSR")), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE - ), - filter = teal.transform::filter_spec( - label = "Select parameter:", - vars = "PARAMCD", - choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), - selected = "PFS", - multiple = FALSE - ) - ), - regressor = teal.transform::data_extract_spec( - dataname = "ADTTE", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADTTE"]], c("AGE", "CNSR", "SEX")), - selected = c("AGE", "CNSR", "SEX"), - multiple = TRUE - ), - filter = teal.transform::filter_spec( - label = "Select parameter:", - vars = "PARAMCD", - choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), - selected = "PFS", - multiple = FALSE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[2], + multiple = TRUE, + label = "Select visit:" + ) + ), + select = select_spec( + label = "Select variable:", + choices = "AVAL", + selected = "AVAL", + multiple = FALSE, + fixed = TRUE + ) + ), + regressor = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2", "AGE")), + selected = "AGE", + multiple = TRUE, + fixed = FALSE + ) + ) +) + +# configuration for the same long datasets (different subsets) +mod5 <- tm_a_regression( + label = "Same long datasets (different subsets)", + default_plot_type = 2, + response = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = TRUE, + label = "Select lab:" ), - tm_a_regression( - label = "Wide and long datasets", - response = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[2], - multiple = TRUE, - label = "Select measurement:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[2], - multiple = TRUE, - label = "Select visit:" - ) - ), - select = select_spec( - label = "Select variable:", - choices = "AVAL", - selected = "AVAL", - multiple = FALSE, - fixed = TRUE - ) - ), - regressor = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2", "AGE")), - selected = "AGE", - multiple = TRUE, - fixed = FALSE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = TRUE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = "AVAL", + selected = "AVAL", + multiple = FALSE, + fixed = TRUE + ) + ), + regressor = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select labs:" ), - tm_a_regression( - label = "Same long datasets (different subsets)", - default_plot_type = 2, - response = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = TRUE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = TRUE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = "AVAL", - selected = "AVAL", - multiple = FALSE, - fixed = TRUE - ) - ), - regressor = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select labs:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("AVAL", "AGE", "BMRKR1", "BMRKR2", "SEX", "ARM")), - selected = c("AVAL", "BMRKR1"), - multiple = TRUE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("AVAL", "AGE", "BMRKR1", "BMRKR2", "SEX", "ARM")), + selected = c("AVAL", "BMRKR1"), + multiple = TRUE + ) + ) +) + +# initialize the app +app <- init( + data = data, + modules = modules( + modules( + label = "Regression plots", + mod1, + mod2, + mod3, + mod4, + mod5 ) ) ) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + diff --git a/vignettes/using-response-plot.Rmd b/vignettes/using-response-plot.Rmd index b60f74387..7eef800d9 100644 --- a/vignettes/using-response-plot.Rmd +++ b/vignettes/using-response-plot.Rmd @@ -1,7 +1,6 @@ --- title: "Using response plot" -author: "Dawid Kałędkowski" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -10,39 +9,36 @@ vignette: > %\VignetteEncoding{UTF-8} --- -# Teal application to use response plot with various datasets types +# `teal` application to use response plot with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside an response plot module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the response plot module `tm_g_response()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets -Inside this app 5 datasets will be used +Inside this app 4 datasets will be used 1. `ADSL` A wide data set with subject data -2. `ADSL2` A wide data set with subject data -3. `ADRS` A long data set with response data for subjects at different time points of the study -4. `ADTTE` A long data set with time to event data -5. `ADLB` A long data set with lab measurements for each subject +2. `ADRS` A long data set with response data for subjects at different time points of the study +3. `ADTTE` A long data set with time to event data +4. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADSL2 <- teal.modules.general::rADSL %>% + ADSL <- teal.modules.general::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) ADRS <- teal.modules.general::rADRS ADTTE <- teal.modules.general::rADTTE @@ -53,324 +49,338 @@ data <- within(data, { TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADSL2", "ADRS", "ADTTE", "ADLB") +datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") datanames(data) <- datanames -jk <- default_cdisc_join_keys[datanames] -jk_adsl2 <- jk -names(jk_adsl2)[names(jk_adsl2) == "ADSL"] <- "ADSL2" -jk <- c(jk, jk_adsl2) -jk["ADSL2", "ADSL"] <- c("USUBJID", "STUDYID") -# nolint end +join_keys(data) <- default_cdisc_join_keys[datanames] ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_g_response` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. The app +itself will be constructed by multiple calls of `tm_g_response()` using different combinations of data sets. ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( - data = data, - modules = teal::modules( - modules( - label = "Response plot", - tm_g_response( - label = "Single wide dataset", - response = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("BMRKR2", "ITTFL", "BEP01FL")), - selected = "BMRKR2", - multiple = FALSE, - fixed = FALSE - ) - ), - x = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY", "ARMCD", "STRATA1")), - selected = "ARMCD", - multiple = FALSE, - fixed = FALSE - ) - ) +# configuration for the single wide dataset +mod1 <- tm_g_response( + label = "Single wide dataset", + response = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("BMRKR2", "ITTFL", "BEP01FL")), + selected = "BMRKR2", + multiple = FALSE, + fixed = FALSE + ) + ), + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("SEX", "RACE", "COUNTRY", "ARMCD", "STRATA1")), + selected = "ARMCD", + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the two wide datasets +mod2 <- tm_g_response( + label = "Two wide datasets", + response = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("BMRKR2", "ITTFL", "BEP01FL")), + selected = "BMRKR2", + multiple = FALSE + ) + ), + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = c("SEX", "COUNTRY", "RACE", "STRATA1", "ARMCD"), + selected = "ARMCD", + multiple = FALSE + ) + ) +) + +# configuration for the multiple long datasets +mod3 <- tm_g_response( + label = "Multiple long datasets", + response = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + label = "Select parameter:", + vars = "PARAMCD", + choices = levels(data[["ADLB"]]$PARAMCD), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE ), - tm_g_response( - label = "Two wide datasets", - response = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("BMRKR2", "ITTFL", "BEP01FL")), - selected = "BMRKR2", - multiple = FALSE - ) - ), - x = teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variable:", - choices = c("SEX", "COUNTRY", "RACE", "STRATA1", "ARMCD"), - selected = "ARMCD", - multiple = FALSE - ) - ) + filter_spec( + label = "Select visit:", + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE + ) + ), + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADLB"]], c("BMRKR2", "ITTFL", "BEP01FL")), + selected = "BMRKR2", + multiple = FALSE + ) + ), + x = data_extract_spec( + dataname = "ADRS", + filter = list( + filter_spec( + label = "Select parameter:", + vars = "PARAMCD", + choices = levels(data[["ADRS"]]$PARAMCD), + selected = levels(data[["ADRS"]]$PARAMCD)[3], + multiple = FALSE ), - tm_g_response( - label = "Multiple long datasets", - response = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - label = "Select parameter:", - vars = "PARAMCD", - choices = levels(data[["ADLB"]]$PARAMCD), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE - ), - filter_spec( - label = "Select visit:", - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE - ) - ), - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADLB"]], c("BMRKR2", "ITTFL", "BEP01FL")), - selected = "BMRKR2", - multiple = FALSE - ) - ), - x = teal.transform::data_extract_spec( - dataname = "ADRS", - filter = list( - filter_spec( - label = "Select parameter:", - vars = "PARAMCD", - choices = levels(data[["ADRS"]]$PARAMCD), - selected = levels(data[["ADRS"]]$PARAMCD)[3], - multiple = FALSE - ), - filter_spec( - label = "Select visit:", - vars = "AVISIT", - choices = levels(data[["ADRS"]]$AVISIT), - selected = levels(data[["ADRS"]]$AVISIT)[3], - multiple = FALSE - ) - ), - select = select_spec( - choices = c("AVALC", "ITTFL", "BEP01FL"), - selected = "AVALC", - multiple = FALSE, - fixed = TRUE - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = "SEX", - selected = NULL, - multiple = FALSE - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("SEX", "COUNTRY")), - selected = NULL, - multiple = FALSE - ) - ) + filter_spec( + label = "Select visit:", + vars = "AVISIT", + choices = levels(data[["ADRS"]]$AVISIT), + selected = levels(data[["ADRS"]]$AVISIT)[3], + multiple = FALSE + ) + ), + select = select_spec( + choices = c("AVALC", "ITTFL", "BEP01FL"), + selected = "AVALC", + multiple = FALSE, + fixed = TRUE + ) + ), + row_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = "SEX", + selected = NULL, + multiple = FALSE + ) + ), + col_facet = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("SEX", "COUNTRY")), + selected = NULL, + multiple = FALSE + ) + ) +) + +# configuration for the wide and long dataset +mod4 <- tm_g_response( + label = "Wide and long dataset", + response = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = levels(data[["ADLB"]]$PARAMCD), + selected = levels(data[["ADLB"]]$PARAMCD)[2], + multiple = TRUE, + label = "Select measurement:" ), - tm_g_response( - label = "Wide and long dataset", - response = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = levels(data[["ADLB"]]$PARAMCD), - selected = levels(data[["ADLB"]]$PARAMCD)[2], - multiple = TRUE, - label = "Select measurement:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[2], - multiple = TRUE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("BMRKR2", "ITTFL", "BEP01FL")), - selected = "BMRKR2", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - x = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - choices = variable_choices(data[["ADSL"]], c("ARMCD", "BMRKR1", "BMRKR2", "BEP01FL")), - selected = "BMRKR2", - multiple = FALSE, - fixed = FALSE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[2], + multiple = TRUE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("BMRKR2", "ITTFL", "BEP01FL")), + selected = "BMRKR2", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + choices = variable_choices(data[["ADSL"]], c("ARMCD", "BMRKR1", "BMRKR2", "BEP01FL")), + selected = "BMRKR2", + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the same long datasets (same subsets) +mod5 <- tm_g_response( + label = "Same long datasets (same subsets)", + response = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("BMRKR2", "AVALC", "BEP01FL")), + selected = "AVALC", + multiple = FALSE, + fixed = TRUE, + label = "Select variable:" + ) + ), + x = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVALC", "AGE", "SEX", "ARMCD", "STRATA1")), + selected = "ARMCD", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + row_facet = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = "PARAMCD", + selected = "PARAMCD", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + col_facet = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = "AVISIT", + selected = "AVISIT", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# configuration for the same long datasets (different subsets) +mod6 <- tm_g_response( + label = "Same long datasets (different subsets)", + response = data_extract_spec( + dataname = "ADLB", + filter = filter_spec( + vars = "PARAMCD", + choices = levels(data[["ADLB"]]$PARAMCD), + selected = levels(data[["ADLB"]]$PARAMCD)[2], + multiple = FALSE, + label = "Select lab:" + ), + select = select_spec( + choices = "BMRKR2", + selected = "BMRKR2", + multiple = FALSE, + fixed = TRUE + ) + ), + x = data_extract_spec( + dataname = "ADLB", + filter = filter_spec( + vars = "PARAMCD", + choices = levels(data[["ADLB"]]$PARAMCD), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("AVISIT", "PARAMCD", "BEP01FL")), + selected = "AVISIT", + multiple = FALSE, + fixed = TRUE + ) + ), + row_facet = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = levels(data[["ADLB"]]$PARAMCD), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_response( - label = "Same long datasets", - response = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("BMRKR2", "AVALC", "BEP01FL")), - selected = "AVALC", - multiple = FALSE, - fixed = TRUE, - label = "Select variable:" - ) - ), - x = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVALC", "AGE", "SEX", "ARMCD", "STRATA1")), - selected = "ARMCD", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = "PARAMCD", - selected = "PARAMCD", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = "AVISIT", - selected = "AVISIT", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("SEX", "RACE", "ARMCD")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select Variable" + ) + ), + col_facet = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = levels(data[["ADLB"]]$PARAMCD), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_response( - label = "Same long datasets (different subsets)", - response = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = teal.transform::filter_spec( - vars = "PARAMCD", - choices = levels(data[["ADLB"]]$PARAMCD), - selected = levels(data[["ADLB"]]$PARAMCD)[2], - multiple = FALSE, - label = "Select lab:" - ), - select = select_spec( - choices = "BMRKR2", - selected = "BMRKR2", - multiple = FALSE, - fixed = TRUE - ) - ), - x = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = teal.transform::filter_spec( - vars = "PARAMCD", - choices = levels(data[["ADLB"]]$PARAMCD), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("AVISIT", "PARAMCD", "BEP01FL")), - selected = "AVISIT", - multiple = FALSE, - fixed = TRUE - ) - ), - row_facet = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = levels(data[["ADLB"]]$PARAMCD), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("SEX", "RACE", "ARMCD")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select Variable" - ) - ), - col_facet = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = levels(data[["ADLB"]]$PARAMCD), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("SEX", "RACE", "ARMCD")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("SEX", "RACE", "ARMCD")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# initialize the app +app <- init( + data = data, + modules = modules( + modules( + label = "Response plot", + mod1, + mod2, + mod3, + mod4, + mod5, + mod6 ) ) ) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` - + diff --git a/vignettes/using-scatterplot-matrix.Rmd b/vignettes/using-scatterplot-matrix.Rmd index 41fa0aeeb..c462e68a8 100644 --- a/vignettes/using-scatterplot-matrix.Rmd +++ b/vignettes/using-scatterplot-matrix.Rmd @@ -1,7 +1,6 @@ --- title: "Using scatterplot matrix" -author: "Dawid Kałędkowski" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -11,39 +10,36 @@ vignette: > --- -# Teal application to use scatter plot matrix with various datasets types +# `teal` application to use scatter plot matrix with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside an scatter plot matrix module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the scatter plot matrix module `tm_g_scatterplotmatrix()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets -Inside this app 5 datasets will be used +Inside this app 4 datasets will be used 1. `ADSL` A wide data set with subject data -2. `ADSL2` A wide data set with subject data -3. `ADRS` A long data set with response data for subjects at different time points of the study -4. `ADTTE` A long data set with time to event data -5. `ADLB` A long data set with lab measurements for each subject +2. `ADRS` A long data set with response data for subjects at different time points of the study +3. `ADTTE` A long data set with time to event data +4. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADSL2 <- teal.modules.general::rADSL %>% + ADSL <- teal.modules.general::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) ADRS <- teal.modules.general::rADRS ADTTE <- teal.modules.general::rADTTE @@ -54,137 +50,115 @@ data <- within(data, { TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADSL2", "ADRS", "ADTTE", "ADLB") +datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") datanames(data) <- datanames -jk <- default_cdisc_join_keys[datanames] -jk_adsl2 <- jk -names(jk_adsl2)[names(jk_adsl2) == "ADSL"] <- "ADSL2" -jk <- c(jk, jk_adsl2) -jk["ADSL2", "ADSL"] <- c("USUBJID", "STUDYID") -# nolint end +join_keys(data) <- default_cdisc_join_keys[datanames] ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_g_scatterplotmatrix` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. The app +itself will be constructed by multiple calls of `tm_g_scatterplotmatrix()` using different combinations of data sets. ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( - data = data, - modules = teal::modules( - modules( - label = "Scatterplot matrix", - # .. single wide ---- - tm_g_scatterplotmatrix( - label = "Single wide dataset", - variables = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]]), - selected = c("AGE", "RACE", "SEX", "BMRKR1", "BMRKR2"), - multiple = TRUE, - fixed = FALSE, - ordered = TRUE - ) - ) - ), - tm_g_scatterplotmatrix( - label = "Multiple wide datasets", - variables = list( - teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]]), - selected = c("AGE", "ACTARM", "SEX", "BMRKR1"), - multiple = TRUE, - fixed = FALSE, - ordered = TRUE - ) - ), - teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL2"]]), - selected = c("COUNTRY", "ACTARM", "STRATA1"), - multiple = TRUE, - fixed = FALSE, - ordered = TRUE - ) - ) - ) +# configuration for the single wide dataset +mod1 <- tm_g_scatterplotmatrix( + label = "Single wide dataset", + variables = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]]), + selected = c("AGE", "RACE", "SEX", "BMRKR1", "BMRKR2"), + multiple = TRUE, + fixed = FALSE, + ordered = TRUE + ) + ) +) + +# configuration for the one long datasets +mod2 <- tm_g_scatterplotmatrix( + "One long dataset", + variables = data_extract_spec( + dataname = "ADTTE", + select = select_spec( + choices = variable_choices(data[["ADTTE"]], c("AVAL", "BMRKR1", "BMRKR2")), + selected = c("AVAL", "BMRKR1", "BMRKR2"), + multiple = TRUE, + fixed = FALSE, + ordered = TRUE, + label = "Select variables:" + ) + ) +) + +# configuration for the two long datasets +mod3 <- tm_g_scatterplotmatrix( + label = "Two long datasets", + variables = list( + data_extract_spec( + dataname = "ADRS", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADRS"]]), + selected = c("AVAL", "AVALC"), + multiple = TRUE, + fixed = FALSE, + ordered = TRUE, ), - tm_g_scatterplotmatrix( - "One long dataset", - variables = teal.transform::data_extract_spec( - dataname = "ADTTE", - select = select_spec( - choices = variable_choices(data[["ADTTE"]], c("AVAL", "BMRKR1", "BMRKR2")), - selected = c("AVAL", "BMRKR1", "BMRKR2"), - multiple = TRUE, - fixed = FALSE, - ordered = TRUE, - label = "Select variables:" - ) - ) + filter = filter_spec( + label = "Select endpoints:", + vars = c("PARAMCD", "AVISIT"), + choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), + selected = "OVRINV - SCREENING", + multiple = FALSE + ) + ), + data_extract_spec( + dataname = "ADTTE", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADTTE"]]), + selected = c("AVAL", "CNSR"), + multiple = TRUE, + fixed = FALSE, + ordered = TRUE ), - tm_g_scatterplotmatrix( - label = "Two long datasets", - variables = list( - teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADRS"]]), - selected = c("AVAL", "AVALC"), - multiple = TRUE, - fixed = FALSE, - ordered = TRUE, - ), - filter = teal.transform::filter_spec( - label = "Select endpoints:", - vars = c("PARAMCD", "AVISIT"), - choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), - selected = "OVRINV - SCREENING", - multiple = FALSE - ) - ), - teal.transform::data_extract_spec( - dataname = "ADTTE", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADTTE"]]), - selected = c("AVAL", "CNSR"), - multiple = TRUE, - fixed = FALSE, - ordered = TRUE - ), - filter = teal.transform::filter_spec( - label = "Select parameters:", - vars = "PARAMCD", - choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), - selected = "OS", - multiple = TRUE - ) - ) - ) + filter = filter_spec( + label = "Select parameters:", + vars = "PARAMCD", + choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + selected = "OS", + multiple = TRUE ) ) ) ) + +# initialize the app +app <- init( + data = data, + modules = modules( + modules( + label = "Scatterplot matrix", + mod1, + mod2, + mod3 + ) + ) +) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + diff --git a/vignettes/using-scatterplot.Rmd b/vignettes/using-scatterplot.Rmd index 805a360e3..4ae42895c 100644 --- a/vignettes/using-scatterplot.Rmd +++ b/vignettes/using-scatterplot.Rmd @@ -1,7 +1,6 @@ --- title: "Using scatterplot" -author: "Dawid Kałędkowski" -date: "`r Sys.Date()`" +author: "NEST CoreDev" output: rmarkdown::html_vignette runtime: shiny vignette: > @@ -11,39 +10,36 @@ vignette: > --- -# Teal application to use scatter plot with various datasets types +# `teal` application to use scatter plot with various datasets types -This vignette will guide you through 4 parts to create a teal application using -various types of datasets inside an scatter plot module: +This vignette will guide you through the four parts to create a `teal` application using +various types of datasets using the scatter plot module `tm_g_scatterplot()`: -1. Load Libraries +1. Load libraries 2. Create data sets 3. Create an `app` variable -4. Run the App +4. Run the app -## Loading libraries +## 1 - Load libraries ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` -## Create data sets +## 2 - Create data sets -Inside this app 5 datasets will be used +Inside this app 4 datasets will be used 1. `ADSL` A wide data set with subject data -2. `ADSL2` A wide data set with subject data -3. `ADRS` A long data set with response data for subjects at different time points of the study -4. `ADTTE` A long data set with time to event data -5. `ADLB` A long data set with lab measurements for each subject +2. `ADRS` A long data set with response data for subjects at different time points of the study +3. `ADTTE` A long data set with time to event data +4. `ADLB` A long data set with lab measurements for each subject ```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -# nolint start data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADSL2 <- teal.modules.general::rADSL %>% + ADSL <- teal.modules.general::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) ADRS <- teal.modules.general::rADRS ADTTE <- teal.modules.general::rADTTE @@ -54,21 +50,16 @@ data <- within(data, { TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADSL2", "ADRS", "ADTTE", "ADLB") +datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") datanames(data) <- datanames -jk <- default_cdisc_join_keys[datanames] -jk_adsl2 <- jk -names(jk_adsl2)[names(jk_adsl2) == "ADSL"] <- "ADSL2" -jk <- c(jk, jk_adsl2) -jk["ADSL2", "ADSL"] <- c("USUBJID", "STUDYID") -# nolint end +join_keys(data) <- default_cdisc_join_keys[datanames] ``` -## Create an `app` variable +## 3 - Create an `app` variable -This is the most important section. We will use the [`teal::init`](https://insightsengineering.github.io/teal/reference/init) function to -create an app. The data will be handed over using [`teal.data::cdisc_data`](https://insightsengineering.github.io/teal.data/reference/cdisc_data). The app -itself will be constructed by multiple calls of `tm_g_scatterplot` using different +This is the most important section. We will use the `teal::init()` function to +create an app. The data will be handed over using `teal.data::teal_data()`. The app +itself will be constructed by multiple calls of `tm_g_scatterplot()` using different combinations of data sets. ```{r ggExtra, include = FALSE} @@ -78,296 +69,316 @@ ggextra_available <- requireNamespace("ggExtra", quietly = TRUE) # NOTE: The code will not be run as package ggExtra is not installed. ``` ```{r, eval = ggextra_available, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} -app <- teal::init( - data = data, - modules = teal::modules( - modules( - label = "Scatterplot", - tm_g_scatterplot( - label = "Single wide dataset", - x = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")), - selected = "AGE", - multiple = FALSE, - fixed = FALSE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")), - selected = "BMRKR1", - multiple = FALSE, - fixed = FALSE - ) - ), - color_by = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variables:", - choices = variable_choices(data[["ADSL"]], c("RACE", "SEX")), - selected = NULL, - multiple = TRUE, - fixed = FALSE - ) - ) - ), - # .. Two wide ----- - tm_g_scatterplot( - label = "Two wide datasets", - x = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2")), - selected = "BMRKR1", - multiple = FALSE, - fixed = FALSE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL2"]], c("AGE", "SEX")), - selected = "AGE", - multiple = FALSE, - fixed = FALSE - ) - ), - color_by = teal.transform::data_extract_spec( - dataname = "ADSL2", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL2"]], c("COUNTRY", "AGE", "RACE")), - selected = "COUNTRY", - multiple = FALSE, - fixed = FALSE - ) - ) +# configuration for the single wide datasets +mod1 <- tm_g_scatterplot( + label = "Single wide dataset", + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")), + selected = "AGE", + multiple = FALSE, + fixed = FALSE + ) + ), + y = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")), + selected = "BMRKR1", + multiple = FALSE, + fixed = FALSE + ) + ), + color_by = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variables:", + choices = variable_choices(data[["ADSL"]], c("RACE", "SEX")), + selected = NULL, + multiple = TRUE, + fixed = FALSE + ) + ) +) + +# configuration for the two wide datasets +mod2 <- tm_g_scatterplot( + label = "Two wide datasets", + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("BMRKR1", "BMRKR2")), + selected = "BMRKR1", + multiple = FALSE, + fixed = FALSE + ) + ), + y = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("AGE", "SEX")), + selected = "AGE", + multiple = FALSE, + fixed = FALSE + ) + ), + color_by = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("COUNTRY", "AGE", "RACE")), + selected = "COUNTRY", + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the different long datasets +mod3 <- tm_g_scatterplot( + label = "Different long datasets", + x = data_extract_spec( + dataname = "ADRS", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADRS"]]), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ), + filter = filter_spec( + label = "Select endpoint:", + vars = c("PARAMCD", "AVISIT"), + choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), + selected = "OVRINV - SCREENING", + multiple = FALSE + ) + ), + y = data_extract_spec( + dataname = "ADTTE", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADTTE"]]), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE + ), + filter = filter_spec( + label = "Select parameters:", + vars = c("PARAMCD"), + choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), + selected = "OS", + multiple = TRUE + ) + ), + color_by = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("AGE", "SEX")), + selected = "AGE", + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the wide and long datasets +mod4 <- tm_g_scatterplot( + label = "Wide and long datasets", + x = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "BMRKR1", "COUNTRY")), + selected = "AGE", + multiple = FALSE, + fixed = FALSE + ) + ), + y = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select measurement:" ), - tm_g_scatterplot( - label = "Different long datasets", - x = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADRS"]]), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE - ), - filter = teal.transform::filter_spec( - label = "Select endpoint:", - vars = c("PARAMCD", "AVISIT"), - choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), - selected = "OVRINV - SCREENING", - multiple = FALSE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADTTE", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADTTE"]]), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE - ), - filter = teal.transform::filter_spec( - label = "Select parameters:", - vars = c("PARAMCD"), - choices = value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), - selected = "OS", - multiple = TRUE - ) - ), - color_by = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("AGE", "SEX")), - selected = "AGE", - multiple = FALSE, - fixed = FALSE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + label = "Selected variable:", + choices = "AVAL", + selected = "AVAL", + multiple = FALSE, + fixed = TRUE + ) + ), + color_by = data_extract_spec( + dataname = "ADSL", + select = select_spec( + label = "Select variable:", + choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "RACE", "COUNTRY")), + selected = NULL, + multiple = FALSE, + fixed = FALSE + ) + ) +) + +# configuration for the same long datasets (same subsets) +mod5 <- tm_g_scatterplot( + label = "Same long datasets (same subsets)", + x = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVAL", "BMRKR1", "BMRKR2")), + selected = "AVAL", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + y = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AVAL", "BMRKR1", "BMRKR2")), + selected = "BMRKR1", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ), + color_by = data_extract_spec( + dataname = "ADRS", + select = select_spec( + choices = variable_choices(data[["ADRS"]], c("AGE", "SEX", "RACE")), + selected = NULL, + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# configuration for the same long datasets (different subsets) +mod6 <- tm_g_scatterplot( + label = "Same long datasets (different subsets)", + x = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_scatterplot( - label = "Wide and long datasets", - x = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "BMRKR1", "COUNTRY")), - selected = "AGE", - multiple = FALSE, - fixed = FALSE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select measurement:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - label = "Selected variable:", - choices = "AVAL", - selected = "AVAL", - multiple = FALSE, - fixed = TRUE - ) - ), - color_by = teal.transform::data_extract_spec( - dataname = "ADSL", - select = select_spec( - label = "Select variable:", - choices = variable_choices(data[["ADSL"]], c("SEX", "AGE", "RACE", "COUNTRY")), - selected = NULL, - multiple = FALSE, - fixed = FALSE - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = "AVAL", + selected = "AVAL", + multiple = FALSE, + fixed = TRUE + ) + ), + y = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_scatterplot( - label = "Same long datasets (same subsets)", - x = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVAL", "BMRKR1", "BMRKR2")), - selected = "AVAL", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AVAL", "BMRKR1", "BMRKR2")), - selected = "BMRKR1", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ), - color_by = teal.transform::data_extract_spec( - dataname = "ADRS", - select = select_spec( - choices = variable_choices(data[["ADRS"]], c("AGE", "SEX", "RACE")), - selected = NULL, - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" + ) + ), + select = select_spec( + choices = "AVAL", + selected = "AVAL", + multiple = FALSE, + fixed = TRUE + ) + ), + color_by = data_extract_spec( + dataname = "ADLB", + filter = list( + filter_spec( + vars = "PARAMCD", + choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), + selected = levels(data[["ADLB"]]$PARAMCD)[1], + multiple = FALSE, + label = "Select lab:" ), - tm_g_scatterplot( - label = "Same long datasets (different subsets)", - x = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = "AVAL", - selected = "AVAL", - multiple = FALSE, - fixed = TRUE - ) - ), - y = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = "AVAL", - selected = "AVAL", - multiple = FALSE, - fixed = TRUE - ) - ), - color_by = teal.transform::data_extract_spec( - dataname = "ADLB", - filter = list( - filter_spec( - vars = "PARAMCD", - choices = value_choices(data[["ADLB"]], "PARAMCD", "PARAM"), - selected = levels(data[["ADLB"]]$PARAMCD)[1], - multiple = FALSE, - label = "Select lab:" - ), - filter_spec( - vars = "AVISIT", - choices = levels(data[["ADLB"]]$AVISIT), - selected = levels(data[["ADLB"]]$AVISIT)[1], - multiple = FALSE, - label = "Select visit:" - ) - ), - select = select_spec( - choices = variable_choices(data[["ADLB"]], c("RACE", "SEX")), - selected = "SEX", - multiple = FALSE, - fixed = FALSE, - label = "Select variable:" - ) - ) + filter_spec( + vars = "AVISIT", + choices = levels(data[["ADLB"]]$AVISIT), + selected = levels(data[["ADLB"]]$AVISIT)[1], + multiple = FALSE, + label = "Select visit:" ) + ), + select = select_spec( + choices = variable_choices(data[["ADLB"]], c("RACE", "SEX")), + selected = "SEX", + multiple = FALSE, + fixed = FALSE, + label = "Select variable:" + ) + ) +) + +# initialize the app +app <- init( + data = data, + modules = modules( + modules( + label = "Scatterplot", + mod1, + mod2, + mod3, + mod4, + mod5, + mod6 ) ) ) ``` -## Run the app +## 4 - Run the app -A simple `shiny::shinyApp` call will let you run the app. -Note that app is only displayed when running this code inside an R session. +A simple `shiny::shinyApp()` call will let you run the app. +Note that app is only displayed when running this code inside an `R` session. -```{r, eval = ggextra_available, echo=TRUE} +```{r, echo=TRUE, results="hide"} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +