diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 4bce0c86d..187f8bb41 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -42,6 +42,22 @@ jobs: checking top-level files .* NOTE unit-test-report-brand: >- https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/thumbs/teal.png + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor r-cmd-non-cran: name: R CMD Check (non-CRAN) 🧬 uses: insightsengineering/r.pkg.template/.github/workflows/build-check-install.yaml@main @@ -51,12 +67,10 @@ jobs: additional-env-vars: | _R_CHECK_EXAMPLE_TIMING_THRESHOLD_=11 TESTING_DEPTH=5 + NOT_CRAN=true enforce-note-blocklist: true - publish-unit-test-report-gh-pages: false - junit-xml-comparison: false concurrency-group: non-cran - disable-unit-test-reports: true - skip-r-cmd-install: true + unit-test-report-directory: unit-test-report-non-cran note-blocklist: | checking dependencies in R code .* NOTE checking R code for possible problems .* NOTE @@ -66,11 +80,46 @@ jobs: checking Rd .usage sections .* NOTE checking for unstated dependencies in vignettes .* NOTE checking top-level files .* NOTE + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor coverage: name: Coverage πŸ“” uses: insightsengineering/r.pkg.template/.github/workflows/test-coverage.yaml@main secrets: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} + with: + additional-env-vars: | + NOT_CRAN=true + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor linter: if: github.event_name != 'push' name: SuperLinter πŸ¦Έβ€β™€οΈ @@ -82,6 +131,22 @@ jobs: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} with: auto-update: true + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor gitleaks: name: gitleaks πŸ’§ uses: insightsengineering/r.pkg.template/.github/workflows/gitleaks.yaml@main diff --git a/.github/workflows/docs.yaml b/.github/workflows/docs.yaml index 9b7a7e54e..2e3d8a86c 100644 --- a/.github/workflows/docs.yaml +++ b/.github/workflows/docs.yaml @@ -41,3 +41,20 @@ jobs: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} with: default-landing-page: latest-tag + additional-unit-test-report-directories: unit-test-report-non-cran + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor diff --git a/.github/workflows/on-demand.yaml b/.github/workflows/on-demand.yaml deleted file mode 100644 index 02843bb32..000000000 --- a/.github/workflows/on-demand.yaml +++ /dev/null @@ -1,12 +0,0 @@ ---- -name: On-demand πŸ§‘β€πŸ”¬ - -on: - schedule: - - cron: '45 3 * * 0' - workflow_dispatch: - -jobs: - revdepcheck: - name: revdepcheck ↩️ - uses: insightsengineering/r.pkg.template/.github/workflows/revdepcheck.yaml@main diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index 226473ce9..4d94ee58d 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -16,12 +16,43 @@ jobs: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} with: default-landing-page: latest-tag + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/tern + insightsengineering/nestcolor + insightsengineering/roxy.shinylive + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer validation: name: R Package Validation report πŸ“ƒ needs: release uses: insightsengineering/r.pkg.template/.github/workflows/validation.yaml@main secrets: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} + with: + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/tern + insightsengineering/nestcolor + insightsengineering/roxy.shinylive + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer release: name: Create release πŸŽ‰ uses: insightsengineering/r.pkg.template/.github/workflows/release.yaml@main @@ -46,9 +77,47 @@ jobs: checking top-level files .* NOTE unit-test-report-brand: >- https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/thumbs/teal.png + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor coverage: name: Coverage πŸ“” needs: [release, docs] uses: insightsengineering/r.pkg.template/.github/workflows/test-coverage.yaml@main secrets: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} + with: + additional-env-vars: | + NOT_CRAN=true + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor + wasm: + name: Build WASM packages πŸ§‘β€πŸ­ + needs: release + uses: insightsengineering/r.pkg.template/.github/workflows/wasm.yaml@main diff --git a/.github/workflows/scheduled.yaml b/.github/workflows/scheduled.yaml index f2ddf6862..50cc3e050 100644 --- a/.github/workflows/scheduled.yaml +++ b/.github/workflows/scheduled.yaml @@ -3,11 +3,28 @@ name: Scheduled πŸ•°οΈ on: schedule: - - cron: '45 3 * * 0' + - cron: "45 3 * * 0" workflow_dispatch: + inputs: + chosen-workflow: + description: | + Select which workflow you'd like to run + required: true + type: choice + default: rhub + options: + - rhub + - dependency-test + - branch-cleanup + - revdepcheck jobs: dependency-test: + if: > + github.event_name == 'schedule' || ( + github.event_name == 'workflow_dispatch' && + inputs.chosen-workflow == 'dependency-test' + ) strategy: fail-fast: false matrix: @@ -22,7 +39,60 @@ jobs: additional-env-vars: | PKG_SYSREQS_DRY_RUN=true branch-cleanup: + if: > + github.event_name == 'schedule' || ( + github.event_name == 'workflow_dispatch' && + inputs.chosen-workflow == 'branch-cleanup' + ) name: Branch Cleanup 🧹 uses: insightsengineering/r.pkg.template/.github/workflows/branch-cleanup.yaml@main secrets: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} + revdepcheck: + if: > + github.event_name == 'schedule' || ( + github.event_name == 'workflow_dispatch' && + inputs.chosen-workflow == 'revdepcheck' + ) + name: revdepcheck ↩️ + uses: insightsengineering/r.pkg.template/.github/workflows/revdepcheck.yaml@main + with: + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor + rhub: + if: > + github.event_name == 'schedule' || ( + github.event_name == 'workflow_dispatch' && + inputs.chosen-workflow == 'rhub' + ) + name: R-hub 🌐 + uses: insightsengineering/r.pkg.template/.github/workflows/rhub.yaml@main + with: + lookup-refs: | + insightsengineering/roxy.shinylive + insightsengineering/teal + insightsengineering/teal.transform + insightsengineering/teal.code + insightsengineering/teal.data + insightsengineering/teal.logger + insightsengineering/teal.reporter + insightsengineering/teal.widgets + insightsengineering/teal.slice + insightsengineering/tern + insightsengineering/formatters + insightsengineering/rtables + insightsengineering/rtables.officer + insightsengineering/nestcolor diff --git a/.gitignore b/.gitignore index fb00dbe32..1657ceda4 100644 --- a/.gitignore +++ b/.gitignore @@ -29,3 +29,5 @@ vignettes/*.R coverage.* tests/testthat/_snaps/**/*.new.md tests/testthat/_snaps/**/*.new.svg +/doc/ +/Meta/ diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 347dffa0a..b154dbae6 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,12 +1,12 @@ --- # All available hooks: https://pre-commit.com/hooks.html # R specific hooks: https://github.com/lorenzwalthert/precommit -default_stages: [commit] +default_stages: [pre-commit] default_language_version: python: python3 repos: - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.3 + rev: v0.4.3.9003 hooks: - id: style-files name: Style code with `styler` @@ -18,8 +18,6 @@ repos: - ggmosaic - ggplot2 - shiny - - teal - - teal.transform - checkmate - dplyr - DT @@ -33,6 +31,9 @@ repos: - shinyWidgets - stats - stringr + - insightsengineering/roxy.shinylive + - insightsengineering/teal + - insightsengineering/teal.transform - insightsengineering/teal.code - insightsengineering/teal.data - insightsengineering/teal.logger diff --git a/DESCRIPTION b/DESCRIPTION index d66519916..91e8ec951 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal.modules.general Title: General Modules for 'teal' Applications -Version: 0.3.0.9040 -Date: 2024-08-14 +Version: 0.3.0.9061 +Date: 2024-12-17 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre")), person("Pawel", "Rucki", , "pawel.rucki@roche.com", role = "aut"), @@ -27,8 +27,8 @@ Depends: ggplot2 (>= 3.4.0), R (>= 3.6), shiny (>= 1.6.0), - teal (>= 0.15.2.9052), - teal.transform (>= 0.5.0) + teal (>= 0.15.2.9091), + teal.transform (>= 0.5.0.9015) Imports: checkmate (>= 2.1.0), colourpicker, @@ -48,6 +48,7 @@ Imports: lattice (>= 0.18-4), MASS, rtables (>= 0.6.8), + lifecycle (>= 0.2.0), scales, shinyjs, shinyTree (>= 0.2.8), @@ -56,8 +57,8 @@ Imports: sparkline, stats, stringr (>= 1.4.1), - teal.code (>= 0.5.0), - teal.data (>= 0.5.0), + teal.code (>= 0.5.0.9012), + teal.data (>= 0.6.0.9015), teal.logger (>= 0.2.0.9004), teal.reporter (>= 0.3.0), teal.widgets (>= 0.4.0), @@ -73,12 +74,14 @@ Suggests: pkgload, rlang (>= 1.0.0), rmarkdown (>= 2.23), + roxy.shinylive, rvest, shinytest2, testthat (>= 3.1.9), withr (>= 2.0.0) VignetteBuilder: - knitr + knitr, + rmarkdown Config/Needs/verdepcheck: haleyjeppson/ggmosaic, tidyverse/ggplot2, rstudio/shiny, insightsengineering/teal, insightsengineering/teal.transform, mllg/checkmate, tidyverse/dplyr, @@ -98,5 +101,5 @@ Config/Needs/website: insightsengineering/nesttemplate Encoding: UTF-8 Language: en-US LazyData: true -Roxygen: list(markdown = TRUE) +Roxygen: list(markdown = TRUE, packages = c("roxy.shinylive")) RoxygenNote: 7.3.2 diff --git a/NEWS.md b/NEWS.md index d5620160f..ec7949c1b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal.modules.general 0.3.0.9040 +# teal.modules.general 0.3.0.9061 * Removed `Show Warnings` modals from modules. diff --git a/R/data.R b/R/data.R deleted file mode 100644 index 0f8a64e04..000000000 --- a/R/data.R +++ /dev/null @@ -1,39 +0,0 @@ -#' Random adverse events -#' @docType data -#' @usage rADAE -#' @keywords datasets internal -#' @source internal -#' @name rADAE -"rADAE" - -#' Random lab analysis -#' @docType data -#' @usage rADLB -#' @keywords datasets internal -#' @source internal -#' @name rADLB -"rADLB" - -#' Random response -#' @docType data -#' @usage rADRS -#' @keywords datasets internal -#' @source internal -#' @name rADRS -"rADRS" - -#' Random patient listing -#' @docType data -#' @usage rADSL -#' @keywords datasets internal -#' @source internal -#' @name rADSL -"rADSL" - -#' Random time to event analysis dataset -#' @docType data -#' @usage rADTTE -#' @keywords datasets internal -#' @source internal -#' @name rADTTE -"rADTTE" diff --git a/R/roxygen2_templates.R b/R/roxygen2_templates.R new file mode 100644 index 000000000..d55c2aef4 --- /dev/null +++ b/R/roxygen2_templates.R @@ -0,0 +1,30 @@ +# nocov start +roxygen_decorators_param <- function(module_name) { + paste( + sep = " ", + lifecycle::badge("experimental"), + " (`list` of `teal_transform_module`, named `list` of `teal_transform_module` or", + "`NULL`) optional, if not `NULL`, decorator for tables or plots included in the module.", + "When a named list of `teal_transform_module`, the decorators are applied to the", + "respective output objects.\n\n", + "Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`.\n\n", + sprintf("See section \"Decorating `%s`\"", module_name), + "below for more details." + ) +} + +roxygen_ggplot2_args_param <- function(...) { + paste( + sep = " ", + "(`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.\n\n", + sprintf( + "List names should match the following: `c(\"default\", %s)`.\n\n", + paste("\"", unlist(rlang::list2(...)), "\"", collapse = ", ", sep = "") + ), + "For more details see the vignette: `vignette(\"custom-ggplot2-arguments\", package = \"teal.widgets\")`." + ) +} + +# nocov end diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index b2c0a1a2e..0398ac555 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -13,13 +13,45 @@ #' 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 +#' @param ggplot2_args `r roxygen_ggplot2_args_param("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")` +#' @param decorators `r roxygen_decorators_param("tm_a_pca")` #' #' @inherit shared_params return #' +#' @section Decorating `tm_a_pca`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `elbow_plot` (`ggplot2`) +#' - `circle_plot` (`ggplot2`) +#' - `biplot` (`ggplot2`) +#' - `eigenvector_plot` (`ggplot2`) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_a_pca( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' elbow_plot = list(teal_transform_module(...)), # applied only to `elbow_plot` output +#' circle_plot = list(teal_transform_module(...)) # applied only to `circle_plot` output +#' biplot = list(teal_transform_module(...)) # applied only to `biplot` output +#' eigenvector_plot = list(teal_transform_module(...)) # applied only to `eigenvector_plot` output +#' ) +#' ) +#' ``` +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} #' @examples -#' library(teal.widgets) #' #' # general data example #' data <- teal_data() @@ -28,8 +60,6 @@ #' USArrests <- USArrests #' }) #' -#' datanames(data) <- "USArrests" -#' #' app <- init( #' data = data, #' modules = modules( @@ -45,9 +75,6 @@ #' multiple = TRUE #' ), #' filter = NULL -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by PCA Module") #' ) #' ) #' ) @@ -56,14 +83,19 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples +#' #' # CDISC data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- "ADSL" -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -80,9 +112,6 @@ #' multiple = TRUE #' ), #' filter = NULL -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by PCA Module") #' ) #' ) #' ) @@ -104,7 +133,8 @@ tm_a_pca <- function(label = "Principal Component Analysis", alpha = c(1, 0, 1), size = c(2, 1, 8), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_a_pca") # Normalize the parameters @@ -154,6 +184,10 @@ tm_a_pca <- function(label = "Principal Component 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) + + available_decorators <- c("elbow_plot", "circle_plot", "biplot", "eigenvector_plot") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, available_decorators) # End of assertions # Make UI args @@ -171,7 +205,8 @@ tm_a_pca <- function(label = "Principal Component Analysis", list( plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -226,6 +261,34 @@ ui_a_pca <- function(id, ...) { label = "Plot type", choices = args$plot_choices, selected = args$plot_choices[1] + ), + conditionalPanel( + condition = sprintf("input['%s'] == 'Elbow plot'", ns("plot_type")), + ui_decorate_teal_data( + ns("d_elbow_plot"), + decorators = select_decorators(args$decorators, "elbow_plot") + ) + ), + conditionalPanel( + condition = sprintf("input['%s'] == 'Circle plot'", ns("plot_type")), + ui_decorate_teal_data( + ns("d_circle_plot"), + decorators = select_decorators(args$decorators, "circle_plot") + ) + ), + conditionalPanel( + condition = sprintf("input['%s'] == 'Biplot'", ns("plot_type")), + ui_decorate_teal_data( + ns("d_biplot"), + decorators = select_decorators(args$decorators, "biplot") + ) + ), + conditionalPanel( + condition = sprintf("input['%s'] == 'Eigenvector plot'", ns("plot_type")), + ui_decorate_teal_data( + ns("d_eigenvector_plot"), + decorators = select_decorators(args$decorators, "eigenvector_plot") + ) ) ), teal.widgets::panel_item( @@ -291,7 +354,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) { +srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args, decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -551,7 +614,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) cols <- c(getOption("ggplot2.discrete.colour"), c("lightblue", "darkred", "black"))[1:3] - g <- ggplot(mapping = aes_string(x = "component", y = "value")) + + elbow_plot <- ggplot(mapping = aes_string(x = "component", y = "value")) + geom_bar( aes(fill = "Single variance"), data = dplyr::filter(elb_dat, metric == "Proportion of Variance"), @@ -571,8 +634,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl scale_fill_manual(values = c("Cumulative variance" = cols[2], "Single variance" = cols[1])) + ggthemes + themes - - print(g) }, env = list( ggthemes = parsed_ggplot2_args$ggtheme, @@ -630,7 +691,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl y = sin(seq(0, 2 * pi, length.out = 100)) ) - g <- ggplot(pca_rot) + + circle_plot <- ggplot(pca_rot) + geom_point(aes_string(x = x_axis, y = y_axis)) + geom_label( aes_string(x = x_axis, y = y_axis, label = "label"), @@ -642,7 +703,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl labs + ggthemes + themes - print(g) }, env = list( x_axis = x_axis, @@ -863,8 +923,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl qenv, substitute( expr = { - g <- plot_call - print(g) + biplot <- plot_call }, env = list( plot_call = Reduce(function(x, y) call("+", x, y), pca_plot_biplot_expr) @@ -873,8 +932,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) } - # plot pc_var ---- - plot_pc_var <- function(base_q) { + # plot eigenvector_plot ---- + plot_eigenvector <- function(base_q) { pc <- input$pc ggtheme <- input$ggtheme @@ -940,10 +999,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl expr = { pca_rot <- pca$rotation[, pc, drop = FALSE] %>% dplyr::as_tibble(rownames = "Variable") - - g <- plot_call - - print(g) + eigenvector_plot <- plot_call }, env = list( pc = pc, @@ -953,23 +1009,54 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) } - # plot final ---- - output_q <- reactive({ - req(computation()) - teal::validate_inputs(iv_r()) - teal::validate_inputs(iv_extra, header = "Plot settings are required") + # qenvs --- + output_q <- lapply( + list( + elbow_plot = plot_elbow, + circle_plot = plot_circle, + biplot = plot_biplot, + eigenvector_plot = plot_eigenvector + ), + function(fun) { + reactive({ + req(computation()) + teal::validate_inputs(iv_r()) + teal::validate_inputs(iv_extra, header = "Plot settings are required") + fun(computation()) + }) + } + ) - switch(input$plot_type, - "Elbow plot" = plot_elbow(computation()), - "Circle plot" = plot_circle(computation()), - "Biplot" = plot_biplot(computation()), - "Eigenvector plot" = plot_pc_var(computation()), + decorated_q <- mapply( + function(obj_name, q) { + srv_decorate_teal_data( + id = sprintf("d_%s", obj_name), + data = q, + decorators = select_decorators(decorators, obj_name), + expr = reactive({ + substitute(print(.plot), env = list(.plot = as.name(obj_name))) + }), + expr_is_reactive = TRUE + ) + }, + names(output_q), + output_q + ) + + # plot final ---- + decorated_output_q <- reactive({ + switch(req(input$plot_type), + "Elbow plot" = decorated_q$elbow_plot(), + "Circle plot" = decorated_q$circle_plot(), + "Biplot" = decorated_q$biplot(), + "Eigenvector plot" = decorated_q$eigenvector_plot(), stop("Unknown plot") ) }) plot_r <- reactive({ - output_q()[["g"]] + plot_name <- gsub(" ", "_", tolower(req(input$plot_type))) + req(decorated_output_q())[[plot_name]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -1036,7 +1123,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), title = "R Code for PCA" ) @@ -1059,7 +1146,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index a941e5e20..e5d76d95c 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -37,21 +37,33 @@ #' It takes the form of `c(value, min, max)` and it is passed to the `value_min_max` #' argument in `teal.widgets::optionalSliderInputValMinMax`. #' -#' @templateVar ggnames `r regression_names` -#' @template ggplot2_args_multi +# nolint start: line_length. +#' @param ggplot2_args `r roxygen_ggplot2_args_param("Response vs Regressor", "Residuals vs Fitted", "Scale-Location", "Cook's distance", "Residuals vs Leverage", "Cook's dist vs Leverage")` +# nolint end: line_length. +#' @param decorators `r roxygen_decorators_param("tm_a_regression")` #' #' @inherit shared_params return #' +#' @section Decorating `tm_a_regression`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} #' @examples -#' # general data example -#' library(teal.widgets) #' +#' # general data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) #' CO2 <- CO2 #' }) -#' datanames(data) <- c("CO2") #' #' app <- init( #' data = data, @@ -77,9 +89,6 @@ #' multiple = TRUE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Regression Module") #' ) #' ) #' ) @@ -88,16 +97,18 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- "ADSL" -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -123,9 +134,6 @@ #' multiple = TRUE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Regression Module") #' ) #' ) #' ) @@ -149,7 +157,8 @@ tm_a_regression <- function(label = "Regression Analysis", post_output = NULL, default_plot_type = 1, default_outlier_label = "USUBJID", - label_segment_threshold = c(0.5, 0, 10)) { + label_segment_threshold = c(0.5, 0, 10), + decorators = NULL) { message("Initializing tm_a_regression") # Normalize the parameters @@ -203,6 +212,7 @@ tm_a_regression <- function(label = "Regression Analysis", checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_choice(default_plot_type, seq.int(1L, length(plot_choices))) checkmate::assert_string(default_outlier_label) + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) if (length(label_segment_threshold) == 1) { checkmate::assert_numeric(label_segment_threshold, any.missing = FALSE, finite = TRUE) @@ -215,6 +225,8 @@ tm_a_regression <- function(label = "Regression Analysis", .var.name = "label_segment_threshold" ) } + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) # End of assertions # Make UI args @@ -236,7 +248,8 @@ tm_a_regression <- function(label = "Regression Analysis", plot_height = plot_height, plot_width = plot_width, default_outlier_label = default_outlier_label, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -250,7 +263,6 @@ ui_a_regression <- function(id, ...) { ns <- NS(id) args <- list(...) is_single_dataset_value <- teal.transform::is_single_dataset(args$regressor, args$response) - teal.widgets::standard_layout( output = teal.widgets::white_small_well(tags$div( teal.widgets::plot_with_settings_ui(id = ns("myplot")), @@ -309,6 +321,7 @@ ui_a_regression <- function(id, ...) { label = "Outlier label" ) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( title = "Plot settings", @@ -365,7 +378,8 @@ srv_a_regression <- function(id, plot_height, plot_width, ggplot2_args, - default_outlier_label) { + default_outlier_label, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -540,450 +554,441 @@ srv_a_regression <- function(id, ) }) - output_q <- reactive({ - alpha <- input$alpha - size <- input$size - ggtheme <- input$ggtheme - input_type <- input$plot_type - show_outlier <- input$show_outlier - - teal::validate_inputs(iv_r()) - - plot_type_0 <- function() { - fit <- fit_r()[["fit"]] - ANL <- anl_merged_q()[["ANL"]] + output_plot_base <- reactive({ + base_fit <- fit_r() + teal.code::eval_code( + base_fit, + quote({ + class(fit$residuals) <- NULL - stopifnot(ncol(fit$model) == 2) + data <- ggplot2::fortify(fit) - if (!is.factor(ANL[[regression_var()$regressor]])) { - shinyjs::show("size") - shinyjs::show("alpha") - plot <- substitute( - env = list( - regressor = regression_var()$regressor, - response = regression_var()$response, - size = size, - alpha = alpha - ), - expr = ggplot( - fit$model[, 2:1], - aes_string(regressor, response) - ) + - geom_point(size = size, alpha = alpha) + - stat_smooth( - method = "lm", - formula = y ~ x, - se = FALSE - ) - ) - if (show_outlier) { - plot <- substitute( - expr = plot + outlier_label, - env = list(plot = plot, outlier_label = outlier_label()) - ) - } - } else { - shinyjs::hide("size") - shinyjs::hide("alpha") - plot <- substitute( - expr = ggplot(fit$model[, 2:1], aes_string(regressor, response)) + - geom_boxplot(), - env = list(regressor = regression_var()$regressor, response = regression_var()$response) - ) - if (show_outlier) { - plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) + smooth <- function(x, y) { + as.data.frame(stats::lowess(x, y, f = 2 / 3, iter = 3)) } - } - - parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( - teal.widgets::resolve_ggplot2_args( - user_plot = ggplot2_args[["Response vs Regressor"]], - user_default = ggplot2_args$default, - module_plot = teal.widgets::ggplot2_args( - labs = list( - title = "Response vs Regressor", - x = varname_w_label(regression_var()$regressor, ANL), - y = varname_w_label(regression_var()$response, ANL) - ), - theme = list() - ) - ), - ggtheme = ggtheme - ) - - teal.code::eval_code( - fit_r(), - substitute( - expr = { - class(fit$residuals) <- NULL - data <- fortify(fit) - g <- plot - print(g) - }, - env = list( - plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) - ) - ) - ) - } - - plot_base <- function() { - base_fit <- fit_r() - teal.code::eval_code( - base_fit, - quote({ - class(fit$residuals) <- NULL - data <- ggplot2::fortify(fit) + smoothy_aes <- ggplot2::aes_string(x = "x", y = "y") - smooth <- function(x, y) { - as.data.frame(stats::lowess(x, y, f = 2 / 3, iter = 3)) - } + reg_form <- deparse(fit$call[[2]]) + }) + ) + }) - smoothy_aes <- ggplot2::aes_string(x = "x", y = "y") + output_plot_0 <- reactive({ + fit <- fit_r()[["fit"]] + ANL <- anl_merged_q()[["ANL"]] - reg_form <- deparse(fit$call[[2]]) - }) - ) - } + stopifnot(ncol(fit$model) == 2) - plot_type_1 <- function(plot_base) { + if (!is.factor(ANL[[regression_var()$regressor]])) { shinyjs::show("size") shinyjs::show("alpha") plot <- substitute( - expr = ggplot(data = data, aes(.fitted, .resid)) + + expr = ggplot(fit$model[, 2:1], aes_string(regressor, response)) + geom_point(size = size, alpha = alpha) + - geom_hline(yintercept = 0, linetype = "dashed", size = 1) + - geom_line(data = smoothy, mapping = smoothy_aes), - env = list(size = size, alpha = alpha) + stat_smooth(method = "lm", formula = y ~ x, se = FALSE), + env = list( + regressor = regression_var()$regressor, + response = regression_var()$response, + size = input$size, + alpha = input$alpha + ) + ) + if (input$show_outlier) { + plot <- substitute( + expr = plot + outlier_label, + env = list(plot = plot, outlier_label = outlier_label()) + ) + } + } else { + shinyjs::hide("size") + shinyjs::hide("alpha") + plot <- substitute( + expr = ggplot(fit$model[, 2:1], aes_string(regressor, response)) + + geom_boxplot(), + env = list(regressor = regression_var()$regressor, response = regression_var()$response) ) - if (show_outlier) { + if (input$show_outlier) { plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) } + } - parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( - teal.widgets::resolve_ggplot2_args( - user_plot = ggplot2_args[["Residuals vs Fitted"]], - user_default = ggplot2_args$default, - module_plot = teal.widgets::ggplot2_args( - labs = list( - x = quote(paste0("Fitted values\nlm(", reg_form, ")")), - y = "Residuals", - title = "Residuals vs Fitted" - ) - ) - ), - ggtheme = ggtheme - ) + parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( + teal.widgets::resolve_ggplot2_args( + user_plot = ggplot2_args[["Response vs Regressor"]], + user_default = ggplot2_args$default, + module_plot = teal.widgets::ggplot2_args( + labs = list( + title = "Response vs Regressor", + x = varname_w_label(regression_var()$regressor, ANL), + y = varname_w_label(regression_var()$response, ANL) + ), + theme = list() + ) + ), + ggtheme = input$ggtheme + ) - teal.code::eval_code( - plot_base, - substitute( - expr = { - smoothy <- smooth(data$.fitted, data$.resid) - g <- plot - print(g) - }, - env = list( - plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) - ) + teal.code::eval_code( + fit_r(), + substitute( + expr = { + class(fit$residuals) <- NULL + data <- fortify(fit) + plot <- graph + }, + env = list( + graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) ) - } + ) + }) - plot_type_2 <- function(plot_base) { - shinyjs::show("size") - shinyjs::show("alpha") - plot <- substitute( - expr = ggplot(data = data, aes(sample = .stdresid)) + - stat_qq(size = size, alpha = alpha) + - geom_abline(linetype = "dashed"), - env = list(size = size, alpha = alpha) - ) - if (show_outlier) { - plot <- substitute( - expr = plot + - stat_qq( - geom = ggrepel::GeomTextRepel, - label = label_col %>% - data.frame(label = .) %>% - dplyr::filter(label != "cooksd == NaN") %>% - unlist(), - color = "red", - hjust = 0, - vjust = 0, - max.overlaps = Inf, - min.segment.length = label_min_segment, - segment.alpha = .5, - seed = 123 - ), - env = list(plot = plot, label_col = label_col(), label_min_segment = label_min_segment()) - ) - } + output_plot_1 <- reactive({ + plot_base <- output_plot_base() + shinyjs::show("size") + shinyjs::show("alpha") + plot <- substitute( + expr = ggplot(data = data, aes(.fitted, .resid)) + + geom_point(size = size, alpha = alpha) + + geom_hline(yintercept = 0, linetype = "dashed", size = 1) + + geom_line(data = smoothy, mapping = smoothy_aes), + env = list(size = input$size, alpha = input$alpha) + ) + if (input$show_outlier) { + plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) + } - parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( - teal.widgets::resolve_ggplot2_args( - user_plot = ggplot2_args[["Normal Q-Q"]], - user_default = ggplot2_args$default, - module_plot = teal.widgets::ggplot2_args( - labs = list( - x = quote(paste0("Theoretical Quantiles\nlm(", reg_form, ")")), - y = "Standardized residuals", - title = "Normal Q-Q" - ) + parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( + teal.widgets::resolve_ggplot2_args( + user_plot = ggplot2_args[["Residuals vs Fitted"]], + user_default = ggplot2_args$default, + module_plot = teal.widgets::ggplot2_args( + labs = list( + x = quote(paste0("Fitted values\nlm(", reg_form, ")")), + y = "Residuals", + title = "Residuals vs Fitted" ) - ), - ggtheme = ggtheme - ) + ) + ), + ggtheme = input$ggtheme + ) - teal.code::eval_code( - plot_base, - substitute( - expr = { - g <- plot - print(g) - }, - env = list( - plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) - ) + teal.code::eval_code( + plot_base, + substitute( + expr = { + smoothy <- smooth(data$.fitted, data$.resid) + plot <- graph + }, + env = list( + graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) ) - } + ) + }) - plot_type_3 <- function(plot_base) { - shinyjs::show("size") - shinyjs::show("alpha") + output_plot_2 <- reactive({ + shinyjs::show("size") + shinyjs::show("alpha") + plot_base <- output_plot_base() + plot <- substitute( + expr = ggplot(data = data, aes(sample = .stdresid)) + + stat_qq(size = size, alpha = alpha) + + geom_abline(linetype = "dashed"), + env = list(size = input$size, alpha = input$alpha) + ) + if (input$show_outlier) { plot <- substitute( - expr = ggplot(data = data, aes(.fitted, sqrt(abs(.stdresid)))) + - geom_point(size = size, alpha = alpha) + - geom_line(data = smoothy, mapping = smoothy_aes), - env = list(size = size, alpha = alpha) + expr = plot + + stat_qq( + geom = ggrepel::GeomTextRepel, + label = label_col %>% + data.frame(label = .) %>% + dplyr::filter(label != "cooksd == NaN") %>% + unlist(), + color = "red", + hjust = 0, + vjust = 0, + max.overlaps = Inf, + min.segment.length = label_min_segment, + segment.alpha = .5, + seed = 123 + ), + env = list(plot = plot, label_col = label_col(), label_min_segment = label_min_segment()) ) - if (show_outlier) { - plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) - } + } - parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( - teal.widgets::resolve_ggplot2_args( - user_plot = ggplot2_args[["Scale-Location"]], - user_default = ggplot2_args$default, - module_plot = teal.widgets::ggplot2_args( - labs = list( - x = quote(paste0("Fitted values\nlm(", reg_form, ")")), - y = quote(expression(sqrt(abs(`Standardized residuals`)))), - title = "Scale-Location" - ) + parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( + teal.widgets::resolve_ggplot2_args( + user_plot = ggplot2_args[["Normal Q-Q"]], + user_default = ggplot2_args$default, + module_plot = teal.widgets::ggplot2_args( + labs = list( + x = quote(paste0("Theoretical Quantiles\nlm(", reg_form, ")")), + y = "Standardized residuals", + title = "Normal Q-Q" ) - ), - ggtheme = ggtheme - ) + ) + ), + ggtheme = input$ggtheme + ) - teal.code::eval_code( - plot_base, - substitute( - expr = { - smoothy <- smooth(data$.fitted, sqrt(abs(data$.stdresid))) - g <- plot - print(g) - }, - env = list( - plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) - ) + teal.code::eval_code( + plot_base, + substitute( + expr = { + plot <- graph + }, + env = list( + graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) ) - } + ) + }) - plot_type_4 <- function(plot_base) { - shinyjs::hide("size") - shinyjs::show("alpha") - plot <- substitute( - expr = ggplot(data = data, aes(seq_along(.cooksd), .cooksd)) + - geom_col(alpha = alpha), - env = list(alpha = alpha) - ) - if (show_outlier) { - plot <- substitute( - expr = plot + - geom_hline( - yintercept = c( - outlier * mean(data$.cooksd, na.rm = TRUE), - mean(data$.cooksd, na.rm = TRUE) - ), - color = "red", - linetype = "dashed" - ) + - geom_text( - aes( - x = 0, - y = mean(data$.cooksd, na.rm = TRUE), - label = paste("mu", "=", round(mean(data$.cooksd, na.rm = TRUE), 4)), - vjust = -1, - hjust = 0, - color = "red", - angle = 90 - ), - parse = TRUE, - show.legend = FALSE - ) + - outlier_label, - env = list(plot = plot, outlier = input$outlier, outlier_label = outlier_label()) - ) - } + output_plot_3 <- reactive({ + shinyjs::show("size") + shinyjs::show("alpha") + plot_base <- output_plot_base() + plot <- substitute( + expr = ggplot(data = data, aes(.fitted, sqrt(abs(.stdresid)))) + + geom_point(size = size, alpha = alpha) + + geom_line(data = smoothy, mapping = smoothy_aes), + env = list(size = input$size, alpha = input$alpha) + ) + if (input$show_outlier) { + plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) + } - parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( - teal.widgets::resolve_ggplot2_args( - user_plot = ggplot2_args[["Cook's distance"]], - user_default = ggplot2_args$default, - module_plot = teal.widgets::ggplot2_args( - labs = list( - x = quote(paste0("Obs. number\nlm(", reg_form, ")")), - y = "Cook's distance", - title = "Cook's distance" - ) + parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( + teal.widgets::resolve_ggplot2_args( + user_plot = ggplot2_args[["Scale-Location"]], + user_default = ggplot2_args$default, + module_plot = teal.widgets::ggplot2_args( + labs = list( + x = quote(paste0("Fitted values\nlm(", reg_form, ")")), + y = quote(expression(sqrt(abs(`Standardized residuals`)))), + title = "Scale-Location" ) - ), - ggtheme = ggtheme - ) + ) + ), + ggtheme = input$ggtheme + ) - teal.code::eval_code( - plot_base, - substitute( - expr = { - g <- plot - print(g) - }, - env = list( - plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) - ) + teal.code::eval_code( + plot_base, + substitute( + expr = { + smoothy <- smooth(data$.fitted, sqrt(abs(data$.stdresid))) + plot <- graph + }, + env = list( + graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) ) - } - + ) + }) - plot_type_5 <- function(plot_base) { - shinyjs::show("size") - shinyjs::show("alpha") + output_plot_4 <- reactive({ + shinyjs::hide("size") + shinyjs::show("alpha") + plot_base <- output_plot_base() + plot <- substitute( + expr = ggplot(data = data, aes(seq_along(.cooksd), .cooksd)) + + geom_col(alpha = alpha), + env = list(alpha = input$alpha) + ) + if (input$show_outlier) { plot <- substitute( - expr = ggplot(data = data, aes(.hat, .stdresid)) + - geom_vline( - size = 1, - colour = "black", - linetype = "dashed", - xintercept = 0 - ) + + expr = plot + geom_hline( - size = 1, - colour = "black", - linetype = "dashed", - yintercept = 0 + yintercept = c( + outlier * mean(data$.cooksd, na.rm = TRUE), + mean(data$.cooksd, na.rm = TRUE) + ), + color = "red", + linetype = "dashed" ) + - geom_point(size = size, alpha = alpha) + - geom_line(data = smoothy, mapping = smoothy_aes), - env = list(size = size, alpha = alpha) + geom_text( + aes( + x = 0, + y = mean(data$.cooksd, na.rm = TRUE), + label = paste("mu", "=", round(mean(data$.cooksd, na.rm = TRUE), 4)), + vjust = -1, + hjust = 0, + color = "red", + angle = 90 + ), + parse = TRUE, + show.legend = FALSE + ) + + outlier_label, + env = list(plot = plot, outlier = input$outlier, outlier_label = outlier_label()) ) - if (show_outlier) { - plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) - } + } - parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( - teal.widgets::resolve_ggplot2_args( - user_plot = ggplot2_args[["Residuals vs Leverage"]], - user_default = ggplot2_args$default, - module_plot = teal.widgets::ggplot2_args( - labs = list( - x = quote(paste0("Standardized residuals\nlm(", reg_form, ")")), - y = "Leverage", - title = "Residuals vs Leverage" - ) + parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( + teal.widgets::resolve_ggplot2_args( + user_plot = ggplot2_args[["Cook's distance"]], + user_default = ggplot2_args$default, + module_plot = teal.widgets::ggplot2_args( + labs = list( + x = quote(paste0("Obs. number\nlm(", reg_form, ")")), + y = "Cook's distance", + title = "Cook's distance" ) - ), - ggtheme = ggtheme - ) + ) + ), + ggtheme = input$ggtheme + ) - teal.code::eval_code( - plot_base, - substitute( - expr = { - smoothy <- smooth(data$.hat, data$.stdresid) - g <- plot - print(g) - }, - env = list( - plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) - ) + teal.code::eval_code( + plot_base, + substitute( + expr = { + plot <- graph + }, + env = list( + graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) ) - } + ) + }) - plot_type_6 <- function(plot_base) { - shinyjs::show("size") - shinyjs::show("alpha") - plot <- substitute( - expr = ggplot(data = data, aes(.hat, .cooksd)) + - geom_vline(xintercept = 0, colour = NA) + - geom_abline( - slope = seq(0, 3, by = 0.5), - colour = "black", - linetype = "dashed", - size = 1 - ) + - geom_line(data = smoothy, mapping = smoothy_aes) + - geom_point(size = size, alpha = alpha), - env = list(size = size, alpha = alpha) - ) - if (show_outlier) { - plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) - } + output_plot_5 <- reactive({ + shinyjs::show("size") + shinyjs::show("alpha") + plot_base <- output_plot_base() + plot <- substitute( + expr = ggplot(data = data, aes(.hat, .stdresid)) + + geom_vline( + size = 1, + colour = "black", + linetype = "dashed", + xintercept = 0 + ) + + geom_hline( + size = 1, + colour = "black", + linetype = "dashed", + yintercept = 0 + ) + + geom_point(size = size, alpha = alpha) + + geom_line(data = smoothy, mapping = smoothy_aes), + env = list(size = input$size, alpha = input$alpha) + ) + if (input$show_outlier) { + plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) + } - parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( - teal.widgets::resolve_ggplot2_args( - user_plot = ggplot2_args[["Cook's dist vs Leverage"]], - user_default = ggplot2_args$default, - module_plot = teal.widgets::ggplot2_args( - labs = list( - x = quote(paste0("Leverage\nlm(", reg_form, ")")), - y = "Cooks's distance", - title = "Cook's dist vs Leverage" - ) + parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( + teal.widgets::resolve_ggplot2_args( + user_plot = ggplot2_args[["Residuals vs Leverage"]], + user_default = ggplot2_args$default, + module_plot = teal.widgets::ggplot2_args( + labs = list( + x = quote(paste0("Standardized residuals\nlm(", reg_form, ")")), + y = "Leverage", + title = "Residuals vs Leverage" ) - ), - ggtheme = ggtheme - ) + ) + ), + ggtheme = input$ggtheme + ) - teal.code::eval_code( - plot_base, - substitute( - expr = { - smoothy <- smooth(data$.hat, data$.cooksd) - g <- plot - print(g) - }, - env = list( - plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) - ) + teal.code::eval_code( + plot_base, + substitute( + expr = { + smoothy <- smooth(data$.hat, data$.stdresid) + plot <- graph + }, + env = list( + graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) ) + ) + }) + + output_plot_6 <- reactive({ + shinyjs::show("size") + shinyjs::show("alpha") + plot_base <- output_plot_base() + plot <- substitute( + expr = ggplot(data = data, aes(.hat, .cooksd)) + + geom_vline(xintercept = 0, colour = NA) + + geom_abline( + slope = seq(0, 3, by = 0.5), + colour = "black", + linetype = "dashed", + size = 1 + ) + + geom_line(data = smoothy, mapping = smoothy_aes) + + geom_point(size = size, alpha = alpha), + env = list(size = input$size, alpha = input$alpha) + ) + if (input$show_outlier) { + plot <- substitute(expr = plot + outlier_label, env = list(plot = plot, outlier_label = outlier_label())) } - qenv <- if (input_type == "Response vs Regressor") { - plot_type_0() - } else { - plot_base_q <- plot_base() - switch(input_type, - "Residuals vs Fitted" = plot_base_q %>% plot_type_1(), - "Normal Q-Q" = plot_base_q %>% plot_type_2(), - "Scale-Location" = plot_base_q %>% plot_type_3(), - "Cook's distance" = plot_base_q %>% plot_type_4(), - "Residuals vs Leverage" = plot_base_q %>% plot_type_5(), - "Cook's dist vs Leverage" = plot_base_q %>% plot_type_6() + parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args( + teal.widgets::resolve_ggplot2_args( + user_plot = ggplot2_args[["Cook's dist vs Leverage"]], + user_default = ggplot2_args$default, + module_plot = teal.widgets::ggplot2_args( + labs = list( + x = quote(paste0("Leverage\nlm(", reg_form, ")")), + y = "Cooks's distance", + title = "Cook's dist vs Leverage" + ) + ) + ), + ggtheme = input$ggtheme + ) + + teal.code::eval_code( + plot_base, + substitute( + expr = { + smoothy <- smooth(data$.hat, data$.cooksd) + plot <- graph + }, + env = list( + graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) + ) ) - } - qenv + ) + }) + + output_q <- reactive({ + teal::validate_inputs(iv_r()) + switch(input$plot_type, + "Response vs Regressor" = output_plot_0(), + "Residuals vs Fitted" = output_plot_1(), + "Normal Q-Q" = output_plot_2(), + "Scale-Location" = output_plot_3(), + "Cook's distance" = output_plot_4(), + "Residuals vs Leverage" = output_plot_5(), + "Cook's dist vs Leverage" = output_plot_6() + ) }) + decorated_output_q <- srv_decorate_teal_data( + "decorator", + data = output_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) - fitted <- reactive(output_q()[["fit"]]) - plot_r <- reactive(output_q()[["g"]]) + fitted <- reactive({ + req(output_q()) + decorated_output_q()[["fit"]] + }) + plot_r <- reactive({ + req(output_q()) + decorated_output_q()[["plot"]] + }) # Insert the plot into a plot_with_settings module from teal.widgets pws <- teal.widgets::plot_with_settings_srv( @@ -1003,7 +1008,7 @@ srv_a_regression <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), title = "R code for the regression plot", ) @@ -1022,7 +1027,7 @@ srv_a_regression <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) @@ -1030,8 +1035,3 @@ srv_a_regression <- function(id, ### }) } - -regression_names <- paste0( - '"Response vs Regressor", "Residuals vs Fitted", ', - '"Scale-Location", "Cook\'s distance", "Residuals vs Leverage"", "Cook\'s dist vs Leverage"' -) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 2d215f8c9..0f1e6a9a8 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -26,9 +26,22 @@ #' `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()]) +#' @param decorators `r roxygen_decorators_param("tm_data_table")` #' #' @inherit shared_params return #' +#' @section Decorating `tm_data_table`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` ([DT::datatable()]) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} #' @examples #' # general data example #' data <- teal_data() @@ -36,7 +49,6 @@ #' require(nestcolor) #' iris <- iris #' }) -#' datanames(data) <- c("iris") #' #' app <- init( #' data = data, @@ -53,14 +65,18 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples #' # CDISC data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- "ADSL" -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -89,7 +105,8 @@ tm_data_table <- function(label = "Data Table", ), server_rendering = FALSE, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_data_table") # Start of assertions @@ -114,6 +131,9 @@ tm_data_table <- function(label = "Data Table", 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) + + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") # End of assertions ans <- module( @@ -126,7 +146,8 @@ tm_data_table <- function(label = "Data Table", datasets_selected = datasets_selected, dt_args = dt_args, dt_options = dt_options, - server_rendering = server_rendering + server_rendering = server_rendering, + decorators = decorators ), ui_args = list( pre_output = pre_output, @@ -138,9 +159,7 @@ tm_data_table <- function(label = "Data Table", } # UI page module -ui_page_data_table <- function(id, - pre_output = NULL, - post_output = NULL) { +ui_page_data_table <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) tagList( @@ -178,7 +197,8 @@ srv_page_data_table <- function(id, variables_selected, dt_args, dt_options, - server_rendering) { + server_rendering, + decorators) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { @@ -187,7 +207,7 @@ srv_page_data_table <- function(id, if_filtered <- reactive(as.logical(input$if_filtered)) if_distinct <- reactive(as.logical(input$if_distinct)) - datanames <- isolate(teal.data::datanames(data())) + datanames <- isolate(names(data())) datanames <- Filter(function(name) { is.data.frame(isolate(data())[[name]]) }, datanames) @@ -231,7 +251,8 @@ srv_page_data_table <- function(id, ui_data_table( id = session$ns(x), choices = choices, - selected = variables_selected + selected = variables_selected, + decorators = decorators ) ) ) @@ -253,7 +274,8 @@ srv_page_data_table <- function(id, if_distinct = if_distinct, dt_args = dt_args, dt_options = dt_options, - server_rendering = server_rendering + server_rendering = server_rendering, + decorators = decorators ) } ) @@ -263,7 +285,8 @@ srv_page_data_table <- function(id, # UI function for the data_table module ui_data_table <- function(id, choices, - selected) { + selected, + decorators) { ns <- NS(id) if (!is.null(selected)) { @@ -275,6 +298,7 @@ ui_data_table <- function(id, tagList( teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")), fluidRow( + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(decorators, "table")), teal.widgets::optionalSelectInput( ns("variables"), "Select variables:", @@ -298,7 +322,8 @@ srv_data_table <- function(id, if_distinct, dt_args, dt_options, - server_rendering) { + server_rendering, + decorators) { moduleServer(id, function(input, output, session) { iv <- shinyvalidate::InputValidator$new() iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names")) @@ -307,27 +332,50 @@ srv_data_table <- function(id, )) iv$enable() - output$data_table <- DT::renderDataTable(server = server_rendering, { - teal::validate_inputs(iv) - + data_table_data <- reactive({ df <- data()[[dataname]] - variables <- input$variables teal::validate_has_data(df, min_nrow = 1L, msg = paste("data", dataname, "is empty")) - dataframe_selected <- if (if_distinct()) { - dplyr::count(df, dplyr::across(dplyr::all_of(variables))) - } else { - df[variables] - } + teal.code::eval_code( + data(), + substitute( + expr = { + variables <- vars + dataframe_selected <- if (if_distinct) { + dplyr::count(dataname, dplyr::across(dplyr::all_of(variables))) + } else { + dataname[variables] + } + dt_args <- args + dt_args$options <- dt_options + if (!is.null(dt_rows)) { + dt_args$options$pageLength <- dt_rows + } + dt_args$data <- dataframe_selected + table <- do.call(DT::datatable, dt_args) + }, + env = list( + dataname = as.name(dataname), + if_distinct = if_distinct(), + vars = input$variables, + args = dt_args, + dt_options = dt_options, + dt_rows = input$dt_rows + ) + ) + ) + }) - dt_args$options <- dt_options - if (!is.null(input$dt_rows)) { - dt_args$options$pageLength <- input$dt_rows - } - dt_args$data <- dataframe_selected + decorated_data_table_data <- srv_decorate_teal_data( + id = "decorator", + data = data_table_data, + decorators = select_decorators(decorators, "table") + ) - do.call(DT::datatable, dt_args) + output$data_table <- DT::renderDataTable(server = server_rendering, { + teal::validate_inputs(iv) + req(decorated_data_table_data())[["table"]] }) }) } diff --git a/R/tm_file_viewer.R b/R/tm_file_viewer.R index 3b96185bb..ee2d50acb 100644 --- a/R/tm_file_viewer.R +++ b/R/tm_file_viewer.R @@ -13,12 +13,15 @@ #' #' @inherit shared_params return #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} #' @examples #' data <- teal_data() #' data <- within(data, { #' data <- data.frame(1) #' }) -#' datanames(data) <- c("data") #' #' app <- init( #' data = data, diff --git a/R/tm_front_page.R b/R/tm_front_page.R index fbffb8769..841b38f86 100644 --- a/R/tm_front_page.R +++ b/R/tm_front_page.R @@ -17,15 +17,18 @@ #' #' @inherit shared_params return #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} #' @examples #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' attr(ADSL, "metadata") <- list("Author" = "NEST team", "data_source" = "synthetic data") #' }) -#' datanames(data) <- "ADSL" -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(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")) @@ -165,7 +168,7 @@ srv_front_page <- function(id, data, tables, show_metadata) { ) metadata_data_frame <- reactive({ - datanames <- teal.data::datanames(data()) + datanames <- names(data()) convert_metadata_to_dataframe( lapply(datanames, function(dataname) attr(data()[[dataname]], "metadata")), datanames diff --git a/R/tm_g_association.R b/R/tm_g_association.R index b0611490c..941448f67 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -20,14 +20,24 @@ #' @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 +#' @param ggplot2_args `r roxygen_ggplot2_args_param("Bivariate1", "Bivariate2")` +#' @param decorators `r roxygen_decorators_param("tm_g_association")` #' #' @inherit shared_params return #' -#' @examples -#' library(teal.widgets) +#' @section Decorating `tm_g_association`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`grob` created with [ggplot2::ggplotGrob()]) #' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples #' # general data example #' data <- teal_data() #' data <- within(data, { @@ -36,7 +46,6 @@ #' factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) #' CO2[factors] <- lapply(CO2[factors], as.character) #' }) -#' datanames(data) <- c("CO2") #' #' app <- init( #' data = data, @@ -60,9 +69,6 @@ #' multiple = TRUE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Association Module") #' ) #' ) #' ) @@ -71,14 +77,18 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples #' # CDISC data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- "ADSL" -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -108,9 +118,6 @@ #' multiple = TRUE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Association Module") #' ) #' ) #' ) @@ -131,7 +138,8 @@ tm_g_association <- function(label = "Association", association_theme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), # nolint: line_length. pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_association") # Normalize the parameters @@ -167,6 +175,9 @@ tm_g_association <- function(label = "Association", plot_choices <- c("Bivariate1", "Bivariate2") checkmate::assert_list(ggplot2_args, types = "ggplot2_args") checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") # End of assertions # Make UI args @@ -184,7 +195,7 @@ tm_g_association <- function(label = "Association", ui_args = args, server_args = c( data_extract_list, - list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args) + list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args, decorators = decorators) ), datanames = teal.transform::get_extract_datanames(data_extract_list) ) @@ -237,6 +248,7 @@ ui_tm_g_association <- function(id, ...) { "Log transformed", value = FALSE ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( title = "Plot settings", @@ -278,7 +290,8 @@ srv_tm_g_association <- function(id, vars, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -393,8 +406,6 @@ srv_tm_g_association <- function(id, # association ref_class_cov <- ifelse(association, ref_class, "NULL") - print_call <- quote(print(p)) - var_calls <- lapply(vars_names, function(var_i) { var_class <- class(ANL[[var_i]])[1] if (is.numeric(ANL[[var_i]]) && log_transformation) { @@ -464,7 +475,6 @@ srv_tm_g_association <- function(id, ) ) } - teal.code::eval_code( merged$anl_q_r(), substitute( @@ -475,10 +485,9 @@ srv_tm_g_association <- function(id, teal.code::eval_code( substitute( expr = { - plots <- plot_calls - p <- tern::stack_grobs(grobs = lapply(plots, ggplotGrob)) - grid::grid.newpage() - grid::grid.draw(p) + plot_top <- plot_calls[[1]] + plot_bottom <- plot_calls[[1]] + plot <- tern::stack_grobs(grobs = lapply(list(plot_top, plot_bottom), ggplotGrob)) }, env = list( plot_calls = do.call( @@ -491,9 +500,19 @@ srv_tm_g_association <- function(id, ) }) + decorated_output_grob_q <- srv_decorate_teal_data( + id = "decorator", + data = output_q, + decorators = select_decorators(decorators, "plot"), + expr = { + grid::grid.newpage() + grid::grid.draw(plot) + } + ) + plot_r <- reactive({ req(iv_r()$is_valid()) - output_q()[["p"]] + req(decorated_output_grob_q())[["plot"]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -509,7 +528,7 @@ srv_tm_g_association <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_grob_q()))), title = "Association Plot" ) @@ -528,7 +547,7 @@ srv_tm_g_association <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_grob_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 807b4f23b..26c7b5c86 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -43,19 +43,30 @@ #' @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`. +#' @param decorators `r roxygen_decorators_param("tm_g_bivariate")` #' #' @inherit shared_params return #' -#' @examples -#' library(teal.widgets) +#' @section Decorating `tm_g_bivariate`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. #' +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples #' # general data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) #' CO2 <- data.frame(CO2) #' }) -#' datanames(data) <- c("CO2") #' #' app <- init( #' data = data, @@ -96,9 +107,6 @@ #' selected = "Treatment", #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Bivariate Module") #' ) #' ) #' ) @@ -106,15 +114,18 @@ #' shinyApp(app$ui, app$server) #' } #' -#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples #' # CDISC data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- c("ADSL") -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -155,9 +166,6 @@ #' selected = "COUNTRY", #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Bivariate Module") #' ) #' ) #' ) @@ -187,7 +195,8 @@ tm_g_bivariate <- function(label = "Bivariate Plots", ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), ggplot2_args = teal.widgets::ggplot2_args(), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_g_bivariate") # Normalize the parameters @@ -267,6 +276,9 @@ tm_g_bivariate <- function(label = "Bivariate Plots", 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) + + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") # End of assertions # Make UI args @@ -290,7 +302,7 @@ tm_g_bivariate <- function(label = "Bivariate Plots", ui_args = args, server_args = c( data_extract_list, - list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args) + list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args, decorators = decorators) ), datanames = teal.transform::get_extract_datanames(data_extract_list) ) @@ -340,6 +352,7 @@ ui_g_bivariate <- function(id, ...) { justified = TRUE ) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), if (!is.null(args$row_facet) || !is.null(args$col_facet)) { tags$div( class = "data-extract-box", @@ -453,7 +466,8 @@ srv_g_bivariate <- function(id, size, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -650,38 +664,49 @@ srv_g_bivariate <- function(id, } } - # Add labels to facets - nulled_row_facet_name <- varname_w_label(row_facet_name, ANL) - nulled_col_facet_name <- varname_w_label(col_facet_name, ANL) - without_facet <- (is.null(nulled_row_facet_name) && is.null(nulled_col_facet_name)) || !facetting - - print_call <- if (without_facet) { - quote(print(p)) - } else { - substitute( - expr = { - # Add facetting labels - # optional: grid.newpage() # nolint: commented_code. - # Prefixed with teal.modules.general as its usage will appear in "Show R code" - p <- teal.modules.general::add_facet_labels( - p, - xfacet_label = nulled_col_facet_name, - yfacet_label = nulled_row_facet_name - ) - grid::grid.newpage() - grid::grid.draw(p) - }, - env = list(nulled_col_facet_name = nulled_col_facet_name, nulled_row_facet_name = nulled_row_facet_name) - ) - } - - teal.code::eval_code(merged$anl_q_r(), substitute(expr = p <- cl, env = list(cl = cl))) %>% - teal.code::eval_code(print_call) + teal.code::eval_code(merged$anl_q_r(), substitute(expr = plot <- cl, env = list(cl = cl))) }) - plot_r <- reactive({ - output_q()[["p"]] - }) + decorated_output_q_facets <- srv_decorate_teal_data( + "decorator", + data = output_q, + decorators = select_decorators(decorators, "plot"), + expr = reactive({ + ANL <- merged$anl_q_r()[["ANL"]] + row_facet_name <- as.vector(merged$anl_input_r()$columns_source$row_facet) + col_facet_name <- as.vector(merged$anl_input_r()$columns_source$col_facet) + + # Add labels to facets + nulled_row_facet_name <- varname_w_label(row_facet_name, ANL) + nulled_col_facet_name <- varname_w_label(col_facet_name, ANL) + facetting <- (isTRUE(input$facetting) && (!is.null(row_facet_name) || !is.null(col_facet_name))) + without_facet <- (is.null(nulled_row_facet_name) && is.null(nulled_col_facet_name)) || !facetting + + print_call <- if (without_facet) { + quote(print(plot)) + } else { + substitute( + expr = { + # Add facetting labels + # optional: grid.newpage() # nolint: commented_code. + # Prefixed with teal.modules.general as its usage will appear in "Show R code" + plot <- teal.modules.general::add_facet_labels( + plot, + xfacet_label = nulled_col_facet_name, + yfacet_label = nulled_row_facet_name + ) + grid::grid.newpage() + grid::grid.draw(plot) + }, + env = list(nulled_col_facet_name = nulled_col_facet_name, nulled_row_facet_name = nulled_row_facet_name) + ) + } + print_call + }), + expr_is_reactive = TRUE + ) + + plot_r <- reactive(req(decorated_output_q_facets())[["plot"]]) pws <- teal.widgets::plot_with_settings_srv( id = "myplot", @@ -692,7 +717,7 @@ srv_g_bivariate <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q_facets()))), title = "Bivariate Plot" ) @@ -711,7 +736,7 @@ srv_g_bivariate <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_q_facets))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R index 17e04e479..92ed8ce2b 100644 --- a/R/tm_g_distribution.R +++ b/R/tm_g_distribution.R @@ -22,20 +22,52 @@ #' and `max`. #' Defaults to `c(30L, 1L, 100L)`. #' -#' @templateVar ggnames "Histogram", "QQplot" -#' @template ggplot2_args_multi +#' @param ggplot2_args `r roxygen_ggplot2_args_param("Histogram", "QQplot")` +#' @param decorators `r roxygen_decorators_param("tm_g_distribution")` #' #' @inherit shared_params return #' -#' @examples -#' library(teal.widgets) +#' @section Decorating `tm_g_distribution`: #' +#' This module generates the following objects, which can be modified in place using decorators:: +#' - `histogram_plot` (`ggplot2`) +#' - `qq_plot` (`data.frame`) +#' - `summary_table` (`data.frame`) +#' - `test_table` (`data.frame`) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_g_distribution( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' histogram_plot = list(teal_transform_module(...)), # applied only to `histogram_plot` output +#' qq_plot = list(teal_transform_module(...)) # applied only to `qq_plot` output +#' summary_table = list(teal_transform_module(...)) # applied only to `summary_table` output +#' test_table = list(teal_transform_module(...)) # applied only to `test_table` output +#' ) +#' ) +#' ``` +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +# nolint start: line_length_linter. +#' @examplesIf require("ggpmisc", quietly = TRUE) && require("ggpp", quietly = TRUE) && require("goftest", quietly = TRUE) && require("MASS", quietly = TRUE) && require("broom", quietly = TRUE) +# nolint end: line_length_linter. #' # general data example #' data <- teal_data() #' data <- within(data, { #' iris <- iris #' }) -#' datanames(data) <- "iris" #' #' app <- init( #' data = data, @@ -44,9 +76,6 @@ #' dist_var = data_extract_spec( #' dataname = "iris", #' select = select_spec(variable_choices("iris"), "Petal.Length") -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Distribution Module") #' ) #' ) #' ) @@ -55,13 +84,19 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +# nolint start: line_length_linter. +#' @examplesIf require("ggpmisc", quietly = TRUE) && require("ggpp", quietly = TRUE) && require("goftest", quietly = TRUE) && require("MASS", quietly = TRUE) && require("broom", quietly = TRUE) +# nolint end: line_length_linter. #' # CDISC data example #' data <- teal_data() #' data <- within(data, { -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- c("ADSL") -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' vars1 <- choices_selected( #' variable_choices(data[["ADSL"]], c("ARM", "COUNTRY", "SEX")), @@ -94,9 +129,6 @@ #' vars = vars1, #' multiple = TRUE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Distribution Module") #' ) #' ) #' ) @@ -118,7 +150,8 @@ tm_g_distribution <- function(label = "Distribution Module", plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_g_distribution") # Normalize the parameters @@ -159,6 +192,11 @@ tm_g_distribution <- function(label = "Distribution Module", 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) + + available_decorators <- c("histogram_plot", "qq_plot", "test_table", "summary_table") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, names = available_decorators) + # End of assertions # Make UI args @@ -175,7 +213,12 @@ tm_g_distribution <- function(label = "Distribution Module", server = srv_distribution, server_args = c( data_extract_list, - list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args) + list( + plot_height = plot_height, + plot_width = plot_width, + ggplot2_args = ggplot2_args, + decorators = decorators + ) ), ui = ui_distribution, ui_args = args, @@ -249,6 +292,10 @@ ui_distribution <- function(id, ...) { inline = TRUE ), checkboxInput(ns("add_dens"), label = "Overlay Density", value = TRUE), + ui_decorate_teal_data( + ns("d_density"), + decorators = select_decorators(args$decorators, "histogram_plot") + ), collapsed = FALSE ) ), @@ -257,9 +304,21 @@ ui_distribution <- function(id, ...) { teal.widgets::panel_item( "QQ Plot", checkboxInput(ns("qq_line"), label = "Add diagonal line(s)", TRUE), + ui_decorate_teal_data( + ns("d_qq"), + decorators = select_decorators(args$decorators, "qq_plot") + ), collapsed = FALSE ) ), + ui_decorate_teal_data( + ns("d_summary"), + decorators = select_decorators(args$decorators, "summary_table") + ), + ui_decorate_teal_data( + ns("d_test"), + decorators = select_decorators(args$decorators, "test_table") + ), conditionalPanel( condition = paste0("input['", ns("main_type"), "'] == 'Density'"), teal.widgets::panel_item( @@ -340,7 +399,8 @@ srv_distribution <- function(id, group_var, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -446,9 +506,10 @@ srv_distribution <- function(id, ) } } + rule_dist <- function(value) { - if (isTRUE(input$tabs == "QQplot" || - input$dist_tests %in% c( + if (isTRUE(input$tabs == "QQplot") || + isTRUE(input$dist_tests %in% c( "Kolmogorov-Smirnov (one-sample)", "Anderson-Darling (one-sample)", "Cramer-von Mises (one-sample)" @@ -458,6 +519,7 @@ srv_distribution <- function(id, } } } + iv_dist <- shinyvalidate::InputValidator$new() iv_dist$add_rule("t_dist", rule_dist) iv_dist$add_rule("dist_param1", rule_dist_1) @@ -500,11 +562,8 @@ srv_distribution <- function(id, selector_list()$dist_i()$select ), handlerExpr = { - req(input$params_reset) params <- if (length(input$t_dist) != 0) { - dist_var2 <- as.vector(merged$anl_input_r()$columns_source$dist_i) - get_dist_params <- function(x, dist) { if (dist == "unif") { return(stats::setNames(range(x, na.rm = TRUE), c("min", "max"))) @@ -515,8 +574,8 @@ srv_distribution <- function(id, ) } - ANL <- merged$anl_q_r()[[as.character(dist_var[[1]]$dataname)]] - round(get_dist_params(as.numeric(stats::na.omit(ANL[[dist_var2]])), input$t_dist), 2) + ANL <- merged$anl_q_r()[["ANL"]] + round(get_dist_params(as.numeric(stats::na.omit(ANL[[merge_vars()$dist_var]])), input$t_dist), 2) } else { c("param1" = NA_real_, "param2" = NA_real_) } @@ -644,12 +703,12 @@ srv_distribution <- function(id, ) } - if (length(s_var) == 0 && length(g_var) == 0) { - qenv <- teal.code::eval_code( + qenv <- if (length(s_var) == 0 && length(g_var) == 0) { + teal.code::eval_code( qenv, substitute( expr = { - summary_table <- ANL %>% + summary_table_data <- ANL %>% dplyr::summarise( min = round(min(dist_var_name, na.rm = TRUE), roundn), median = round(stats::median(dist_var_name, na.rm = TRUE), roundn), @@ -666,12 +725,12 @@ srv_distribution <- function(id, ) ) } else { - qenv <- teal.code::eval_code( + teal.code::eval_code( qenv, substitute( expr = { strata_vars <- strata_vars_raw - summary_table <- ANL %>% + summary_table_data <- ANL %>% dplyr::group_by_at(dplyr::vars(dplyr::any_of(strata_vars))) %>% dplyr::summarise( min = round(min(dist_var_name, na.rm = TRUE), roundn), @@ -681,7 +740,6 @@ srv_distribution <- function(id, sd = round(stats::sd(dist_var_name, na.rm = TRUE), roundn), count = dplyr::n() ) - summary_table # used to display table when running show-r-code code }, env = list( dist_var_name = dist_var_name, @@ -691,6 +749,20 @@ srv_distribution <- function(id, ) ) } + if (iv_r()$is_valid()) { + within(qenv, { + summary_table <- DT::datatable( + summary_table_data, + options = list( + autoWidth = TRUE, + columnDefs = list(list(width = "200px", targets = "_all")) + ), + rownames = FALSE + ) + }) + } else { + within(qenv, summary_table <- NULL) + } }) # distplot qenv ---- @@ -880,10 +952,7 @@ srv_distribution <- function(id, teal.code::eval_code( qenv, substitute( - expr = { - g <- plot_call - print(g) - }, + expr = histogram_plot <- plot_call, env = list(plot_call = Reduce(function(x, y) call("+", x, y), c(plot_call, parsed_ggplot2_args))) ) ) @@ -897,6 +966,7 @@ srv_distribution <- function(id, input$scales_type input$qq_line is.null(input$ggtheme) + input$tabs }, valueExpr = { dist_var <- merge_vars()$dist_var @@ -905,7 +975,6 @@ srv_distribution <- function(id, dist_var_name <- merge_vars()$dist_var_name s_var_name <- merge_vars()$s_var_name g_var_name <- merge_vars()$g_var_name - t_dist <- input$t_dist dist_param1 <- input$dist_param1 dist_param2 <- input$dist_param2 @@ -913,7 +982,7 @@ srv_distribution <- function(id, ggtheme <- input$ggtheme teal::validate_inputs(iv_r_dist(), iv_dist) - + t_dist <- req(input$t_dist) # Not validated when tab is not selected qenv <- common_q() plot_call <- if (length(s_var) == 0 && length(g_var) == 0) { @@ -1012,10 +1081,7 @@ srv_distribution <- function(id, teal.code::eval_code( qenv, substitute( - expr = { - g <- plot_call - print(g) - }, + expr = qq_plot <- plot_call, env = list(plot_call = Reduce(function(x, y) call("+", x, y), c(plot_call, parsed_ggplot2_args))) ) ) @@ -1164,7 +1230,7 @@ srv_distribution <- function(id, qenv, substitute( expr = { - test_stats <- ANL %>% + test_table_data <- ANL %>% dplyr::select(dist_var) %>% with(., generics::glance(do.call(test, args))) %>% dplyr::mutate_if(is.numeric, round, 3) @@ -1177,7 +1243,7 @@ srv_distribution <- function(id, qenv, substitute( expr = { - test_stats <- ANL %>% + test_table_data <- ANL %>% dplyr::select(dist_var, s_var, g_var) %>% dplyr::group_by_at(dplyr::vars(dplyr::any_of(groups))) %>% dplyr::do(tests = generics::glance(do.call(test, args))) %>% @@ -1188,52 +1254,88 @@ srv_distribution <- function(id, ) ) } - qenv %>% - # used to display table when running show-r-code code - teal.code::eval_code(quote(test_stats)) } ) # outputs ---- ## building main qenv - output_q <- reactive({ - tab <- input$tabs - req(tab) # tab is NULL upon app launch, hence will crash without this statement - - qenv_final <- common_q() + output_common_q <- reactive({ # wrapped in if since could lead into validate error - we do want to continue - test_r_qenv_out <- try(test_q(), silent = TRUE) - if (!inherits(test_r_qenv_out, c("try-error", "error"))) { - qenv_final <- teal.code::join(qenv_final, test_q()) + test_q_out <- try(test_q(), silent = TRUE) + if (!inherits(test_q_out, c("try-error", "error"))) { + c( + common_q(), + within(test_q_out, { + test_table <- DT::datatable( + test_table_data, + options = list(scrollX = TRUE), + rownames = FALSE + ) + }) + ) + } else { + within(common_q(), test_table <- NULL) } + }) + + output_dist_q <- reactive(c(output_common_q(), req(dist_q()))) + output_qq_q <- reactive(c(output_common_q(), req(qq_q()))) - qenv_final <- if (tab == "Histogram") { - req(dist_q()) - teal.code::join(qenv_final, dist_q()) - } else if (tab == "QQplot") { - req(qq_q()) - teal.code::join(qenv_final, qq_q()) + decorated_output_dist_q <- srv_decorate_teal_data( + "d_density", + data = output_dist_q, + decorators = select_decorators(decorators, "histogram_plot"), + expr = print(histogram_plot) + ) + + decorated_output_qq_q <- srv_decorate_teal_data( + "d_qq", + data = output_qq_q, + decorators = select_decorators(decorators, "qq_plot"), + expr = print(qq_plot) + ) + + decorated_output_summary_q <- srv_decorate_teal_data( + "d_summary", + data = output_common_q, + decorators = select_decorators(decorators, "summary_table"), + expr = summary_table + ) + + decorated_output_test_q <- srv_decorate_teal_data( + "d_test", + data = output_common_q, + decorators = select_decorators(decorators, "test_table"), + expr = test_table + ) + + decorated_output_q <- reactive({ + tab <- req(input$tabs) # tab is NULL upon app launch, hence will crash without this statement + test_q_out <- try(test_q(), silent = TRUE) + decorated_test_q_out <- if (inherits(test_q_out, c("try-error", "error"))) { + teal.code::qenv() + } else { + decorated_output_test_q() } - qenv_final + + out_q <- switch(tab, + Histogram = decorated_output_dist_q(), + QQplot = decorated_output_qq_q() + ) + c(out_q, decorated_output_summary_q(), decorated_test_q_out) }) - dist_r <- reactive(dist_q()[["g"]]) + dist_r <- reactive(req(decorated_output_dist_q())[["histogram_plot"]]) - qq_r <- reactive(qq_q()[["g"]]) + qq_r <- reactive(req(decorated_output_qq_q())[["qq_plot"]]) - output$summary_table <- DT::renderDataTable( - expr = if (iv_r()$is_valid()) common_q()[["summary_table"]] else NULL, - options = list( - autoWidth = TRUE, - columnDefs = list(list(width = "200px", targets = "_all")) - ), - rownames = FALSE - ) + output$summary_table <- DT::renderDataTable(expr = decorated_output_summary_q()[["summary_table"]]) tests_r <- reactive({ req(iv_r()$is_valid()) teal::validate_inputs(iv_r_dist()) - test_q()[["test_stats"]] + req(test_q()) # Ensure original errors are displayed + decorated_output_test_q()[["test_table"]] }) pws1 <- teal.widgets::plot_with_settings_srv( @@ -1253,14 +1355,12 @@ srv_distribution <- function(id, ) output$t_stats <- DT::renderDataTable( - expr = tests_r(), - options = list(scrollX = TRUE), - rownames = FALSE + expr = tests_r() ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), title = "R Code for distribution" ) @@ -1292,7 +1392,7 @@ srv_distribution <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_response.R b/R/tm_g_response.R index 44daa300d..98d7647e1 100644 --- a/R/tm_g_response.R +++ b/R/tm_g_response.R @@ -33,16 +33,27 @@ #' @param freq (`logical(1)`) #' Indicates whether to display frequency (`TRUE`) or density (`FALSE`). #' Defaults to density (`FALSE`). +#' @param decorators `r roxygen_decorators_param("tm_g_response")` #' #' @inherit shared_params return #' #' @note For more examples, please see the vignette "Using response plot" via #' `vignette("using-response-plot", package = "teal.modules.general")`. #' +#' @section Decorating `tm_g_response`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} #' @examples #' # general data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) @@ -51,7 +62,6 @@ #' mtcars[[v]] <- as.factor(mtcars[[v]]) #' } #' }) -#' datanames(data) <- "mtcars" #' #' app <- init( #' data = data, @@ -77,9 +87,6 @@ #' multiple = FALSE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Response Module") #' ) #' ) #' ) @@ -88,16 +95,18 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- c("ADSL") -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -123,9 +132,6 @@ #' multiple = FALSE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Response Module") #' ) #' ) #' ) @@ -150,7 +156,8 @@ tm_g_response <- function(label = "Response Plot", ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), ggplot2_args = teal.widgets::ggplot2_args(), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_g_response") # Normalize the parameters @@ -194,6 +201,9 @@ tm_g_response <- function(label = "Response Plot", 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) + + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") # End of assertions # Make UI args @@ -213,7 +223,12 @@ tm_g_response <- function(label = "Response Plot", ui_args = args, server_args = c( data_extract_list, - list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args) + list( + plot_height = plot_height, + plot_width = plot_width, + ggplot2_args = ggplot2_args, + decorators = decorators + ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) ) @@ -272,6 +287,7 @@ ui_g_response <- function(id, ...) { selected = ifelse(args$freq, "frequency", "density"), justified = TRUE ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( title = "Plot settings", @@ -307,7 +323,8 @@ srv_g_response <- function(id, col_facet, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -526,8 +543,7 @@ srv_g_response <- function(id, ) plot_call <- substitute(expr = { - p <- plot_call + labs + ggthemes + themes - print(p) + plot <- plot_call + labs + ggthemes + themes }, env = list( plot_call = plot_call, labs = parsed_ggplot2_args$labs, @@ -538,7 +554,14 @@ srv_g_response <- function(id, teal.code::eval_code(qenv, plot_call) }) - plot_r <- reactive(output_q()[["p"]]) + decorated_output_plot_q <- srv_decorate_teal_data( + id = "decorator", + data = output_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + + plot_r <- reactive(req(decorated_output_plot_q())[["plot"]]) # Insert the plot into a plot_with_settings module from teal.widgets pws <- teal.widgets::plot_with_settings_srv( @@ -550,7 +573,7 @@ srv_g_response <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_plot_q()))), title = "Show R Code for Response" ) @@ -569,7 +592,7 @@ srv_g_response <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_plot_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 4c804f073..9111150d0 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -27,19 +27,32 @@ #' `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. +#' @param decorators `r roxygen_decorators_param("tm_g_scatterplot")` #' #' @inherit shared_params return #' -#' @examples -#' library(teal.widgets) +#' @section Decorating `tm_g_scatterplot`: #' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +# nolint start: line_length_linter. +#' @examplesIf require("ggpmisc", quietly = TRUE) && require("ggExtra", quietly = TRUE) && require("colourpicker", quietly = TRUE) +# nolint end: line_length_linter. #' # general data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) #' CO2 <- CO2 #' }) -#' datanames(data) <- "CO2" #' #' app <- init( #' data = data, @@ -108,9 +121,6 @@ #' multiple = FALSE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Scatterplot Module") #' ) #' ) #' ) @@ -119,14 +129,20 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +# nolint start: line_length_linter. +#' @examplesIf require("ggpmisc", quietly = TRUE) && require("ggExtra", quietly = TRUE) && require("colourpicker", quietly = TRUE) +# nolint end: line_length_linter. #' # CDISC data example #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- c("ADSL") -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -195,9 +211,6 @@ #' multiple = FALSE, #' fixed = FALSE #' ) -#' ), -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Scatterplot Module") #' ) #' ) #' ) @@ -226,7 +239,8 @@ tm_g_scatterplot <- function(label = "Scatterplot", pre_output = NULL, post_output = NULL, table_dec = 4, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_scatterplot") # Normalize the parameters @@ -284,6 +298,10 @@ tm_g_scatterplot <- function(label = "Scatterplot", checkmate::assert_scalar(table_dec) checkmate::assert_class(ggplot2_args, "ggplot2_args") + + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") + # End of assertions # Make UI args @@ -305,7 +323,13 @@ tm_g_scatterplot <- function(label = "Scatterplot", ui_args = args, server_args = c( data_extract_list, - list(plot_height = plot_height, plot_width = plot_width, table_dec = table_dec, ggplot2_args = ggplot2_args) + list( + plot_height = plot_height, + plot_width = plot_width, + table_dec = table_dec, + ggplot2_args = ggplot2_args, + decorators = decorators + ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) ) @@ -400,6 +424,7 @@ ui_g_scatterplot <- function(id, ...) { is_single_dataset = is_single_dataset_value ) }, + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( title = "Plot settings", @@ -478,7 +503,8 @@ srv_g_scatterplot <- function(id, plot_height, plot_width, table_dec, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -968,13 +994,19 @@ srv_g_scatterplot <- function(id, ) } - plot_call <- substitute(expr = p <- plot_call, env = list(plot_call = plot_call)) + plot_call <- substitute(expr = plot <- plot_call, env = list(plot_call = plot_call)) - teal.code::eval_code(plot_q, plot_call) %>% - teal.code::eval_code(quote(print(p))) + teal.code::eval_code(plot_q, plot_call) }) - plot_r <- reactive(output_q()[["p"]]) + decorated_output_plot_q <- srv_decorate_teal_data( + id = "decorator", + data = output_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + + plot_r <- reactive(req(decorated_output_plot_q())[["plot"]]) # Insert the plot into a plot_with_settings module from teal.widgets pws <- teal.widgets::plot_with_settings_srv( @@ -1015,7 +1047,7 @@ srv_g_scatterplot <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_plot_q()))), title = "R Code for scatterplot" ) @@ -1034,7 +1066,7 @@ srv_g_scatterplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_plot_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_scatterplotmatrix.R b/R/tm_g_scatterplotmatrix.R index 2f857afcc..58f94cf61 100644 --- a/R/tm_g_scatterplotmatrix.R +++ b/R/tm_g_scatterplotmatrix.R @@ -15,10 +15,23 @@ #' 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. +#' @param decorators `r roxygen_decorators_param("tm_g_scatterplotmatrix")` #' #' @inherit shared_params return #' -#' @examples +#' @section Decorating `tm_g_scatterplotmatrix`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`trellis` - output of `lattice::splom`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examplesIf require("lattice", quietly = TRUE) #' # general data example #' data <- teal_data() #' data <- within(data, { @@ -52,7 +65,6 @@ #' profit = rnorm(50, 20, 10) #' ) #' }) -#' datanames(data) <- c("countries", "sales") #' join_keys(data) <- join_keys( #' join_key("countries", "countries", "id"), #' join_key("sales", "sales", "id"), @@ -102,14 +114,18 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examplesIf require("lattice", quietly = TRUE) #' # CDISC data example #' data <- teal_data() #' data <- within(data, { -#' ADSL <- rADSL -#' ADRS <- rADRS +#' ADSL <- teal.data::rADSL +#' ADRS <- teal.data::rADRS #' }) -#' datanames(data) <- c("ADSL", "ADRS") -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -161,7 +177,8 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix", plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_g_scatterplotmatrix") # Normalize the parameters @@ -181,6 +198,9 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix", 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) + + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") # End of assertions # Make UI args @@ -191,7 +211,12 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix", server = srv_g_scatterplotmatrix, ui = ui_g_scatterplotmatrix, ui_args = args, - server_args = list(variables = variables, plot_height = plot_height, plot_width = plot_width), + server_args = list( + variables = variables, + plot_height = plot_height, + plot_width = plot_width, + decorators = decorators + ), datanames = teal.transform::get_extract_datanames(variables) ) attr(ans, "teal_bookmarkable") <- TRUE @@ -222,6 +247,7 @@ ui_g_scatterplotmatrix <- function(id, ...) { is_single_dataset = is_single_dataset_value ), tags$hr(), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( title = "Plot settings", @@ -255,7 +281,14 @@ 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) { +srv_g_scatterplotmatrix <- function(id, + data, + reporter, + filter_panel_api, + variables, + plot_height, + plot_width, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -352,7 +385,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab qenv, substitute( expr = { - g <- lattice::splom( + plot <- lattice::splom( ANL, varnames = varnames_value, panel = function(x, y, ...) { @@ -376,7 +409,6 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab alpha = alpha_value, cex = cex_value ) - print(g) }, env = list( varnames_value = varnames, @@ -395,8 +427,13 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab qenv, substitute( expr = { - g <- lattice::splom(ANL, varnames = varnames_value, pch = 16, alpha = alpha_value, cex = cex_value) - g + plot <- lattice::splom( + ANL, + varnames = varnames_value, + pch = 16, + alpha = alpha_value, + cex = cex_value + ) }, env = list(varnames_value = varnames, alpha_value = alpha, cex_value = cex) ) @@ -405,7 +442,14 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab qenv }) - plot_r <- reactive(output_q()[["g"]]) + decorated_output_q <- srv_decorate_teal_data( + id = "decorator", + data = output_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + + plot_r <- reactive(req(decorated_output_q())[["plot"]]) # Insert the plot into a plot_with_settings module pws <- teal.widgets::plot_with_settings_srv( @@ -439,7 +483,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), title = "Show R Code for Scatterplotmatrix" ) @@ -458,7 +502,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R index 0f6c7b578..ade3d9fb6 100644 --- a/R/tm_missing_data.R +++ b/R/tm_missing_data.R @@ -10,26 +10,48 @@ #' @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. +# nolint start: line_length. #' @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 +#' @param ggplot2_args `r roxygen_ggplot2_args_param("Summary Obs", "Summary Patients", "Combinations Main", "Combinations Hist", "By Subject")` +# nolint end: line_length. +#' @param decorators `r roxygen_decorators_param("tm_missing_data")` #' #' @inherit shared_params return #' -#' @examples -#' library(teal.widgets) +#' @section Decorating `tm_missing_data`: #' -#' # module specification used in apps below -#' tm_missing_data_module <- tm_missing_data( -#' ggplot2_args = list( -#' "Combinations Hist" = ggplot2_args( -#' labs = list(subtitle = "Plot produced by Missing Data Module", caption = NULL) -#' ), -#' "Combinations Main" = ggplot2_args(labs = list(title = NULL)) -#' ) +#' This module generates the following objects, which can be modified in place using decorators: +#' - `summary_plot` (`grob` created with [ggplot2::ggplotGrob()]) +#' - `combination_plot` (`grob` created with [ggplot2::ggplotGrob()]) +#' - `by_subject_plot` (`ggplot2`) +#' - `table` ([DT::datatable()]) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_missing_data( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' summary_plot = list(teal_transform_module(...)), # applied only to `summary_plot` output +#' combination_plot = list(teal_transform_module(...)) # applied only to `combination_plot` output +#' by_subject_plot = list(teal_transform_module(...)) # applied only to `by_subject_plot` output +#' table = list(teal_transform_module(...)) # applied only to `table` output +#' ) #' ) +#' ``` +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examplesIf require("gridExtra", quietly = TRUE) && require("rlang", quietly = TRUE) #' # general example data #' data <- teal_data() #' data <- within(data, { @@ -48,29 +70,36 @@ #' mtcars[["cyl"]] <- as.factor(mtcars[["cyl"]]) #' mtcars[["gear"]] <- as.factor(mtcars[["gear"]]) #' }) -#' datanames(data) <- c("iris", "mtcars") #' #' app <- init( #' data = data, -#' modules = modules(tm_missing_data_module) +#' modules = modules( +#' tm_missing_data() +#' ) #' ) #' if (interactive()) { #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examplesIf require("gridExtra", quietly = TRUE) && require("rlang", quietly = TRUE) #' # CDISC example data #' data <- teal_data() #' data <- within(data, { #' require(nestcolor) -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' ADRS <- rADRS #' }) -#' datanames(data) <- c("ADSL", "ADRS") -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, -#' modules = modules(tm_missing_data_module) +#' modules = modules( +#' tm_missing_data() +#' ) #' ) #' if (interactive()) { #' shinyApp(app$ui, app$server) @@ -88,7 +117,8 @@ tm_missing_data <- function(label = "Missing data", "Combinations Main" = teal.widgets::ggplot2_args(labs = list(title = NULL)) ), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_missing_data") # Normalize the parameters @@ -114,14 +144,22 @@ tm_missing_data <- function(label = "Missing data", 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) + + available_decorators <- c("summary_plot", "combination_plot", "by_subject_plot", "summary_table") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, names = available_decorators) # End of assertions ans <- module( label, server = srv_page_missing_data, server_args = list( - parent_dataname = parent_dataname, plot_height = plot_height, - plot_width = plot_width, ggplot2_args = ggplot2_args, ggtheme = ggtheme + parent_dataname = parent_dataname, + plot_height = plot_height, + plot_width = plot_width, + ggplot2_args = ggplot2_args, + ggtheme = ggtheme, + decorators = decorators ), ui = ui_page_missing_data, datanames = "all", @@ -158,16 +196,17 @@ 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) { + plot_height, plot_width, ggplot2_args, ggtheme, decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") moduleServer(id, function(input, output, session) { teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.general") - datanames <- isolate(teal.data::datanames(data())) - datanames <- Filter(function(name) { - is.data.frame(isolate(data())[[name]]) - }, datanames) + datanames <- isolate(names(data())) + datanames <- Filter( + function(name) is.data.frame(isolate(data())[[name]]), + datanames + ) if_subject_plot <- length(parent_dataname) > 0 && parent_dataname %in% datanames ns <- session$ns @@ -207,7 +246,8 @@ srv_page_missing_data <- function(id, data, reporter, filter_panel_api, parent_d id = ns(x), summary_per_patient = if_subject_plot, ggtheme = ggtheme, - datanames = datanames + datanames = datanames, + decorators = decorators ) ) } @@ -240,7 +280,8 @@ srv_page_missing_data <- function(id, data, reporter, filter_panel_api, parent_d parent_dataname = parent_dataname, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) } ) @@ -318,7 +359,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) { +encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, datanames, decorators) { ns <- NS(id) tagList( @@ -373,25 +414,30 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data ), value = FALSE ) - } + }, + ui_decorate_teal_data(ns("dec_summary_plot"), decorators = select_decorators(decorators, "summary_plot")) ), conditionalPanel( is_tab_active_js(ns("summary_type"), "Combinations"), - uiOutput(ns("cutoff")) + uiOutput(ns("cutoff")), + ui_decorate_teal_data(ns("dec_combination_plot"), decorators = select_decorators(decorators, "combination_plot")) + ), + conditionalPanel( + is_tab_active_js(ns("summary_type"), "Grouped by Subject"), + ui_decorate_teal_data(ns("dec_by_subject_plot"), decorators = select_decorators(decorators, "by_subject_plot")) ), conditionalPanel( is_tab_active_js(ns("summary_type"), "By Variable Levels"), - tagList( - uiOutput(ns("group_by_var_ui")), - uiOutput(ns("group_by_vals_ui")), - radioButtons( - ns("count_type"), - label = "Display missing as", - choices = c("counts", "proportions"), - selected = "counts", - inline = TRUE - ) - ) + uiOutput(ns("group_by_var_ui")), + uiOutput(ns("group_by_vals_ui")), + radioButtons( + ns("count_type"), + label = "Display missing as", + choices = c("counts", "proportions"), + selected = "counts", + inline = TRUE + ), + ui_decorate_teal_data(ns("dec_summary_table"), decorators = select_decorators(decorators, "summary_table")) ), teal.widgets::panel_item( title = "Plot settings", @@ -407,8 +453,16 @@ 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) { +srv_missing_data <- function(id, + data, + reporter, + filter_panel_api, + dataname, + parent_dataname, + plot_height, + plot_width, + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -454,9 +508,8 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par iv }) - data_parent_keys <- reactive({ - if (length(parent_dataname) > 0 && parent_dataname %in% teal.data::datanames(data())) { + if (length(parent_dataname) > 0 && parent_dataname %in% names(data())) { keys <- teal.data::join_keys(data())[[dataname]] if (parent_dataname %in% names(keys)) { keys[[parent_dataname]] @@ -545,6 +598,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ) }) + # Keep encoding panel up-to-date output$variables <- renderUI({ choices <- split(x = vars_summary()$key, f = vars_summary()$label, drop = TRUE) %>% rev() selected <- choices <- unname(unlist(choices)) @@ -623,7 +677,6 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par prev_group_by_var(input$group_by_var) # set current group_by_var validate(need(length(choices) < 100, "Please select group-by variable with fewer than 100 unique values")) - teal.widgets::optionalSelectInput( ns("group_by_vals"), label = "Filter levels", @@ -634,12 +687,47 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ) }) + combination_cutoff_q <- reactive({ + req(common_code_q()) + teal.code::eval_code( + common_code_q(), + quote( + combination_cutoff <- ANL %>% + dplyr::mutate_all(is.na) %>% + dplyr::group_by_all() %>% + dplyr::tally() %>% + dplyr::ungroup() + ) + ) + }) + + output$cutoff <- renderUI({ + x <- combination_cutoff_q()[["combination_cutoff"]]$n + + # select 10-th from the top + n <- length(x) + idx <- max(1, n - 10) + prev_value <- isolate(input$combination_cutoff) + value <- if (is.null(prev_value) || prev_value > max(x) || prev_value < min(x)) { + sort(x, partial = idx)[idx] + } else { + prev_value + } + + teal.widgets::optionalSliderInputValMinMax( + ns("combination_cutoff"), + "Combination cut-off", + c(value, range(x)) + ) + }) + + # Prepare qenvs for output objects + summary_plot_q <- reactive({ req(input$summary_type == "Summary") # needed to trigger show r code update on tab change teal::validate_has_data(data_r(), 1) qenv <- common_code_q() - if (input$any_na) { new_col_name <- "**anyna**" qenv <- teal.code::eval_code( @@ -710,7 +798,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par qenv <- teal.code::eval_code( qenv, substitute( - p1 <- summary_plot_obs %>% + summary_plot_top <- summary_plot_obs %>% ggplot() + aes( x = factor(create_cols_labels(col), levels = x_levels), @@ -792,7 +880,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par qenv <- teal.code::eval_code( qenv, substitute( - p2 <- summary_plot_patients %>% + summary_plot_bottom <- summary_plot_patients %>% ggplot() + aes_( x = ~ factor(create_cols_labels(col), levels = x_levels), @@ -825,65 +913,22 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ggthemes = parsed_ggplot2_args$ggtheme ) ) - ) %>% - teal.code::eval_code( - quote({ - g1 <- ggplotGrob(p1) - g2 <- ggplotGrob(p2) - g <- gridExtra::gtable_cbind(g1, g2, size = "first") - g$heights <- grid::unit.pmax(g1$heights, g2$heights) - grid::grid.newpage() - }) - ) - } else { - qenv <- teal.code::eval_code( - qenv, - quote({ - g <- ggplotGrob(p1) - grid::grid.newpage() - }) ) } - teal.code::eval_code( - qenv, - quote(grid::grid.draw(g)) - ) - }) - - summary_plot_r <- reactive(summary_plot_q()[["g"]]) - - combination_cutoff_q <- reactive({ - req(common_code_q()) - teal.code::eval_code( - common_code_q(), - quote( - combination_cutoff <- ANL %>% - dplyr::mutate_all(is.na) %>% - dplyr::group_by_all() %>% - dplyr::tally() %>% - dplyr::ungroup() - ) - ) - }) - - output$cutoff <- renderUI({ - x <- combination_cutoff_q()[["combination_cutoff"]]$n - - # select 10-th from the top - n <- length(x) - idx <- max(1, n - 10) - prev_value <- isolate(input$combination_cutoff) - value <- `if`( - is.null(prev_value) || prev_value > max(x) || prev_value < min(x), - sort(x, partial = idx)[idx], prev_value - ) - - teal.widgets::optionalSliderInputValMinMax( - ns("combination_cutoff"), - "Combination cut-off", - c(value, range(x)) - ) + if (isTRUE(input$if_patients_plot)) { + within(qenv, { + g1 <- ggplotGrob(summary_plot_top) + g2 <- ggplotGrob(summary_plot_bottom) + summary_plot <- gridExtra::gtable_cbind(g1, g2, size = "first") + summary_plot$heights <- grid::unit.pmax(g1$heights, g2$heights) + }) + } else { + within(qenv, { + g1 <- ggplotGrob(summary_plot_top) + summary_plot <- g1 + }) + } }) combination_plot_q <- reactive({ @@ -964,11 +1009,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ggtheme = input$ggtheme ) - teal.code::eval_code( + qenv <- teal.code::eval_code( qenv, substitute( expr = { - p1 <- data_combination_plot_cutoff %>% + combination_plot_top <- data_combination_plot_cutoff %>% dplyr::select(id, n) %>% dplyr::distinct() %>% ggplot(aes(x = id, y = n)) + @@ -986,7 +1031,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par graph_number_rows <- length(unique(data_combination_plot_cutoff$id)) graph_number_cols <- nrow(data_combination_plot_cutoff) / graph_number_rows - p2 <- data_combination_plot_cutoff %>% ggplot() + + combination_plot_bottom <- data_combination_plot_cutoff %>% ggplot() + aes(x = create_cols_labels(key), y = id - 0.5, fill = value) + geom_tile(alpha = 0.85, height = 0.95) + scale_fill_manual( @@ -1000,14 +1045,6 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par labs2 + ggthemes2 + themes2 - - g1 <- ggplotGrob(p1) - g2 <- ggplotGrob(p2) - - g <- gridExtra::gtable_rbind(g1, g2, size = "last") - g$heights[7] <- grid::unit(0.2, "null") # rescale to get the bar chart smaller - grid::grid.newpage() - grid::grid.draw(g) }, env = list( labs1 = parsed_ggplot2_args1$labs, @@ -1019,9 +1056,15 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ) ) ) - }) - combination_plot_r <- reactive(combination_plot_q()[["g"]]) + within(qenv, { + g1 <- ggplotGrob(combination_plot_top) + g2 <- ggplotGrob(combination_plot_bottom) + + combination_plot <- gridExtra::gtable_rbind(g1, g2, size = "last") + combination_plot$heights[7] <- grid::unit(0.2, "null") # rescale to get the bar chart smaller + }) + }) summary_table_q <- reactive({ req( @@ -1059,11 +1102,9 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par function(x) round(sum(is.na(x)) / length(x), 4) } - qenv <- common_code_q() - - if (!is.null(group_var)) { - qenv <- teal.code::eval_code( - qenv, + qenv <- if (!is.null(group_var)) { + teal.code::eval_code( + common_code_q(), substitute( expr = { summary_data <- ANL %>% @@ -1085,8 +1126,8 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ) ) } else { - qenv <- teal.code::eval_code( - qenv, + teal.code::eval_code( + common_code_q(), substitute( expr = summary_data <- ANL %>% dplyr::summarise_all(summ_fn) %>% @@ -1100,11 +1141,9 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ) } - teal.code::eval_code(qenv, quote(summary_data)) + within(qenv, table <- DT::datatable(summary_data)) }) - summary_table_r <- reactive(summary_table_q()[["summary_data"]]) - by_subject_plot_q <- reactive({ # needed to trigger show r code update on tab change req(input$summary_type == "Grouped by Subject", common_code_q()) @@ -1190,7 +1229,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par teal.code::eval_code( substitute( expr = { - g <- ggplot(summary_plot_patients, aes( + by_subject_plot <- ggplot(summary_plot_patients, aes( x = factor(id, levels = order_subjects), y = factor(col, levels = ordered_columns[["column"]]), fill = isna @@ -1211,7 +1250,6 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par labs + ggthemes + themes - print(g) }, env = list( labs = parsed_ggplot2_args$labs, @@ -1222,21 +1260,73 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ) }) - by_subject_plot_r <- reactive(by_subject_plot_q()[["g"]]) + # Decorated outputs - output$levels_table <- DT::renderDataTable( + # Summary_plot_q + decorated_summary_plot_q <- srv_decorate_teal_data( + id = "dec_summary_plot", + data = summary_plot_q, + decorators = select_decorators(decorators, "summary_plot"), expr = { - if (length(input$variables_select) == 0) { - # so that zeroRecords message gets printed - # using tibble as it supports weird column names, such as " " - tibble::tibble(` ` = logical(0)) - } else { - summary_table_r() - } - }, - options = list(language = list(zeroRecords = "No variable selected"), pageLength = input$levels_table_rows) + grid::grid.newpage() + grid::grid.draw(summary_plot) + } + ) + + decorated_combination_plot_q <- srv_decorate_teal_data( + id = "dec_combination_plot", + data = combination_plot_q, + decorators = select_decorators(decorators, "combination_plot"), + expr = { + grid::grid.newpage() + grid::grid.draw(combination_plot) + } + ) + + decorated_summary_table_q <- srv_decorate_teal_data( + id = "dec_summary_table", + data = summary_table_q, + decorators = select_decorators(decorators, "summary_table"), + expr = table + ) + + decorated_by_subject_plot_q <- srv_decorate_teal_data( + id = "dec_by_subject_plot", + data = by_subject_plot_q, + decorators = select_decorators(decorators, "by_subject_plot"), + expr = print(by_subject_plot) ) + # Plots & tables reactives + + summary_plot_r <- reactive({ + req(decorated_summary_plot_q())[["summary_plot"]] + }) + + combination_plot_r <- reactive({ + req(decorated_combination_plot_q())[["combination_plot"]] + }) + + summary_table_r <- reactive({ + req(decorated_summary_table_q()) + + if (length(input$variables_select) == 0) { + # so that zeroRecords message gets printed + # using tibble as it supports weird column names, such as " " + DT::datatable( + tibble::tibble(` ` = logical(0)), + options = list(language = list(zeroRecords = "No variable selected."), pageLength = input$levels_table_rows) + ) + } else { + decorated_summary_table_q()[["table"]] + } + }) + + by_subject_plot_r <- reactive({ + req(decorated_by_subject_plot_q()[["by_subject_plot"]]) + }) + + # Generate output pws1 <- teal.widgets::plot_with_settings_srv( id = "summary_plot", plot_r = summary_plot_r, @@ -1251,6 +1341,8 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par width = plot_width ) + output$levels_table <- DT::renderDataTable(summary_table_r()) + pws3 <- teal.widgets::plot_with_settings_srv( id = "by_subject_plot", plot_r = by_subject_plot_r, @@ -1258,23 +1350,22 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par width = plot_width ) - final_q <- reactive({ - req(input$summary_type) - sum_type <- input$summary_type + decorated_final_q <- reactive({ + sum_type <- req(input$summary_type) if (sum_type == "Summary") { - summary_plot_q() + decorated_summary_plot_q() } else if (sum_type == "Combinations") { - combination_plot_q() + decorated_combination_plot_q() } else if (sum_type == "By Variable Levels") { - summary_table_q() + decorated_summary_table_q() } else if (sum_type == "Grouped by Subject") { - by_subject_plot_q() + decorated_by_subject_plot_q() } }) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(final_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_final_q()))), title = "Show R Code for Missing Data" ) @@ -1310,7 +1401,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(final_q())) + card$append_src(teal.code::get_code(req(decorated_final_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 7f30b897a..b9fdd90e6 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -11,14 +11,45 @@ #' 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 +#' @param ggplot2_args `r roxygen_ggplot2_args_param("Boxplot", "Density Plot", "Cumulative Distribution Plot")` +#' @param decorators `r roxygen_decorators_param("tm_outliers")` #' #' @inherit shared_params return #' +#' @section Decorating `tm_outliers`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `box_plot` (`ggplot2`) +#' - `density_plot` (`ggplot2`) +#' - `cumulative_plot` (`ggplot2`) +#' - `table` ([DT::datatable()]) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_outliers( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' box_plot = list(teal_transform_module(...)), # applied only to `box_plot` output +#' density_plot = list(teal_transform_module(...)) # applied only to `density_plot` output +#' cumulative_plot = list(teal_transform_module(...)) # applied only to `cumulative_plot` output +#' table = list(teal_transform_module(...)) # applied only to `table` output +#' ) +#' ) +#' ``` +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} #' @examples -#' library(teal.widgets) #' #' # general data example #' data <- teal_data() @@ -26,7 +57,6 @@ #' CO2 <- CO2 #' CO2[["primary_key"]] <- seq_len(nrow(CO2)) #' }) -#' datanames(data) <- "CO2" #' join_keys(data) <- join_keys(join_key("CO2", "CO2", "primary_key")) #' #' vars <- choices_selected(variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment"))) @@ -57,11 +87,6 @@ #' multiple = TRUE #' ) #' ) -#' ), -#' ggplot2_args = list( -#' ggplot2_args( -#' labs = list(subtitle = "Plot generated by Outliers Module") -#' ) #' ) #' ) #' ) @@ -70,17 +95,24 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples +#' #' # CDISC data example #' data <- teal_data() #' data <- within(data, { -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- "ADSL" -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) #' vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl)) #' +#' +#' #' app <- init( #' data = data, #' modules = modules( @@ -107,11 +139,6 @@ #' multiple = TRUE #' ) #' ) -#' ), -#' ggplot2_args = list( -#' ggplot2_args( -#' labs = list(subtitle = "Plot generated by Outliers Module") -#' ) #' ) #' ) #' ) @@ -130,7 +157,8 @@ tm_outliers <- function(label = "Outliers Module", plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_outliers") # Normalize the parameters @@ -167,6 +195,10 @@ tm_outliers <- function(label = "Outliers Module", 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) + + available_decorators <- c("box_plot", "density_plot", "cumulative_plot", "table") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, names = available_decorators) # End of assertions # Make UI args @@ -177,12 +209,16 @@ tm_outliers <- function(label = "Outliers Module", categorical_var = categorical_var ) + ans <- module( label = label, server = srv_outliers, server_args = c( data_extract_list, - list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args) + list( + plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args, + decorators = decorators + ) ), ui = ui_outliers, ui_args = args, @@ -305,6 +341,28 @@ ui_outliers <- function(id, ...) { uiOutput(ns("ui_outlier_help")) ) ), + conditionalPanel( + condition = paste0("input['", ns("tabs"), "'] == 'Boxplot'"), + ui_decorate_teal_data( + ns("d_box_plot"), + decorators = select_decorators(args$decorators, "box_plot") + ) + ), + conditionalPanel( + condition = paste0("input['", ns("tabs"), "'] == 'Density Plot'"), + ui_decorate_teal_data( + ns("d_density_plot"), + decorators = select_decorators(args$decorators, "density_plot") + ) + ), + conditionalPanel( + condition = paste0("input['", ns("tabs"), "'] == 'Cumulative Distribution Plot'"), + ui_decorate_teal_data( + ns("d_cumulative_plot"), + decorators = select_decorators(args$decorators, "cumulative_plot") + ) + ), + ui_decorate_teal_data(ns("d_table"), decorators = select_decorators(args$decorators, "table")), teal.widgets::panel_item( title = "Plot settings", selectInput( @@ -324,9 +382,10 @@ ui_outliers <- function(id, ...) { ) } +# Server function for the outliers module # 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) { + categorical_var, plot_height, plot_width, ggplot2_args, decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -399,7 +458,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, }) # Used to create outlier table and the dropdown with additional columns - dataname_first <- isolate(teal.data::datanames(data())[[1]]) + dataname_first <- isolate(names(data())[[1]]) common_code_q <- reactive({ req(iv_r()$is_valid()) @@ -566,7 +625,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ) ) - if (length(categorical_var) > 0) { + qenv <- if (length(categorical_var) > 0) { qenv <- teal.code::eval_code( qenv, substitute( @@ -622,7 +681,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ) } - qenv <- teal.code::eval_code( + teal.code::eval_code( qenv, substitute( expr = { @@ -650,7 +709,6 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, tidyr::pivot_longer(-categorical_var_name) %>% tidyr::pivot_wider(names_from = categorical_var, values_from = value) %>% tibble::column_to_rownames("name") - summary_table }, env = list( categorical_var = categorical_var, @@ -658,8 +716,22 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ) ) ) + } else { + within(qenv, summary_table <- data.frame()) } + # Datatable is generated in qenv to allow for output decoration + qenv <- within(qenv, { + table <- DT::datatable( + summary_table, + options = list( + dom = "t", + autoWidth = TRUE, + columnDefs = list(list(width = "200px", targets = "_all")) + ) + ) + }) + if (length(categorical_var) > 0 && nrow(qenv[["ANL_OUTLIER"]]) > 0) { shinyjs::show("order_by_outlier") } else { @@ -669,26 +741,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, qenv }) - output$summary_table <- DT::renderDataTable( - expr = { - if (iv_r()$is_valid()) { - categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) - if (!is.null(categorical_var)) { - DT::datatable( - common_code_q()[["summary_table"]], - options = list( - dom = "t", - autoWidth = TRUE, - columnDefs = list(list(width = "200px", targets = "_all")) - ) - ) - } - } - } - ) - # boxplot/violinplot # nolint commented_code - boxplot_q <- reactive({ + box_plot_q <- reactive({ req(common_code_q()) ANL <- common_code_q()[["ANL"]] ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] @@ -766,7 +820,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, teal.code::eval_code( common_code_q(), substitute( - expr = g <- plot_call + + expr = box_plot <- plot_call + scale_color_manual(values = c("TRUE" = "red", "FALSE" = "black")) + labs + ggthemes + themes, env = list( @@ -776,8 +830,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, themes = parsed_ggplot2_args$theme ) ) - ) %>% - teal.code::eval_code(quote(print(g))) + ) }) # density plot @@ -828,7 +881,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, teal.code::eval_code( common_code_q(), substitute( - expr = g <- plot_call + labs + ggthemes + themes, + expr = density_plot <- plot_call + labs + ggthemes + themes, env = list( plot_call = plot_call, labs = parsed_ggplot2_args$labs, @@ -836,8 +889,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ggthemes = parsed_ggplot2_args$ggtheme ) ) - ) %>% - teal.code::eval_code(quote(print(g))) + ) }) # Cumulative distribution plot @@ -930,7 +982,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, teal.code::eval_code( qenv, substitute( - expr = g <- plot_call + + expr = cumulative_plot <- plot_call + geom_point(data = outlier_points, aes(x = outlier_var_name, y = y, color = is_outlier_selected)) + scale_color_manual(values = c("TRUE" = "red", "FALSE" = "black")) + labs + ggthemes + themes, @@ -942,40 +994,63 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ggthemes = parsed_ggplot2_args$ggtheme ) ) - ) %>% - teal.code::eval_code(quote(print(g))) + ) }) - final_q <- reactive({ - req(input$tabs) - tab_type <- input$tabs - result_q <- if (tab_type == "Boxplot") { - boxplot_q() - } else if (tab_type == "Density Plot") { - density_plot_q() - } else if (tab_type == "Cumulative Distribution Plot") { - cumulative_plot_q() - } - # used to display table when running show-r-code code - # added after the plots so that a change in selected columns doesn't affect - # brush selection. - teal.code::eval_code( - result_q, - substitute( - expr = { - columns_index <- union( - setdiff(names(ANL_OUTLIER), "is_outlier_selected"), - table_columns - ) - ANL_OUTLIER_EXTENDED[ANL_OUTLIER_EXTENDED$is_outlier_selected, columns_index] - }, - env = list( - table_columns = input$table_ui_columns - ) - ) + current_tab_r <- reactive({ + switch(req(input$tabs), + "Boxplot" = "box_plot", + "Density Plot" = "density_plot", + "Cumulative Distribution Plot" = "cumulative_plot" ) }) + decorated_q <- mapply( + function(obj_name, q) { + srv_decorate_teal_data( + id = sprintf("d_%s", obj_name), + data = q, + decorators = select_decorators(decorators, obj_name), + expr = reactive({ + substitute( + expr = { + columns_index <- union( + setdiff(names(ANL_OUTLIER), c("is_outlier_selected", "order")), + table_columns + ) + ANL_OUTLIER_EXTENDED[ANL_OUTLIER_EXTENDED$is_outlier_selected, columns_index] + print(.plot) + }, + env = list(table_columns = input$table_ui_columns, .plot = as.name(obj_name)) + ) + }), + expr_is_reactive = TRUE + ) + }, + rlang::set_names(c("box_plot", "density_plot", "cumulative_plot")), + c(box_plot_q, density_plot_q, cumulative_plot_q) + ) + + decorated_final_q_no_table <- reactive(decorated_q[[req(current_tab_r())]]()) + + decorated_final_q <- srv_decorate_teal_data( + "d_table", + data = decorated_final_q_no_table, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + output$summary_table <- DT::renderDataTable( + expr = { + if (iv_r()$is_valid()) { + categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) + if (!is.null(categorical_var)) { + decorated_final_q()[["table"]] + } + } + } + ) + # slider text output$ui_outlier_help <- renderUI({ req(input$method) @@ -1024,22 +1099,22 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, } }) - boxplot_r <- reactive({ + box_plot_r <- reactive({ teal::validate_inputs(iv_r()) - boxplot_q()[["g"]] + req(decorated_q$box_plot())[["box_plot"]] }) density_plot_r <- reactive({ teal::validate_inputs(iv_r()) - density_plot_q()[["g"]] + req(decorated_q$density_plot())[["density_plot"]] }) cumulative_plot_r <- reactive({ teal::validate_inputs(iv_r()) - cumulative_plot_q()[["g"]] + req(decorated_q$cumulative_plot())[["cumulative_plot"]] }) box_pws <- teal.widgets::plot_with_settings_srv( id = "box_plot", - plot_r = boxplot_r, + plot_r = box_plot_r, height = plot_height, width = plot_width, brushing = TRUE @@ -1085,16 +1160,20 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ANL_OUTLIER_EXTENDED <- common_code_q()[["ANL_OUTLIER_EXTENDED"]] ANL <- common_code_q()[["ANL"]] - plot_brush <- if (tab == "Boxplot") { - boxplot_r() - box_pws$brush() - } else if (tab == "Density Plot") { - density_plot_r() - density_pws$brush() - } else if (tab == "Cumulative Distribution Plot") { - cumulative_plot_r() - cum_density_pws$brush() - } + plot_brush <- switch(current_tab_r(), + box_plot = { + box_plot_r() + box_pws$brush() + }, + density_plot = { + density_plot_r() + density_pws$brush() + }, + cumulative_plot = { + cumulative_plot_r() + cum_density_pws$brush() + } + ) # removing unused column ASAP ANL_OUTLIER$order <- ANL$order <- NULL @@ -1222,7 +1301,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(final_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_final_q()))), title = "Show R Code for Outlier" ) @@ -1244,7 +1323,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, } card$append_text("Plot", "header3") if (tab_type == "Boxplot") { - card$append_plot(boxplot_r(), dim = box_pws$dim()) + card$append_plot(box_plot_r(), dim = box_pws$dim()) } else if (tab_type == "Density Plot") { card$append_plot(density_plot_r(), dim = density_pws$dim()) } else if (tab_type == "Cumulative Distribution Plot") { @@ -1254,7 +1333,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(final_q())) + card$append_src(teal.code::get_code(req(decorated_final_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_crosstable.R b/R/tm_t_crosstable.R index 728fbca2e..c03014e93 100644 --- a/R/tm_t_crosstable.R +++ b/R/tm_t_crosstable.R @@ -19,16 +19,27 @@ #' @param show_total (`logical(1)`) #' Indicates whether to show total column. #' Defaults to `TRUE`. +#' @param decorators `r roxygen_decorators_param("tm_t_crosstable")` #' #' @note For more examples, please see the vignette "Using cross table" via #' `vignette("using-cross-table", package = "teal.modules.general")`. #' #' @inherit shared_params return #' -#' @examples -#' # general data example -#' library(teal.widgets) +#' @section Decorating `tm_t_crosstable`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examplesIf require("rtables", quietly = TRUE) +#' # general data example #' data <- teal_data() #' data <- within(data, { #' mtcars <- mtcars @@ -37,7 +48,6 @@ #' } #' mtcars[["primary_key"]] <- seq_len(nrow(mtcars)) #' }) -#' datanames(data) <- "mtcars" #' join_keys(data) <- join_keys(join_key("mtcars", "mtcars", "primary_key")) #' #' app <- init( @@ -65,9 +75,6 @@ #' multiple = FALSE, #' fixed = FALSE #' ) -#' ), -#' basic_table_args = basic_table_args( -#' subtitles = "Table generated by Crosstable Module" #' ) #' ) #' ) @@ -76,15 +83,17 @@ #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examplesIf require("rtables", quietly = TRUE) #' # CDISC data example -#' library(teal.widgets) -#' #' data <- teal_data() #' data <- within(data, { -#' ADSL <- rADSL +#' ADSL <- teal.data::rADSL #' }) -#' datanames(data) <- "ADSL" -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, @@ -117,9 +126,6 @@ #' multiple = FALSE, #' fixed = FALSE #' ) -#' ), -#' basic_table_args = basic_table_args( -#' subtitles = "Table generated by Crosstable Module" #' ) #' ) #' ) @@ -137,7 +143,8 @@ tm_t_crosstable <- function(label = "Cross Table", show_total = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_crosstable") # Normalize the parameters @@ -156,6 +163,9 @@ tm_t_crosstable <- function(label = "Cross Table", 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") + + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") # End of assertions # Make UI args @@ -165,7 +175,8 @@ tm_t_crosstable <- function(label = "Cross Table", label = label, x = x, y = y, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ans <- module( @@ -182,6 +193,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, ...) { + args <- list(...) ns <- NS(id) is_single_dataset <- teal.transform::is_single_dataset(x, y) @@ -219,7 +231,8 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p checkboxInput(ns("show_percentage"), "Show column percentage", value = show_percentage), checkboxInput(ns("show_total"), "Show total column", value = show_total) ) - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") @@ -230,7 +243,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) { +srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args, decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -349,7 +362,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, teal.code::eval_code( substitute( expr = { - lyt <- basic_tables %>% + table <- basic_tables %>% split_call %>% # styler: off rtables::add_colcounts() %>% tern::analyze_vars( @@ -385,19 +398,25 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, substitute( expr = { ANL <- tern::df_explicit_na(ANL) - tbl <- rtables::build_table(lyt = lyt, df = ANL[order(ANL[[y_name]]), ]) - tbl + table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ]) }, env = list(y_name = y_name) ) ) }) - output$title <- renderText(output_q()[["title"]]) + decorated_output_q <- srv_decorate_teal_data( + id = "decorator", + data = output_q, + decorators = select_decorators(decorators, "plot"), + expr = table + ) + + output$title <- renderText(req(decorated_output_q())[["title"]]) table_r <- reactive({ req(iv_r()$is_valid()) - output_q()[["tbl"]] + req(decorated_output_q())[["table"]] }) teal.widgets::table_with_settings_srv( @@ -407,7 +426,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), title = "Show R Code for Cross-Table" ) @@ -426,7 +445,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index 4dec3ab26..7b0f7c01c 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -21,17 +21,13 @@ #' #' @inherit shared_params return #' -#' @examples -#' library(teal.widgets) -#' -#' # Module specification used in apps below -#' tm_variable_browser_module <- tm_variable_browser( -#' label = "Variable browser", -#' ggplot2_args = ggplot2_args( -#' labs = list(subtitle = "Plot generated by Variable Browser Module") -#' ) -#' ) -#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +# nolint start: line_length_linter. +#' @examplesIf require("sparkline", quietly = TRUE) && require("htmlwidgets", quietly = TRUE) && require("jsonlite", quietly = TRUE) +# nolint end: line_length_linter. #' # general data example #' data <- teal_data() #' data <- within(data, { @@ -41,28 +37,42 @@ #' faithful <- faithful #' CO2 <- CO2 #' }) -#' datanames(data) <- c("iris", "mtcars", "women", "faithful", "CO2") #' #' app <- init( #' data = data, -#' modules = modules(tm_variable_browser_module) +#' modules = modules( +#' tm_variable_browser( +#' label = "Variable browser" +#' ) +#' ) #' ) #' if (interactive()) { #' shinyApp(app$ui, app$server) #' } #' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +# nolint start: line_length_linter. +#' @examplesIf require("sparkline", quietly = TRUE) && require("htmlwidgets", quietly = TRUE) && require("jsonlite", quietly = TRUE) +# nolint end: line_length_linter. #' # CDISC example data +#' library(sparkline) #' data <- teal_data() #' data <- within(data, { -#' ADSL <- rADSL -#' ADTTE <- rADTTE +#' ADSL <- teal.data::rADSL +#' ADTTE <- teal.data::rADTTE #' }) -#' datanames(data) <- c("ADSL", "ADTTE") -#' join_keys(data) <- default_cdisc_join_keys[datanames(data)] +#' join_keys(data) <- default_cdisc_join_keys[names(data)] #' #' app <- init( #' data = data, -#' modules = modules(tm_variable_browser_module) +#' modules = modules( +#' tm_variable_browser( +#' label = "Variable browser" +#' ) +#' ) #' ) #' if (interactive()) { #' shinyApp(app$ui, app$server) @@ -202,7 +212,7 @@ srv_variable_browser <- function(id, varname_numeric_as_factor <- reactiveValues() - datanames <- isolate(teal.data::datanames(data())) + datanames <- isolate(names(data())) datanames <- Filter(function(name) { is.data.frame(isolate(data())[[name]]) }, datanames) @@ -896,9 +906,9 @@ render_tab_header <- function(dataset_name, output, data) { dataset_ui_id <- paste0("dataset_summary_", dataset_name) output[[dataset_ui_id]] <- renderText({ df <- data()[[dataset_name]] - join_keys <- join_keys(data()) + join_keys <- teal.data::join_keys(data()) if (!is.null(join_keys)) { - key <- join_keys(data())[dataset_name, dataset_name] + key <- teal.data::join_keys(data())[dataset_name, dataset_name] } else { key <- NULL } @@ -968,7 +978,7 @@ render_tab_table <- function(dataset_name, parent_dataname, output, data, input, # get icons proper for the data types icons <- vapply(df, function(x) class(x)[1L], character(1L)) - join_keys <- join_keys(data()) + join_keys <- teal.data::join_keys(data()) if (!is.null(join_keys)) { icons[intersect(join_keys[dataset_name, dataset_name], colnames(df))] <- "primary_key" } diff --git a/R/utils.R b/R/utils.R index 5876abcab..dcb0ebd17 100644 --- a/R/utils.R +++ b/R/utils.R @@ -25,7 +25,6 @@ #' with text placed before the output to put the output into context. For example a title. #' @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 @@ -278,3 +277,134 @@ assert_single_selection <- function(x, } invisible(TRUE) } + +#' Wrappers around `srv_transform_teal_data` that allows to decorate the data +#' @inheritParams teal::srv_transform_teal_data +#' @param expr (`expression` or `reactive`) to evaluate on the output of the decoration. +#' When an expression it must be inline code. See [within()] +#' Default is `NULL` which won't evaluate any appending code. +#' @param expr_is_reactive (`logical(1)`) whether `expr` is a reactive expression +#' that skips defusing the argument. +#' @details +#' `srv_decorate_teal_data` is a wrapper around `srv_transform_teal_data` that +#' allows to decorate the data with additional expressions. +#' When original `teal_data` object is in error state, it will show that error +#' first. +#' +#' @keywords internal +srv_decorate_teal_data <- function(id, data, decorators, expr, expr_is_reactive = FALSE) { + checkmate::assert_class(data, classes = "reactive") + checkmate::assert_list(decorators, "teal_transform_module") + checkmate::assert_flag(expr_is_reactive) + + missing_expr <- missing(expr) + if (!missing_expr && !expr_is_reactive) { + expr <- rlang::enexpr(expr) + } + + moduleServer(id, function(input, output, session) { + decorated_output <- srv_transform_teal_data("inner", data = data, transformators = decorators) + + reactive({ + # ensure original errors are displayed and `eval_code` is never executed with NULL + req(data(), decorated_output()) + if (missing_expr) { + decorated_output() + } else if (expr_is_reactive) { + teal.code::eval_code(decorated_output(), expr()) + } else { + teal.code::eval_code(decorated_output(), expr) + } + }) + }) +} + +#' @rdname srv_decorate_teal_data +#' @details +#' `ui_decorate_teal_data` is a wrapper around `ui_transform_teal_data`. +#' @keywords internal +ui_decorate_teal_data <- function(id, decorators, ...) { + teal::ui_transform_teal_data(NS(id, "inner"), transformators = decorators, ...) +} + +#' Internal function to check if decorators is a valid object +#' @noRd +check_decorators <- function(x, names = NULL, null.ok = FALSE) { # nolint: object_name. + checkmate::qassert(null.ok, "B1") + + check_message <- checkmate::check_list( + x, + null.ok = null.ok, + names = "named" + ) + + if (!is.null(names)) { + check_message <- if (isTRUE(check_message)) { + out_message <- checkmate::check_names(names(x), subset.of = c("default", names)) + # see https://github.com/insightsengineering/teal.logger/issues/101 + if (isTRUE(out_message)) { + out_message + } else { + gsub("\\{", "(", gsub("\\}", ")", out_message)) + } + } else { + check_message + } + } + + if (!isTRUE(check_message)) { + return(check_message) + } + + valid_elements <- vapply( + x, + checkmate::test_list, + types = "teal_transform_module", + null.ok = TRUE, + FUN.VALUE = logical(1L) + ) + + if (all(valid_elements)) { + return(TRUE) + } + + "May only contain the type 'teal_transform_module' or a named list of 'teal_transform_module'." +} + +#' Internal assertion on decorators +#' @noRd +assert_decorators <- checkmate::makeAssertionFunction(check_decorators) + +#' Subset decorators based on the scope +#' +#' `default` is a protected decorator name that is always included in the output, +#' if it exists +#' +#' @param scope (`character`) a character vector of decorator names to include. +#' @param decorators (named `list`) of list decorators to subset. +#' +#' @return A flat list with all decorators to include. +#' It can be an empty list if none of the scope exists in `decorators` argument. +#' @keywords internal +select_decorators <- function(decorators, scope) { + checkmate::assert_character(scope, null.ok = TRUE) + scope <- intersect(union("default", scope), names(decorators)) + c(list(), unlist(decorators[scope], recursive = FALSE)) +} + +#' Convert flat list of `teal_transform_module` to named lists +#' +#' @param decorators (list of `teal_transform_module`) to normalize. +#' @return A named list of lists with `teal_transform_module` objects. +#' @keywords internal +normalize_decorators <- function(decorators) { + if (checkmate::test_list(decorators, "teal_transform_module", null.ok = TRUE)) { + if (checkmate::test_names(names(decorators))) { + lapply(decorators, list) + } else { + list(default = decorators) + } + } else { + decorators + } +} diff --git a/README.md b/README.md index ef66a1ece..b60732686 100644 --- a/README.md +++ b/README.md @@ -41,26 +41,26 @@ Please see [`teal` gallery](https://github.com/insightsengineering/teal.gallery) ## Installation ```r -# stable versions 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/). +Alternatively, you might want to use the development version. ```r -# beta versions -install.packages('teal.modules.general', repos = c('https://pharmaverse.r-universe.dev', getOption('repos'))) - # install.packages("pak") pak::pak("insightsengineering/teal.modules.general") ``` ## 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/). +To understand how to use this package, please refer to the [Getting Started](https://insightsengineering.github.io/teal.modules.general/latest-tag/articles/teal-modules-general.html) article, which provides multiple examples of code implementation. + +## Playground + +You can try out the package without installing it in the Shinylive: + +* [stable](https://shinylive.io/r/editor/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCGAC+AXSA) +* [development](https://shinylive.io/r/editor/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMI1UgSxIGcAKAdzgCMAnAfVQGsA5jy5xURRgAIAvJILMAOmC4BaAK4Q6ANzhdGcJTMlKAFqVKpGiAPTXUJqFxhQdeuBlUbtu-RgAmcFpKuJKCcKQA8rQMEIpg7Nx8QiJiEkoAlJkKEAA2dNyOAJ7M5FA5GDBEfmo5cIwYYRC6ZenZYAC+ALpAA) ## Getting help diff --git a/_pkgdown.yml b/_pkgdown.yml index ec36b1c74..d8d697150 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -15,6 +15,8 @@ navbar: href: coverage-report/ - text: Unit test report href: unit-test-report/ + - text: Non-CRAN unit test report + href: unit-test-report-non-cran/ github: icon: fa-github href: https://github.com/insightsengineering/teal.modules.general diff --git a/data-raw/data.R b/data-raw/data.R deleted file mode 100644 index a01b65119..000000000 --- a/data-raw/data.R +++ /dev/null @@ -1,15 +0,0 @@ -## code to prepare `data` for testing examples -rADAE <- random.cdisc.data::cadae -usethis::use_data(rADAE) - -rADLB <- random.cdisc.data::cadlb -usethis::use_data(rADLB) - -rADRS <- random.cdisc.data::cadrs -usethis::use_data(rADRS) - -rADSL <- random.cdisc.data::cadsl -usethis::use_data(rADSL) - -rADTTE <- random.cdisc.data::cadtte -usethis::use_data(rADTTE) diff --git a/data/rADAE.rda b/data/rADAE.rda deleted file mode 100644 index a1ad1463f..000000000 Binary files a/data/rADAE.rda and /dev/null differ diff --git a/data/rADLB.rda b/data/rADLB.rda deleted file mode 100644 index 188087301..000000000 Binary files a/data/rADLB.rda and /dev/null differ diff --git a/data/rADRS.rda b/data/rADRS.rda deleted file mode 100644 index 9c434fe2f..000000000 Binary files a/data/rADRS.rda and /dev/null differ diff --git a/data/rADSL.rda b/data/rADSL.rda deleted file mode 100644 index 3f3705330..000000000 Binary files a/data/rADSL.rda and /dev/null differ diff --git a/data/rADTTE.rda b/data/rADTTE.rda deleted file mode 100644 index a9158029d..000000000 Binary files a/data/rADTTE.rda and /dev/null differ diff --git a/inst/WORDLIST b/inst/WORDLIST index e77494d7b..d00a0162f 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,6 +1,7 @@ Forkers Hoffmann Prebuilt +Shinylive TLG UI customizable diff --git a/man-roxygen/ggplot2_args_multi.R b/man-roxygen/ggplot2_args_multi.R deleted file mode 100644 index dc0497942..000000000 --- a/man-roxygen/ggplot2_args_multi.R +++ /dev/null @@ -1,7 +0,0 @@ -#' @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. -#' -#' List names should match the following: `c("default", <%=ggnames%>)`. -#' -#' For more details see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`. diff --git a/man/normalize_decorators.Rd b/man/normalize_decorators.Rd new file mode 100644 index 000000000..257342765 --- /dev/null +++ b/man/normalize_decorators.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{normalize_decorators} +\alias{normalize_decorators} +\title{Convert flat list of \code{teal_transform_module} to named lists} +\usage{ +normalize_decorators(decorators) +} +\arguments{ +\item{decorators}{(list of \code{teal_transform_module}) to normalize.} +} +\value{ +A named list of lists with \code{teal_transform_module} objects. +} +\description{ +Convert flat list of \code{teal_transform_module} to named lists +} +\keyword{internal} diff --git a/man/rADAE.Rd b/man/rADAE.Rd deleted file mode 100644 index 6e57b7d7a..000000000 --- a/man/rADAE.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{rADAE} -\alias{rADAE} -\title{Random adverse events} -\format{ -An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 1934 rows and 92 columns. -} -\source{ -internal -} -\usage{ -rADAE -} -\description{ -Random adverse events -} -\keyword{datasets} -\keyword{internal} diff --git a/man/rADLB.Rd b/man/rADLB.Rd deleted file mode 100644 index a5430d325..000000000 --- a/man/rADLB.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{rADLB} -\alias{rADLB} -\title{Random lab analysis} -\format{ -An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 8400 rows and 102 columns. -} -\source{ -internal -} -\usage{ -rADLB -} -\description{ -Random lab analysis -} -\keyword{datasets} -\keyword{internal} diff --git a/man/rADRS.Rd b/man/rADRS.Rd deleted file mode 100644 index b25c99888..000000000 --- a/man/rADRS.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{rADRS} -\alias{rADRS} -\title{Random response} -\format{ -An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 3200 rows and 65 columns. -} -\source{ -internal -} -\usage{ -rADRS -} -\description{ -Random response -} -\keyword{datasets} -\keyword{internal} diff --git a/man/rADSL.Rd b/man/rADSL.Rd deleted file mode 100644 index 1b09ee22a..000000000 --- a/man/rADSL.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{rADSL} -\alias{rADSL} -\title{Random patient listing} -\format{ -An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 400 rows and 55 columns. -} -\source{ -internal -} -\usage{ -rADSL -} -\description{ -Random patient listing -} -\keyword{datasets} -\keyword{internal} diff --git a/man/rADTTE.Rd b/man/rADTTE.Rd deleted file mode 100644 index 185d391d9..000000000 --- a/man/rADTTE.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{rADTTE} -\alias{rADTTE} -\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. -} -\source{ -internal -} -\usage{ -rADTTE -} -\description{ -Random time to event analysis dataset -} -\keyword{datasets} -\keyword{internal} diff --git a/man/select_decorators.Rd b/man/select_decorators.Rd new file mode 100644 index 000000000..2c7403dca --- /dev/null +++ b/man/select_decorators.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{select_decorators} +\alias{select_decorators} +\title{Subset decorators based on the scope} +\usage{ +select_decorators(decorators, scope) +} +\arguments{ +\item{decorators}{(named \code{list}) of list decorators to subset.} + +\item{scope}{(\code{character}) a character vector of decorator names to include.} +} +\value{ +A flat list with all decorators to include. +It can be an empty list if none of the scope exists in \code{decorators} argument. +} +\description{ +\code{default} is a protected decorator name that is always included in the output, +if it exists +} +\keyword{internal} diff --git a/man/srv_decorate_teal_data.Rd b/man/srv_decorate_teal_data.Rd new file mode 100644 index 000000000..18201124e --- /dev/null +++ b/man/srv_decorate_teal_data.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{srv_decorate_teal_data} +\alias{srv_decorate_teal_data} +\alias{ui_decorate_teal_data} +\title{Wrappers around \code{srv_transform_teal_data} that allows to decorate the data} +\usage{ +srv_decorate_teal_data(id, data, decorators, expr, expr_is_reactive = FALSE) + +ui_decorate_teal_data(id, decorators, ...) +} +\arguments{ +\item{id}{(\code{character(1)}) Module id} + +\item{data}{(\verb{reactive teal_data})} + +\item{expr}{(\code{expression} or \code{reactive}) to evaluate on the output of the decoration. +When an expression it must be inline code. See \code{\link[=within]{within()}} +Default is \code{NULL} which won't evaluate any appending code.} + +\item{expr_is_reactive}{(\code{logical(1)}) whether \code{expr} is a reactive expression +that skips defusing the argument.} +} +\description{ +Wrappers around \code{srv_transform_teal_data} that allows to decorate the data +} +\details{ +\code{srv_decorate_teal_data} is a wrapper around \code{srv_transform_teal_data} that +allows to decorate the data with additional expressions. +When original \code{teal_data} object is in error state, it will show that error +first. + +\code{ui_decorate_teal_data} is a wrapper around \code{ui_transform_teal_data}. +} +\keyword{internal} diff --git a/man/tm_a_pca.Rd b/man/tm_a_pca.Rd index a4fa1e679..8dada5c8c 100644 --- a/man/tm_a_pca.Rd +++ b/man/tm_a_pca.Rd @@ -16,7 +16,8 @@ tm_a_pca( alpha = c(1, 0, 1), size = c(2, 1, 8), pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -34,9 +35,7 @@ specifying columns used to compute PCA.} \item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\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. +\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. List names should match the following: \code{c("default", "Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")}. @@ -72,6 +71,12 @@ with text placed before the output to put the output into context. For example a \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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_a_pca}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -82,8 +87,39 @@ ways of visualizing the outcomes, including elbow plot, circle plot, biplot, and Additionally, it enables dynamic customization of plot aesthetics, such as opacity, size, and font size, through UI inputs. } +\section{Decorating \code{tm_a_pca}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{elbow_plot} (\code{ggplot2}) +\item \code{circle_plot} (\code{ggplot2}) +\item \code{biplot} (\code{ggplot2}) +\item \code{eigenvector_plot} (\code{ggplot2}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_a_pca( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + elbow_plot = list(teal_transform_module(...)), # applied only to `elbow_plot` output + circle_plot = list(teal_transform_module(...)) # applied only to `circle_plot` output + biplot = list(teal_transform_module(...)) # applied only to `biplot` output + eigenvector_plot = list(teal_transform_module(...)) # applied only to `eigenvector_plot` output + ) +) +}\if{html}{\out{
}} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + \examples{ -library(teal.widgets) # general data example data <- teal_data() @@ -92,8 +128,6 @@ data <- within(data, { USArrests <- USArrests }) -datanames(data) <- "USArrests" - app <- init( data = data, modules = modules( @@ -109,9 +143,6 @@ app <- init( multiple = TRUE ), filter = NULL - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by PCA Module") ) ) ) @@ -120,14 +151,14 @@ if (interactive()) { shinyApp(app$ui, app$server) } + # CDISC data example data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- "ADSL" -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -144,9 +175,6 @@ app <- init( multiple = TRUE ), filter = NULL - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by PCA Module") ) ) ) @@ -156,3 +184,18 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLqkQ11XfxQpFC6cAAesKgiSoHBBsZc1AD6sVA2MUEhRroA7rSkABYq7Km4uiBKurqMcACOgrQ17L6ipMTURIyKEFWOAMoAgow1raLxuv1DI6SiSgC+3UpoqOMq+eyVAZm6ALxbwbibfEIiY3vHwmIbPVW6pDBJUEmoBGmbt7oKYAAKAMIDX0ONw+sV2+ye4VIzA0SVEqDgBGuHxBmWg8DBX0mwzEM0B72RojgIg0YMJxNIsPhiPxyN0BAKRFoBDEYK0LFoUHoIiS9MZzNESNpyNSYNSwGAmMG2NGXwAurKytSwABZQSMfgyQGfMADUSiKDCUhazGMehQCDfIioY1gLBoOBfbpC25yIHOqpkhHkfhgpWq9WavDa3X6w2Ot3umCG2hRPR7BwuGkuiO0ky0ajkRhggByjgAMnmk06XZtut1aCZdOwVJn1JodDZbBUbqIihBWAN0OxlgASBplXuExg6LrzJRgOayoA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLoDCAEQCSAMreuvxQpFC6cAAesKgiSmERBsZc1AD6SVA2ieGRRroA7rSkABYq7Fm4uiBKurqMcACOgrSN7BBipMTURIyKEPUAgr6BADIpumkYWYiIjCPjSgC+AwBWRCrpANZwrKKVebYF-HAmUMKk6QT8tKIE6Rtbu-vA0PAHWXIAuu5oqJMVCV2HVQnldABeMERXCgvhCESiSG6eHCMQgwb1KYwdJQdKoAjZUFY3QKMAABW8QzJsMxJKSyKy6RipGYGnSolQcAIGJJ9Ly7z0ULJizGNOJfNEcBEGmRUplV053N5fJJBFKmwIYmRWhYtCg9BE1w1tC1BwlqvqWUZeWAwBFozFYG+32qPLJACEALJYADSWAAjDTSWAhgBxVx4EPOADygV8AE0yQNLVi5LTU-V5dzyPxke6wN6-YHgyKI8mM5mYJdaPEhfYnK46Xz0xasSZaNRyIxkQA5RxjMXN+optOggYDWgmXTsFTd9SaHQ2Wy1TGicoQVhDdDsf4AEla1X3UsYOn6KyUYGW3yAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd index dc4f458f3..20897f8af 100644 --- a/man/tm_a_regression.Rd +++ b/man/tm_a_regression.Rd @@ -18,7 +18,8 @@ tm_a_regression( post_output = NULL, default_plot_type = 1, default_outlier_label = "USUBJID", - label_segment_threshold = c(0.5, 0, 10) + label_segment_threshold = c(0.5, 0, 10), + decorators = NULL ) } \arguments{ @@ -53,11 +54,9 @@ vector of \code{value}, \code{min}, and \code{max}. \item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\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. +\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. -List names should match the following: \verb{c("default", "Response vs Regressor", "Residuals vs Fitted", "Scale-Location", "Cook's distance", "Residuals vs Leverage"", "Cook's dist vs Leverage")}. +List names should match the following: \code{c("default", "Response vs Regressor", "Residuals vs Fitted", "Scale-Location", "Cook's distance", "Residuals vs Leverage", "Cook's dist vs Leverage")}. For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} @@ -96,6 +95,12 @@ It can take the following forms: It takes the form of \code{c(value, min, max)} and it is passed to the \code{value_min_max} argument in \code{teal.widgets::optionalSliderInputValMinMax}. }} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_a_regression}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -110,16 +115,26 @@ visualize residuals, and identify outliers. For more examples, please see the vignette "Using regression plots" via \code{vignette("using-regression-plots", package = "teal.modules.general")}. } +\section{Decorating \code{tm_a_regression}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + \examples{ -# general data example -library(teal.widgets) +# general data example data <- teal_data() data <- within(data, { require(nestcolor) CO2 <- CO2 }) -datanames(data) <- c("CO2") app <- init( data = data, @@ -145,9 +160,6 @@ app <- init( multiple = TRUE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Regression Module") ) ) ) @@ -157,15 +169,12 @@ if (interactive()) { } # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- "ADSL" -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -191,9 +200,6 @@ app <- init( multiple = TRUE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Regression Module") ) ) ) @@ -203,3 +209,18 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLqkQ11XfxQpFC6cAAesKgiSoHBBsZc1AD6sVA2MUEhRroA7rSkABYq7Km4uiBKurqMcACOgrQ17L6ipMTURIyKEFUAwgDyAEzxugODSgC+3UpoqCMq+eyVAZm6ALwrwbjLfEIiouu6u8JiSz1VuqQwSVBJNRI1oqJWEGcXF9RQ9HD+GwpgWDgDzEzxI-2253ej1QJFEeg2qSS4VIzA0SVEqDgBDe7wuqWg8EO-zG4OWuN0cJEGkOlKxpHRmOxZPJuk+31+un+AGUfnTdFoWLQviJEKTISyCAUiLQCGIiWBBKhggBrOBilkXWkaOD8eWKlVqvDM8kwYSaKLw3QAMQAggAZLnOCEaqomWhhHWHBwuY0XbrkuTO3H3R6iTqHRHI1H0jFYnHk-GwS3Eobqlla0g03lo2NM8Xktk-eU8qmZgWMIX0faio353GS6Wyg4bcuVkRJBsy06pYDAFPjMAAXUHZSZhBIBHBnLAdhqQXgZH+ckDvveGc9f3HFjTGtN1HNIi9Tidq4ubo9uo2todrjrVX9uIf9+W3W6tBMunYKnI0e0cBstgVOcohFBArA2ug7CzAAJA0ZQwXCjA6F0kxKGAEyDkAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0lA0g0JA1RKIrBB0ZjMdQoPQ4NQkQowFg4ASxMSSPSYRjyYTUCRRHpIZk0tFSMwNGlRKg4AQyeTMZk3vzdPSFqN2SDZbo+SINEitVLLhKpTKNXVKdTaZD6QEafrdFoWLQqSJEGrOSaCCUNgQxHSwAAhACyWAA0lgAIyuk2YvUaOD8X2BkPhyNR5EXWhxRUAMUGowCzg5qdMtCicaRDhc6tl-Q1ckLsvxhNEvSRguFooNkulVfJ8tgiuVI1VeB70ZtOshMc7RtH5LNNN91u1pDtDqdYhdI7dGo9Xp9kPtjEd9BEV09tG9H1ywGAg8WYC+Xyq3bAgwA4q48EqwPmABrs78sEGLxPzkOtZzHZcy0tV8PxTKMYHTTNyycAsILqEwS2g3QczzVxt0xGtqyrIj+n6WgTF0dgVHIDttDgGxbBqDFRDKCBWEGdB2DQVAABIWiqHjeL5RgdD6ZYlDAJYviAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_data_table.Rd b/man/tm_data_table.Rd index 1d24f04b1..78864c9c4 100644 --- a/man/tm_data_table.Rd +++ b/man/tm_data_table.Rd @@ -13,7 +13,8 @@ tm_data_table( scrollX = TRUE), server_rendering = FALSE, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -46,6 +47,12 @@ with text placed before the output to put the output into context. For example a \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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_data_table}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -61,6 +68,18 @@ 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. } +\section{Decorating \code{tm_data_table}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{\link[DT:datatable]{DT::datatable()}}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + \examples{ # general data example data <- teal_data() @@ -68,7 +87,6 @@ data <- within(data, { require(nestcolor) iris <- iris }) -datanames(data) <- c("iris") app <- init( data = data, @@ -89,10 +107,9 @@ if (interactive()) { data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- "ADSL" -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -108,3 +125,18 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQ20onG6vaJKAL5dSmioAyp57BX+GboAvAtBuPN8QiL9K5vCYnPdlbqkMMkZiUH0IofHx1ostFDXYomicCIacPzLunQttzuxyGvwIczAAGU4KhuBgADIUCQFBR4XQoqEwngAdVo-GRqJRAAU4EEeAiIEj8ijSkSSbCcXiqQTIag4ARaGIUV0gbo5Osjnc8YkWBIdn8+qR2AQ0JoSL8UQBJLAKiH2Z4iXQAYRlVggXPmlW5vKUXVoJl07BU5GYlh0Nls5SOokKEFYAEF0OxJgASeqlH3vRg6TqjJRgEYAXSAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjAMrk0uF6CJ0ZjMVoWLQoASxGlRHARBo4PwkXRRKR2AtxpCCMCwAE7I4fABNPw+BR4XSixwBRwAIQAUsLRVVRVK5Qqxcq-HZnGqlWBBgBxVzqnnOAAaorkchhGOJ-EuLAkiMhzNZBDQmhISNF7PsFJE3ndVggFpBdX6YaU-VoJl07BU5GYlh0NlsNQxojKEFYg3Q7DQqAAJC0qvmCzTGDo+sslGAll8gA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_file_viewer.Rd b/man/tm_file_viewer.Rd index c04f73a2e..a1617b9db 100644 --- a/man/tm_file_viewer.Rd +++ b/man/tm_file_viewer.Rd @@ -31,7 +31,6 @@ data <- teal_data() data <- within(data, { data <- data.frame(1) }) -datanames(data) <- c("data") app <- init( data = data, @@ -51,3 +50,13 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXSSfTLCME2Z4dgBGRQgAX1KlNFRslRj2dJyvXQBeJuTGviERUVbdLuExBogMjNIYfxNaEX8tWjhImWHR0ZVUQVJ-VE9YvrpRUmWV0ZMian4ZPtFWA7gYPOm4BrBRWFQZqZ6FPF1tggBrKBSPrfPy8ASDcRSCBqajfOS4RrHX4QCRXG7ke6fJ7fV4wd5wSaPUQAejxBKJIgwqFR3xSf0BwLaoLg3HB3TEkmksnhiJGyN0pAAHqR0bcsY9nuSPsSyW8ZVThaQ6b91Iy9MywGCBj0uTCeWAEUjjoJGNQQWBYqRSKhRIgSSSTB5JEQtI7ZfxGIIJKT1vR9rE4PwSQAFIiMLz+uCGAAiRAIgngZEMADFwzBPIYAMqoOAEWhTAieKwQcSofgmb7GjKlFa13SlUoF3TsFTkZiWHQ2WxpfmieIQVgAQXQ7GqABJBLQUhPRDIdIxSmUlGAygBdIA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_front_page.Rd b/man/tm_front_page.Rd index 801bbd00e..b19d33651 100644 --- a/man/tm_front_page.Rd +++ b/man/tm_front_page.Rd @@ -43,11 +43,10 @@ introductory text, tables, additional \code{html} or \code{shiny} tags, and foot data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL attr(ADSL, "metadata") <- list("Author" = "NEST team", "data_source" = "synthetic data") }) -datanames(data) <- "ADSL" -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(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")) @@ -82,3 +81,13 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXUY4AEdBWiz2CDFSYmoiRkUIDIBBABEAZQAZH10-DCTEREY6pvTdT1JGdh7GlIUweC8k8dsIulFSdnHqwTjy8d0AXl1xgDlnertWuFhxsbAk-1EiQUYCOA3t8dFWMli4TQJdabBKgF9KgArIgqfwAazgrFEiTCs2M-DgJigwlI-gI-FoogI-mBoIhUOA0Hg0KScgAum4yFB6CJ-ABGFpJDAmZjwdgASQgJiIW10BCWYGqZx2YAAQjMUnY4AAPUi8-nLYXjcW-SpeGlwfwAJkZYWZrLg7AABgBhIjUQQwKp0o3ygUmpVgWoS3Sm82Wqpa23bfkAVgwvpSADYMEG5Ck3RarboAMzevkCoV4EUquRq6m0mO6rz62CGzncu3jVzJ8YAMRdUtlRbAAHFHQAJGaVJTq2kqVCrFrzRZ9cZ2DN6OmPVqD+m4PtgAca3RakdtzVaidVEXTkSx+djmNKFvQdAtFQxJYrpK8pLLjJ8IQiUS8q-CMTHjIZUgwfwskio1BQKRP58Zd4oARRh-HIasfT-f8MnGdkYFQcovDIXQVG5RgYE8KwIBHGC5QIKAqgkHl3iyDAzj6KCRQAeTiGRkK5cp0M0EhsLAE18N0QjdGIuBSLAcjn3DfiX0HW9tgXfwO1WC8oKAjEmOgAIvAkUTdAbOwAFlGkTfg5Mw7hVI05pyl0UR4ggVhR2UjiiJkPR9CYAA+CUhNMIgiFICB3LEGsAA0WMxVp3lMfIFlc9zPPIR0AE1kNvGiTLgYgIH4MKPK85yV3-UyiEifxJiAsJeQcFx+MqDJBJXQDgN5JTRAAEliOkBXqWBUHXap0DoPD5IyjJuS8xgap-erUETTraG6zDUpkDLd1oExdHYFRyGYSwdBsWw0hXUyVFYDrRrQVA6ryFJDrq0QZB0ColD+JQwD+MkgA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index ef47169a7..be072e66e 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -17,7 +17,8 @@ tm_g_association( "void"), pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -50,13 +51,17 @@ with text placed before the output to put the output into context. For example a \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}) 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. +\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. List names should match the following: \code{c("default", "Bivariate1", "Bivariate2")}. For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_g_association}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -70,9 +75,19 @@ It supports configuring the appearance of the plots, including themes and whethe For more examples, please see the vignette "Using association plot" via \code{vignette("using-association-plot", package = "teal.modules.general")}. } -\examples{ -library(teal.widgets) +\section{Decorating \code{tm_g_association}}{ + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{grob} created with \code{\link[ggplot2:ggplotGrob]{ggplot2::ggplotGrob()}}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + +\examples{ # general data example data <- teal_data() data <- within(data, { @@ -81,7 +96,6 @@ data <- within(data, { factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) CO2[factors] <- lapply(CO2[factors], as.character) }) -datanames(data) <- c("CO2") app <- init( data = data, @@ -105,9 +119,6 @@ app <- init( multiple = TRUE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Association Module") ) ) ) @@ -120,10 +131,9 @@ if (interactive()) { data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- "ADSL" -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -153,9 +163,6 @@ app <- init( multiple = TRUE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Association Module") ) ) ) @@ -165,3 +172,18 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QMVpuqkHaLD0PCi7ABitNTkjOy0og4upVpokRyjpZsYJpMdpe0StATc7ACMADJyL129g8BnGtMAusPU+2ohw+XymjFEP1KUHEBHyLEmMi6AF8ukp9sMVHl2OMUroALz+DK4cZ8IQiGYE0nCMTY7qVXSkGCJCSJaGiIgEWiBKwQWn0+nVEz4wlBRJhUjMDSJUSoOAEPn8+kpOZ6AkKMCjdXEumK3SiOAiDTC-WG0jS2Xy8a6yoA+gG4XqgDKBrlpF0e0YXPoIkQWqt1thRBuYmFHq9IkSgeDCxSwGA6s1YB+kN0lrAAAUAWQtbp1XZWLKc3nqoF4NmwC9tdb6SbXXB+A6M1nSH6ddaTLRQvXhYsAIKPR2uNv8t6KuRVxUeikiqBi0ISybmuUK3XK2Cq3Mawat6u1o0EvdmmXL-26232tVgZ2m90scNiX14U+KqMEEMEsNQb1wSP5INvmMMjjBNtyTFM00zKBy1KPMCzgIswDsEtGQoFsK3HZ9+UPbtLyQuBS1Qndq10GBhE0SIN22ZwJ2rDsuwbAk+wHIdq1HEd-VHLouloIUNlUSVNB0GxbHKOlREKCBWF7dB2H2AASeooXQOT9UYHROiUJElDAJEfiAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0lBRKIiARaGErBB0ZjMQ0TEjMmloqRmBo0qJUHACBTKZjMm89JCFGAFqMBTCMVzdKI4CINEjJdLLqz2ZzxXVqFB6FKkQKAlL2aRdFoWCT6CJECKQSrdAQShsCGIkYbGMaRFcbbQ7fsLZaoVBgMABUKBV8vqLvZiOdrnAANEW6AVYQZeVx4ONgLwAeUcADkHABNWMBrAAWQLYACDkGdkGAEZS+WE1WAEylvx2OwAMWFKYFACEi1gANJYZtgfphuSh71yvVwfhasAJpPmsUqky0KKzpHtwajAKuFeUsdcideuqOxGQukMpkKtkRg-c3K8+eBvCnzHTmWQz+3pXvylqhq1Dzjq8oGka6oImab4PpS1q2vakKOs6cCughnqwVymR+gGIxdsGk5hhGZbRqWi7JlUAoZtmealoMxZ1hWVa1t2ZZMYMI6UWArYdl2XF9oOw4CkelonphdQ-pu-JgAJQ6cf+mIwBctBxHy9hOM4hGruuUm6Nuu77qJ74iboR79P0tA0uwKjkDe2hwDYtg1BiohlBArCDOg7BoKgAAkLRVD5vmSowOh9MsShgEsXxAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_g_bivariate.Rd b/man/tm_g_bivariate.Rd index fc0675ee3..80adf050e 100644 --- a/man/tm_g_bivariate.Rd +++ b/man/tm_g_bivariate.Rd @@ -25,7 +25,8 @@ tm_g_bivariate( ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), ggplot2_args = teal.widgets::ggplot2_args(), pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -100,6 +101,12 @@ with text placed before the output to put the output into context. For example a \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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_g_bivariate}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -115,16 +122,25 @@ This is a general module to visualize 1 & 2 dimensional data. For more examples, please see the vignette "Using bivariate plot" via \code{vignette("using-bivariate-plot", package = "teal.modules.general")}. } -\examples{ -library(teal.widgets) +\section{Decorating \code{tm_g_bivariate}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} +\examples{ # general data example data <- teal_data() data <- within(data, { require(nestcolor) CO2 <- data.frame(CO2) }) -datanames(data) <- c("CO2") app <- init( data = data, @@ -165,9 +181,6 @@ app <- init( selected = "Treatment", fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Bivariate Module") ) ) ) @@ -175,15 +188,13 @@ if (interactive()) { shinyApp(app$ui, app$server) } - # CDISC data example data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- c("ADSL") -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -224,9 +235,6 @@ app <- init( selected = "COUNTRY", fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Bivariate Module") ) ) ) @@ -235,3 +243,18 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHH+GRgmzPDs-QNdAL5dSmiowyp57BUjsQC8m1C4G3xCIqK6O6QwiRKJ9NostIFw692VuqGnu4lhpMwaiaKocAITxeLxS0Hg7wUYGmUP2zxBojgIg070RyNIfwBQI2IMq1Cg9CRkLAAGUkYDSLotHcCSJELCcbiCPkiLQCGJ3tTGPd6CJEszWezRMUMsBgFCYWAALpSuRw3EvNEUuD8YnECwM+G4ky0UIq94AMQAggAZEmuLWVLoguWM1jvFKfULfdQY-6A4G4sGwPQ7CWDTUKpUonbBt1Yz0K-GEvx+0nklFcnl0wMK3QCtkcnZJ2lwfkszPClJi-0DKEy22WxUJ8iquOCVBBADWcFTCpgwk0kV9umNZuc8rTOr1dd7pvNjKtjMrIMYRGyiRM6jglJ2jq+P3DHsnu3BPdLber6NRNcx26reIJRLjZOPOd5cHpeB3lQzQs5NIf+cFYhFQRL0IBtKsqDkGNb6nGdisACh4gsOEFjv2O7Wi8M4vG0i7LquHwbq6Z7YlW3oQnGkqgUeFInui+GRri0bXroUK3hR94ps+F7pgW77Zp+fJvr+xbioBZbAWhYHoghUJ2NUgTwGQsEvPBo59hOVYoVOzxdF0tAmLo7AqOQm7aI8ci2OUzyiIUECsEa6DsEsAAk9SlA5iKMDonRKLMShgLMUpAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIZMYGkJGl6NoWLQwnBgQM6rookjMmloqRmBo0qJUHACHiCQTMm89JCFGAFqM2TD8QzRHARBokXyBZdqbT6QyCdQoPR+Ui2QF+bTSLotFiZSJEFyQZLdAQShsCGIkWrGNj6CIrgbaEaPrlgMA2Ry2V8vnJubq6sLlXB+PL2QBxVx4HWSky0KK+pEAMUGowCrh5BP6DPdodYxNypKi5PUoppdNDdSZsBZuidI05IaTXqVgsh3spYsLNalMrlrLAipFqvVFrgWurnr11ttJr7lv1hrEB3CDorizArrTrdrIqjnYTAA1tavdDALrQ4mXY-HnB7PeHI37IaeE0XdCnkxe6owiAU0mcjSrISSyRT83FB8S3gf1nSHSVGx-XQoKpAsJV1aVZWof1u2VXszQ1Add2HKcbWNSFTXNSdRxnTJ53ZSsXTdF9ILrcgb3LdksAAWRwy8Iw3XQ70TXUnzqFcGW6T91DgaC-xzAC4KA1sQLLBcq1otd0IbejpJbYckI7Ji0MFIisMHJSCTwsdCInOArWnO050dSjF2XIzlI0Li2S8AB5RwADkHAATXY3Ury4niH34x8QX6fpaBMXR2BUcgAO0XE5FsGp8VEMoIFYQZ0HYNBUAAEhaKo8vyvlGB0PpliUMAli+IA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_g_distribution.Rd b/man/tm_g_distribution.Rd index 033161a0c..8931ba7b6 100644 --- a/man/tm_g_distribution.Rd +++ b/man/tm_g_distribution.Rd @@ -16,7 +16,8 @@ tm_g_distribution( plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -37,9 +38,7 @@ Defaults to density (\code{FALSE}).} \item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\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. +\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. List names should match the following: \code{c("default", "Histogram", "QQplot")}. @@ -59,11 +58,17 @@ Defaults to \code{c(30L, 1L, 100L)}. \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)\cr 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 +\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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_g_distribution}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -73,15 +78,45 @@ Module is designed to explore the distribution of a single variable within a giv It offers several tools, such as histograms, Q-Q plots, and various statistical tests to visually and statistically analyze the variable's distribution. } -\examples{ -library(teal.widgets) +\section{Decorating \code{tm_g_distribution}}{ + + +This module generates the following objects, which can be modified in place using decorators:: +\itemize{ +\item \code{histogram_plot} (\code{ggplot2}) +\item \code{qq_plot} (\code{data.frame}) +\item \code{summary_table} (\code{data.frame}) +\item \code{test_table} (\code{data.frame}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_g_distribution( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + histogram_plot = list(teal_transform_module(...)), # applied only to `histogram_plot` output + qq_plot = list(teal_transform_module(...)) # applied only to `qq_plot` output + summary_table = list(teal_transform_module(...)) # applied only to `summary_table` output + test_table = list(teal_transform_module(...)) # applied only to `test_table` output + ) +) +}\if{html}{\out{
}} +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + +\examples{ +\dontshow{if (require("ggpmisc", quietly = TRUE) && require("ggpp", quietly = TRUE) && require("goftest", quietly = TRUE) && require("MASS", quietly = TRUE) && require("broom", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # general data example data <- teal_data() data <- within(data, { iris <- iris }) -datanames(data) <- "iris" app <- init( data = data, @@ -90,9 +125,6 @@ app <- init( dist_var = data_extract_spec( dataname = "iris", select = select_spec(variable_choices("iris"), "Petal.Length") - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Distribution Module") ) ) ) @@ -100,14 +132,14 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +\dontshow{if (require("ggpmisc", quietly = TRUE) && require("ggpp", quietly = TRUE) && require("goftest", quietly = TRUE) && require("MASS", quietly = TRUE) && require("broom", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # CDISC data example data <- teal_data() data <- within(data, { - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- c("ADSL") -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] vars1 <- choices_selected( variable_choices(data[["ADSL"]], c("ARM", "COUNTRY", "SEX")), @@ -140,9 +172,6 @@ app <- init( vars = vars1, multiple = TRUE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Distribution Module") ) ) ) @@ -150,5 +179,20 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +} +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6B6BFR3rHxSSkuGVk53nkBRCbkoqRF0aUJyQ6VupnZnrVwfmAAsgCCAMrjrSVxHRVpPdX9PoP+TEREMNMxs+VdaUoAxLpSEGrUuvxQpFC6cAAesKgiSlc3BsZc1AD6b1A2r2utyMugA7rRSAALFTsP6REBKXS6HyhD7IxihJQAX0UECUaFQaJUEL8ECRf3KcMRuj4QhEonKdGapKRSNIMG+El+oVIGPogk01mprMuPO+WhYlKB3wevPUpG+olQcAILJFrL+0Hg5X8KNEEWF6tEcBEGnKxtNCqVKvYEoxUHoIm+BEhRFoBDEQz1-jkkX8AAVYtwMAAZCgSKE+w1I3Ei2O6XG42gmXTsFTkZiWHQ2WwIsm6UTQiCsUbodgEgAk3kileNjB0jFxWKUYCxAF0gA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6B6BFR3rHxSSkuGVk53nkBRCbkoqRF0aUJyQ6VupnZnrVwfmAAsgCCAMrjrSVxHRVpPdX9PoP+TEREMNMxs+VdaUoAxLoAwgAiAJLjJ7r8UKRQunAAHrCoIkp3DwbGXNQA+l8oDZPvdHkZdAB3WikAAWKnYQMiICUul0ozO4wAMj9dH8MEDEIhGBjsUoAL6KCAAKyIKn+AGs4KxRIiwbYIfw4CYoMJSP8CPxQgR-rT6UyWcBoPBWUC5ABdJRKLQsUQARlxBFhdIIYn+ojgIg0cH4fggaJVjFoUHoIgF2toutlYOAwH8pKx-nl8siBCGoywwyK-hOAHlHAA5BwATWDYHGzgAGv45HJcKjdAajeR+OUI44sZ6IFSlGhULiVDCzWigeUkRm+EIRKJyo3hGJq2i8TB-hJAaFSFb6IJNNYM13bgP-pa62D-i9B+p+aJUHA-eOJ7cwdK9Ml3ZjPXgNxOs2vSOVTxp9av1+bNxOtTqxOVLdbbXB7U-nQ9XfuyWBvV9f0AHFXDwXR-AAIWGLAAGksDVFM02PTdLxzcooJg+DEKPO97zRGA+Vod5d10AAxUYsQTdM8PwkxaGeE1ygoqjXFoicqXvZD2MzRcHmnFhZ34hdmCvFc107e8gR3DCwA9CIULRejqHIRhymU1TrwkxSu0tFtkj0tUaPwrtCJU4iRD2VIdM4zduPvCRGCIQRUAEtTkiBednkXMSb0kzdpNgUi-0PYy6NoFSZHUiLNPE28TItVUX1VIydIIoiSKslwbJQ2y0VsqkqVoExdHYFRVKXbRBlTXQUTvUR4QgVhRnQdgywAEm8SIOoNRgdEYKlySUMByXlIA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } } +} + diff --git a/man/tm_g_response.Rd b/man/tm_g_response.Rd index 6e9e1e93c..a75adb823 100644 --- a/man/tm_g_response.Rd +++ b/man/tm_g_response.Rd @@ -19,7 +19,8 @@ tm_g_response( ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), ggplot2_args = teal.widgets::ggplot2_args(), pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -80,6 +81,12 @@ with text placed before the output to put the output into context. For example a \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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_g_response}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -96,10 +103,20 @@ as frequency or density. For more examples, please see the vignette "Using response plot" via \code{vignette("using-response-plot", package = "teal.modules.general")}. } +\section{Decorating \code{tm_g_response}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + \examples{ # general data example -library(teal.widgets) - data <- teal_data() data <- within(data, { require(nestcolor) @@ -108,7 +125,6 @@ data <- within(data, { mtcars[[v]] <- as.factor(mtcars[[v]]) } }) -datanames(data) <- "mtcars" app <- init( data = data, @@ -134,9 +150,6 @@ app <- init( multiple = FALSE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Response Module") ) ) ) @@ -146,15 +159,12 @@ if (interactive()) { } # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- c("ADSL") -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -180,9 +190,6 @@ app <- init( multiple = FALSE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Response Module") ) ) ) @@ -192,3 +199,18 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlTCtLKJxur0E-RWmHbrsWroqugTsCoSs1Iuli1qiq7qLsFuLUiyLcrbl3ZVDfYyiwMBaALp3g1DiJuqkHezD-Tf3d12VAF8lACuko0KhBio8gszildABefwZXBjPhCEQDRFo4RiGHnXSkGCJCSJaqiVAkURwPH43TUKD0OB+RGLLBiCkQKm6AAK7VImzwY3xZI5XMRKUSYVIzA0iXJcHmQtpKWg8AR2zAXyuqyV+KpIg06v1CtIctQCpptPO9MZzI1AGUmSbdFoWLQGSJEDqzlbKgR8kRaAQxOrXYx3fQRIl-YHg6JihkbostQKHqVFUsVngNQdGEc5Cifb7jRo4Px1YsCMtvb7zjBhJpInpEQAxACCABl7c5C7XKiZaKEy+r213XEX8f9aQXdbpQuqJVKZab5YqJ+cVbBmxqUzXi07DYiSyvzWu+3SGUyK2BHQbSC63R64F7Bev8TGgyHEWGI1GP3GEyCJNNUuVM7nTBYwA2PYUBgfNez7Y9hxZKCBQQ2t62oRsRBHTtu3Q30ByHctWzw8daynSclSnLouloExJhUchl20aljjKMZREKCBWDbdB2HBAASepSiEqlGB0TpgSUMAATuIA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0g1RKgSKI4OjMZjqFB6HBqEiFGAsGJCRBiboAAo9UiiOkwjFk-FMlmQzJpaKkZgaNIEuAEUlkzGZN56SF0hajbkguW6YkiDRI7XSy5SmUazW6ClUmnKsABakG3RaFi0SkiRDq3mmgglDYEMRIh2MJ30ERXL20H0fXLAYAqkZqsBfL5VY1gABCAFksABpLAAJm5ujpXgA8o4AHIOACadLkch5psx+o0cH4tNTGezebwJs1MAutDiSt0ADFBqMAs46-XTLQos2kSOx653WT+pra93dFEkcLReLDahpbLNQrYIOY4su8uG7bdZDG-vDxuyebqa2bTrSPbHc64K7L1PdE9b1fUhf1A2DICwzRTIo3POMEyTYFrWcAANfM6SwQYvFcMAa0net7znK1MOwt0AN7ahNAHedR3HfDTRMGciOHWil3rVc5Q4uoOP6fpaBMXR2BUcg920Eka2qEFRDKCBWEGdB2DQVAABIWiqJTlOJRgdD6ZYlDAJYviAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index 466294031..3e961928c 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -23,7 +23,8 @@ tm_g_scatterplot( pre_output = NULL, post_output = NULL, table_dec = 4, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -93,6 +94,12 @@ with settings for the module plot. The argument is merged with options variable \code{teal.ggplot2_args} and default module setup. For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_g_scatterplot}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -107,16 +114,26 @@ trend line additions, and dynamic adjustments of point opacity and size through For more examples, please see the vignette "Using scatterplot" via \code{vignette("using-scatterplot", package = "teal.modules.general")}. } -\examples{ -library(teal.widgets) +\section{Decorating \code{tm_g_scatterplot}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} +\examples{ +\dontshow{if (require("ggpmisc", quietly = TRUE) && require("ggExtra", quietly = TRUE) && require("colourpicker", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # general data example data <- teal_data() data <- within(data, { require(nestcolor) CO2 <- CO2 }) -datanames(data) <- "CO2" app <- init( data = data, @@ -185,9 +202,6 @@ app <- init( multiple = FALSE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Scatterplot Module") ) ) ) @@ -195,15 +209,15 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +\dontshow{if (require("ggpmisc", quietly = TRUE) && require("ggExtra", quietly = TRUE) && require("colourpicker", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # CDISC data example data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- c("ADSL") -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -272,9 +286,6 @@ app <- init( multiple = FALSE, fixed = FALSE ) - ), - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Scatterplot Module") ) ) ) @@ -282,5 +293,20 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +} +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6BzgAepMwRUd6x8UkpLhlZOd55hETURIKMqLQEANYyZdGVCckOtUoAxLpSEGrUuvxQpFC6cIWwqCJK84sGxlzUAPpbUDabC0tGugDutKQAFirsR5EgSrrZno1w7NOipMStjEUEDeAGEAPIAJh2unBEKUAF8gUo0KhoSobn5gXMztUnq9dHwhCJRNVCcIxJi3m9SDB9hJ9mEFuQOq1SJSqW9qFB6HBZsl-ABlAhMmTrIikGG3IhdMQRfEcwq4s77FYldSkBmoOAEdkct5HaDwar+WFyrF63SiXnaiXJK0iDSa7W6i26Lk8vm6QXWjS6LQsWjckSIM2uqkEKUyknJf2MQP0ET7CPSggUo7AYAmyH+AC6OciOv8xAsZX8glQi16-jkclw8td9ptcH4xuaJbw9YtMGEmnWemSADEAIIAGQFzjr5tdJlohWb1WHY9cU45QIttc7uiG2MWKuKzEdoi1hZXVINsH7XrApo7p7ejd9dp9GqPzs3HPdvNbAuffoDQbgENbzDN5kyjapY3jRMwNTURHjODMszhMA8wLPw23CPAr3LSs4GrDc7ypB9yBbfkwBwqAq2AkDu2oXsRAXUdx0nEDTFnedByY5cwzXPUCItf4iEYfZ6G3I49zVQ9jxdDlzyNMibxYhtfyfB0X2k98qU-T1vTUv84wAoClLDGCxAg-8EzgJNI1gmTXXTTNr2zFD800jlCzAAAFLkyFLMA7FYLU-LsdwFngXysKLEhMMiMsK0ovCwF4njjOUtSON0AA5RwRxHVKux7Wg+0Ypd8r1Gc51I3RF3HTTkqpfi9VEWgAC8rNEpVd1VA91LfQi5MvJDQzSm1qmIp0T1Y7Tv1-SDDOGkybLMmMLOgpa4IcoaXLQqL21i8j4qomsyo5YiMri3CFtdWj6MvGqJzctjKpK2rCPqt5Go5RgiEufYTHUWJOqgCSeomuz9TOQ1Bqc5CTstFT4bUsHHumsifz0ubLKMx7TOjfSoKs3H4MWRCYdzfNdA87yoAi-aAqCyL-NCmkKFIfC4fvZ8Muy3KOYJQris40rHoqjL7rqzdPvDFo-oB20d2B7r1WR-rIYvVtFM04ixufFWpu5L80dm1bAKugT1vMgzLOslM0wQxyb1Qyn0Op2mr3pxK6eZ8K2aSqWLTOqqebyx6bqKhiheYkX2Kq8W3sl+teKBIFaBMXR2BUZl1W0L4a10F4sVEe4IFYId0HYFEABJvEiKurUYHRAQRJQwHhHMgA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6BzgAepMwRUd6x8UkpLhlZOd55hETURIKMqLQEANYyZdGVCckOtUoAxLoAwgAiAJIAypO6-FCkULpwhbCoIkorawbGXNQA+vtQNnur60a6AO60pAAWKuznkSBKutmejXDsEDEpGIrUYigg3wAgtN5gAZQ66Y4Yc6IRCMaFwpQAX3BACsiCoTr1WKI3tdbLd+HATFBhKQTgR+KECCd8YTiaJgNB4KTznIALpKJRoVAIlSPPwQ5bXarvL66PhCESiaqK4RiSXfb6kGAnCQnMKrcgdVqkTVa77UKD0ODUar+eYEI0yHZEUhTJ4EghiCLyi2FWXXE6bErqemiVBwAjmi3fc7cvTJfwY2G+qWx3SiW1R93JLMiDQGyPRv0Z3RWm12pNgebZjS6LQsWjWkSINNlrUET1dMTVRuMZv0EQM7ve3nXYDAZMw1Ngfn8yIlsCQgDirjwun8ACEALJYADSWAAjGVt3vDwAmfxyOS4UsZ-M5uD8e3LtftjsKum0HaJ3QAMUhWF5mcO90zLExaEKZ9qkA4DXHAi1wQzW9710IZpTWYNimYQsIyjGNY3jWA-2nTE8DQ75H3rPM63DYtCIzCtbVfWsC3dftB1bD8Oy7L1e2STiWzgEd+PHNZJzI2d50XPw33XSIzwPY9TzAXdlKvMAbzAz9MzomDq3Uw8TwoxDYxgb9f1goCQJ0z9IOgl9kjgkDKN0ZDY1QsyQSIRgTnoDDzmw0M8IYtziPgV8Ux42NqNzPT2KLAi3Mta0WOrNicwbJthLbUzdL4nsVUEnKhxEwqx0Ystzkk5cZ38GSUs7OTVwUzc1PPFSNyUy9VKwSFJja-wsGcFdZgAeQAORMjyOy83S4oM3RJscWFYTsjsLOoTQrOcmzQKahylpchC5rQ+bYtoAAvESAsDLCQ1w+jkrMuNrgTKL6vyss4uqOKkpLV6tWYqt2sy+shLKvKNrLCqBOygdhNEoqyQkqc6vImTdCXVrVKMrrtKaxanPa3Hvs2yyRGs+CYYzI6SZOtzZq1C6LUYIg7hOGlvXioLHrDAGqretYPuraLydiui-rowWmpB1ipch7iJYzOHioRrjytHDUavR8WsaXfHNMUsB+sGvrRom6br1Zn79JJla1tp8zKb-E7nYtenqdcoHme+W3vhBLn1Fie6oGCp7ZaBiLSIx2cPYSrLaMS-DAd0+WMsV0rlYTwPtfVpWtbE1GoFq-WF2xuSjb6gahtNy2ppmgPJfYpbHfWpqtp2qm9ppw6oOO-amfO0sPPBcFaBMXR2BUY0w20f4b10T4pVEF4IFYSF0HYEUABJvEiPes0YHQwWxJQwCxfkgA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } } +} + diff --git a/man/tm_g_scatterplotmatrix.Rd b/man/tm_g_scatterplotmatrix.Rd index 65672cb11..582d08917 100644 --- a/man/tm_g_scatterplotmatrix.Rd +++ b/man/tm_g_scatterplotmatrix.Rd @@ -10,7 +10,8 @@ tm_g_scatterplotmatrix( plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -34,6 +35,12 @@ with text placed before the output to put the output into context. For example a \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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_g_scatterplotmatrix}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -47,7 +54,20 @@ providing the overview of correlations and distributions across selected data. For more examples, please see the vignette "Using scatterplot matrix" via \code{vignette("using-scatterplot-matrix", package = "teal.modules.general")}. } +\section{Decorating \code{tm_g_scatterplotmatrix}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{trellis} - output of \code{lattice::splom}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + \examples{ +\dontshow{if (require("lattice", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # general data example data <- teal_data() data <- within(data, { @@ -81,7 +101,6 @@ data <- within(data, { profit = rnorm(50, 20, 10) ) }) -datanames(data) <- c("countries", "sales") join_keys(data) <- join_keys( join_key("countries", "countries", "id"), join_key("sales", "sales", "id"), @@ -130,15 +149,15 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +\dontshow{if (require("lattice", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # CDISC data example data <- teal_data() data <- within(data, { - ADSL <- rADSL - ADRS <- rADRS + ADSL <- teal.data::rADSL + ADRS <- teal.data::rADRS }) -datanames(data) <- c("ADSL", "ADRS") -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -182,5 +201,20 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CmlCkmgRw-ri6XrRwpNSsugC89k7OihAAxLpSEGrUuvyBULpwAB6wqCJK+aSFRrpc1AD6VVA2lQUGxgDutKQAFirszeEgSrq6xOakjFGiHXkFGCbM8H4QY2O0-AnjfmAAIq54uv4AYlhhx2AAknYX-s4AyndgAAq3R-4A4ucfYAByABlngAhQ7hfwAxzPACC7zkuFG6wkRB0jAg8DI2xM6lIREYq3W6wI7AATOEyboKQBGcm03Q0+nhBkk+GIwnUKD0ODUWaJYn+ACyJBYBF6rGeWDgqEE9DoBH8qUJrLW6w5EAkgigUga2JgtFiWJxeIJhJ2DIAzOFLbprdbqUyrUzlabdByuTztvywJ8ZDAoMp5b8ABLckQBiVEP0WUJgRXrZ3rVBEaUczQkT3sAAc1oAbAB2cI5gAM4QALAX6SX6QyqRWqQyixgc+EAJwJsYsOCFPnsc0AVgrfb7FqLDL7Rb7rep5oppZH5Kb4Wz7cy-FQGfNGFLC4rJIwNa34Ub1sbFMbFcbk90jYbW5X-Dg9FIGb3zIwdsPlMXX4-25-C7-PdfzjONRG4MQ5maRZljgE0Ni2RIqUQccERVMYJjINgGk2bYwJgcpYLZIldgOZ4zmeG5nkeZ43meb5nkBEEwUuSEYThVCXVEWgAC89ESFCiLGdxynUPikhcIiV1YLtGFwvFSHYPCCNJUci0QEkiw08IUN0YSORCbYHBcOQVx0CBBDEpSRHYL1RD9ahqGeeB+FoQQYGeDlGCkZ4SDobIFW0qs9NEwzkhXAh-RCBy4AQ3QrNg4kjOccITmhAEHhSQLwmCgzEiSlcvH9TRSDiRI0TxGB2B0qkiyrDTwqIURSF5XSIAqqqq0zOqixXVBGCIEwem2crGEqnStMrEClAAX1SAArIgVAaABrOBWFEQYClsWoFqW1b1pNXaIBWtbdgwqYZmec7pjEZ5NgCxEjpOjh-DAkRRGeN7bt+e7Yw43Qnv2s6iEmG6Pt+L7wfCL1fu2fxrtYbD+AVVJUiUNB11qFQehNZptiGRE+CEd7tiJ4QxDguoYAaCQGlECKghkcoiFIP0LuKSmxjdbk4bAB4GfIRhmefNnpmKMJBN0LQWFoTkScSOgms59ZmgaEophxOnUDgfk0JdeZqmgeBeeuy68ElwlRG5HXn0SK2RA0LWdeVl1udyRJ-Aea2NClmW5bERAJb1-Xxl6RaQha6Xpn9hpRXDinmmAYB4ZBzCzYAXXTlcQ-tm2YozfxOygZ4JDXZ4HyfB7g-1mBhE0AjQpcf6Q7GPEH3cWKkublvBuKfPElS9LXGrpULd0bOVYKNXig1x3RG13WW4N-1YDE17wKhsexkG6hBaxfVBadxel9dTkeY9vnvefKPZdlOBA-NkfTSjlqU9BxHfu7kO49oCPtml6gFlY5h1-gnAoSd17vX8JncEhBU5TA-sjP6W91i5w0P3HY-hSK-HIr8SivxqK-For8eivxGK-FBM8VivxYRVxProWuu9aANzyskFBE9LZX1wlfI+LtTRu15l7B218-Z31EA-L++sf5-0SDfGO0iwHVAgWASG0D07Q12IVMgPRxS-GIE1KGlw+oDR6CjSRnEr4YK9Fo4qujYH6Oas8Yxg1SB0JPow+uIhG7JRQa3Rg7cMFd18aYWgfdYqDwyuwsecZR56ymhAVItATC6HYCoQWOJtCwRMroEYKpRD9AgKwaE6B2AYwACTeHCOUq2jBUSpGmkoMA0105AA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CmlCkmgRw-ri6XrRwpNSsugC89k7OihAAxLoAwgAiAJIAypm6-IFQunAAHrCoIkolpGVGulzUAPr1UDZ1pQbGAO60pAAWKuwd4SBKuroAgtn5ADK9zXDcGB2IiIxzi1Oz2Vj5yy3rpZvbB-lKAL6pAFZEKq0A1nCsomOltk38cCZQwlIrQI-FoogIrQeT1e72A0HgHw6cgAukolGhUMsVIM-BBph0EsVSrg9nwhCJRISycIxLjptNSDBWhJWuDAuRGDUiIzAoxaBU6fTptQoPQ4NRCf58gR2TIuaRdDBefywnshVoWLRRRTCXRRKRBUL8aVWpVSMwNKzUHACIajcaGvC9Il-DsFqq8fb6aJxTaFYkfSJLaJrba1V7haLxZKwPlfRpdBq+dqxIgPRGhQQho8QpTEkmtfQRMDs7Rc58GsBgK75u6wMjkXISZ6M7pA364PxCWGwDMAOKuPC6fxYGaZQfhKXOAAa-ib4YjMEBtBqzqSLmbremREYv3cXcSDg3C69Jn5ncJADEZgt8q4W17UhH5w+hR1TRVzeogSGbXb7R0ToxnMhzphmZ7UByhIQRyVp-ie9oimKEourG8YKhQ-CoI8ZCiGmeAIUaSZ5roPYAAozKOACyORhMOvYAGoFLkdhzpuW5ZjmYiEhq1CCHAJZcYipRVjWoH1si4TkZRMw0dkdGukx+QsWxpF+GAFHUQpjHMaxYByC+W5tuhF6obkAByDHOHYujGM45nZLoADyl66BZ2SOJkdi5E55lga2S6QSuIiEke96toZGbtgmAboXBYavl6SHRqhcZBgqBYpnh-kZpxZbcfmmopoJ+XCZW1a9pc-gNpFrbReQB5qa6A7aTMDE3q12QAJpsYRQqBZoq6hck7Gtjue6meuzijeB56Ndet7hRmT6PieK3TCtqSpLQJi6OwKgct+2hwDYtiTJ6ogjBArAzOg7AYgAJN44SPT6jA6IwqTXEoYDXMiQA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_missing_data.Rd b/man/tm_missing_data.Rd index 878adeb14..86517c88c 100644 --- a/man/tm_missing_data.Rd +++ b/man/tm_missing_data.Rd @@ -14,7 +14,8 @@ tm_missing_data( list(caption = NULL)), `Combinations Main` = teal.widgets::ggplot2_args(labs = list(title = NULL))), pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -33,9 +34,7 @@ ignored.} \item{ggtheme}{(\code{character}) optional, specifies the default \code{ggplot2} theme for plots. Defaults to \code{classic}.} -\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. +\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. List names should match the following: \code{c("default", "Summary Obs", "Summary Patients", "Combinations Main", "Combinations Hist", "By Subject")}. @@ -47,6 +46,12 @@ with text placed before the output to put the output into context. For example a \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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_missing_data}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -57,19 +62,40 @@ 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) - -# module specification used in apps below -tm_missing_data_module <- tm_missing_data( - ggplot2_args = list( - "Combinations Hist" = ggplot2_args( - labs = list(subtitle = "Plot produced by Missing Data Module", caption = NULL) - ), - "Combinations Main" = ggplot2_args(labs = list(title = NULL)) - ) +\section{Decorating \code{tm_missing_data}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{summary_plot} (\code{grob} created with \code{\link[ggplot2:ggplotGrob]{ggplot2::ggplotGrob()}}) +\item \code{combination_plot} (\code{grob} created with \code{\link[ggplot2:ggplotGrob]{ggplot2::ggplotGrob()}}) +\item \code{by_subject_plot} (\code{ggplot2}) +\item \code{table} (\code{\link[DT:datatable]{DT::datatable()}}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_missing_data( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + summary_plot = list(teal_transform_module(...)), # applied only to `summary_plot` output + combination_plot = list(teal_transform_module(...)) # applied only to `combination_plot` output + by_subject_plot = list(teal_transform_module(...)) # applied only to `by_subject_plot` output + table = list(teal_transform_module(...)) # applied only to `table` output + ) ) +}\if{html}{\out{
}} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} +\examples{ +\dontshow{if (require("gridExtra", quietly = TRUE) && require("rlang", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # general example data data <- teal_data() data <- within(data, { @@ -88,32 +114,50 @@ data <- within(data, { mtcars[["cyl"]] <- as.factor(mtcars[["cyl"]]) mtcars[["gear"]] <- as.factor(mtcars[["gear"]]) }) -datanames(data) <- c("iris", "mtcars") app <- init( data = data, - modules = modules(tm_missing_data_module) + modules = modules( + tm_missing_data() + ) ) if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +\dontshow{if (require("gridExtra", quietly = TRUE) && require("rlang", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # CDISC example data data <- teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL ADRS <- rADRS }) -datanames(data) <- c("ADSL", "ADRS") -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, - modules = modules(tm_missing_data_module) + modules = modules( + tm_missing_data() + ) ) if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBKMtPzOAB6kzP64ul60cKTUrLoAvPZOzrYAZJm67rG+-ozUUBASUTHe8YkpaS6KEADEulIQatS6cKGwqCK6-FCkUEr9gwbGXNQA+iNQNsMDUGO6AO60pAAWKuwz0SBKurme3r6toqTE1ESM9fu6UPz8k9CiS2YWmtahtnsQBwehwFE3RE7FEnkm3BIEnYX2iJkuV3YIlKGxhtgAVLlzLQTOwAIzRDAABgArIS8QB2OTUgC6SwAcgBBW7-W4AXyUtx8tBeRl03NEtxg5xYvOMwoIos5v35QVEwDpfOK6ES7AF0Xuj2e9QOEtFCqWyp6HD1jFEGoeTygoh1ulN8uA-gIrGo-hpiuM1owJnUpER9uAjsILrdNNtAaDUhYoaWXp9Gn9IrNgf8UcYofqbJu0HQSxUaz8MpmNR2QoEwjENT4QhEokLf10pBgkxgPNEKgk0wWcxl9XqON0atUzEsOhs31uok2EFYjPQ7DQqAAJN4Negl2DGDprkoORAwGyaUA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBKMtPzOAB6kzP64ul60cKTUrLoAvPZOzrYAZJm67rG+-ozUUBASUTHe8YkpaS6KEADEugDCACIAkgDKzbpwobCoIrr8UKRQSiNjBsZc1AD6k1A2E6NQ07oA7rSkABYq7IvRIEq6uZ7evhBipMTURIz1pwCCrZ0AMuuzGIuIiIwv7xOuheWE663+rVBSgAvvUAFZEFRzADWcFYogOq1sRmGcBMUGEpDmBH4tFEBDmCKRqPRwGg8AxizkAF0lEo0Kh1iptn4IKdFjVDkC+EIRKIaiLhGJeadTqQYHMYGTRCoJAtVss+bp6vVaCZdOwVORmJYdDZbMctaI9hBWE90OwOQASbzRZ2iGQ6B4wpRgaHMoA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index 4ca23deeb..04a0761ed 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -13,7 +13,8 @@ tm_outliers( plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -28,11 +29,9 @@ specifies the categorical variable(s) to split the selected outlier variables on \item{ggtheme}{(\code{character}) optional, \code{ggplot2} theme to be used by default. Defaults to \code{"gray"}.} -\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. +\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. -List names should match the following: \code{c("default", "Boxplot","Density Plot","Cumulative Distribution Plot")}. +List names should match the following: \code{c("default", "Boxplot", "Density Plot", "Cumulative Distribution Plot")}. For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} @@ -48,6 +47,12 @@ with text placed before the output to put the output into context. For example a \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{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_outliers}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -57,8 +62,39 @@ 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. } +\section{Decorating \code{tm_outliers}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{box_plot} (\code{ggplot2}) +\item \code{density_plot} (\code{ggplot2}) +\item \code{cumulative_plot} (\code{ggplot2}) +\item \code{table} (\code{\link[DT:datatable]{DT::datatable()}}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_outliers( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + box_plot = list(teal_transform_module(...)), # applied only to `box_plot` output + density_plot = list(teal_transform_module(...)) # applied only to `density_plot` output + cumulative_plot = list(teal_transform_module(...)) # applied only to `cumulative_plot` output + table = list(teal_transform_module(...)) # applied only to `table` output + ) +) +}\if{html}{\out{
}} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + \examples{ -library(teal.widgets) # general data example data <- teal_data() @@ -66,7 +102,6 @@ data <- within(data, { CO2 <- CO2 CO2[["primary_key"]] <- seq_len(nrow(CO2)) }) -datanames(data) <- "CO2" join_keys(data) <- join_keys(join_key("CO2", "CO2", "primary_key")) vars <- choices_selected(variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment"))) @@ -97,11 +132,6 @@ app <- init( multiple = TRUE ) ) - ), - ggplot2_args = list( - ggplot2_args( - labs = list(subtitle = "Plot generated by Outliers Module") - ) ) ) ) @@ -110,17 +140,19 @@ if (interactive()) { shinyApp(app$ui, app$server) } + # CDISC data example data <- teal_data() data <- within(data, { - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- "ADSL" -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl)) + + app <- init( data = data, modules = modules( @@ -147,11 +179,6 @@ app <- init( multiple = TRUE ) ) - ), - ggplot2_args = list( - ggplot2_args( - labs = list(subtitle = "Plot generated by Outliers Module") - ) ) ) ) @@ -161,3 +188,18 @@ if (interactive()) { } } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLqkQ11XfxQpFC6cAAesKgiSoHBBsZc1AD6sVA2MUEhRroA7rSkABYq7Km4uiBKuroAwgDyAEzxNQ2VzfXAwApgqIy0MCysSQDWcKxdALrjTaJwAI5JIhDsEIxEOex19XKKEAC+OwBWRCrDo6IlmbbZRycjrOc3EKccXZtdZa8teLpdPX0Dzy623cWhYoiaBAKxwIYiSMxEGjg-HYoN6UHoIiSkOhYguwQ6n3qE3GZQI7C6AAVqFAyO8fmA7KxUHA6V07Iw4EF4LSwNsdko0Kgmip8uSIFVUroALwBTK4Vp8IQicEyxXCXGtKqkGBJIiCUh0GTnTVVXR6g20GRJVHS3R0USkMWm52y4JJcKkZgaOHMskml2ummwPQywnvf0u+FwDS2qPe0S+p0Bl3U+hwfyhsAAZXT0dIulRtHRIkQ4fFyed2NoMJVBZYRYxcCxUOruNSBLAbzAk1J5MIJAIrLAglQwRGQLk8vLFaqcfI-FtXRHY5ZeAjAZgwk0URDugAYgBBAAyWecU5nppMtDCSNth5PrmnyZ2FZfLsnEYIQTgEiIvS-yQ2jK9qOuugbumEnrqKQPrRkmFapNA8CLp2XznjOV7UOQjC2ph2GwX6T4VqitYkehF5VjWtqgtQghNpRbaZB2XY9nWjCiAAJHOSIfkRybcQuMo0XRzY4uc7adKhRLdiSbGcQJvEXlUm5YbQO62g4LhgVUb4Brppr6W+Ow7LQJi6OwKjYdB2hwDYtgVOWohFBArAHug7CChxgi0GUnkzIwOiMDsuxKGAuzjEAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLoDCAEQCSAMreuvxQpFC6cAAesKgiSmERBsZc1AD6SVA2ieGRRroA7rSkABYq7Fm4uiBKuroAgr6BADIpumkYWYiIjE2tSgC+ihAAVkQq6QDWcKyilXm2BfxwJlDCpOkE-LSiBOnjkzNzwNDw81lyALruaxrpWiyi6VD8otTtZ2LsAGK01ORGOxdg4XNVRGh4hwssBgAowP0WvCrldqrsMHdSERGHJcUpHoxRO0CKUJgQxOlRHARBo4Px2ATaFB6CItqTaOSLnlYfDEcjUaZ1JsCc9Xu88RB3EpIe0VCV2HVQnldABeJURXCKvhCEREtXa4TfRX1UgwdJEQSkOgyebG+q6C1W2gyB4sVW6OiiUgKiD2v3qqDpGKkZj3USoOAEH3+-1ZL7u3nNJF4O0xqk00ju9ORzbhyPRmP+6jM6kJsCBak53SM5kiRDwzW+wt+klksTumssuBsttciI8hFJ-nVKO8gDirjwunhACEALJYADSWAAjPDcY3m37s7T+GWGhOG6nCzANrR4no1T8Gi1As5N1v6iZaNE6e7r7fXE3myMf8e5A+LbhHAEjYhy3Cuow7qet6x71FkQbRCGQqUhGo7foWcawJe06DgMKYYTGz4AjI7rEYCqH5nB-oih2TyAVurYcu2aqPNQgjdkxnILP2cJ4cmKLVCKAAkO7kPwAHUdula7nR7Gcey3EwnxfJgIJ1ZPKJMniZJhEnmeF7uqCX6Pr+hZmX6Fm6GZIwjLQJi6MCqihpoOg2LYtRNqI5QQKwDToOwkLCYItDVEFVKMDoOJDEoYCDFcQA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_t_crosstable.Rd b/man/tm_t_crosstable.Rd index 54b96b06e..b44c4ec94 100644 --- a/man/tm_t_crosstable.Rd +++ b/man/tm_t_crosstable.Rd @@ -12,7 +12,8 @@ tm_t_crosstable( show_total = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -49,6 +50,12 @@ with settings for the module table. The argument is merged with options variable \code{teal.basic_table_args} and default module setup. For more details see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_t_crosstable}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -61,10 +68,21 @@ options for showing percentages and sub-totals. For more examples, please see the vignette "Using cross table" via \code{vignette("using-cross-table", package = "teal.modules.general")}. } +\section{Decorating \code{tm_t_crosstable}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{ElementaryTable} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. +} + \examples{ +\dontshow{if (require("rtables", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # general data example -library(teal.widgets) - data <- teal_data() data <- within(data, { mtcars <- mtcars @@ -73,7 +91,6 @@ data <- within(data, { } mtcars[["primary_key"]] <- seq_len(nrow(mtcars)) }) -datanames(data) <- "mtcars" join_keys(data) <- join_keys(join_key("mtcars", "mtcars", "primary_key")) app <- init( @@ -101,9 +118,6 @@ app <- init( multiple = FALSE, fixed = FALSE ) - ), - basic_table_args = basic_table_args( - subtitles = "Table generated by Crosstable Module" ) ) ) @@ -111,16 +125,14 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +\dontshow{if (require("rtables", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # CDISC data example -library(teal.widgets) - data <- teal_data() data <- within(data, { - ADSL <- rADSL + ADSL <- teal.data::rADSL }) -datanames(data) <- "ADSL" -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, @@ -153,9 +165,6 @@ app <- init( multiple = FALSE, fixed = FALSE ) - ), - basic_table_args = basic_table_args( - subtitles = "Table generated by Crosstable Module" ) ) ) @@ -163,5 +172,20 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} } +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsIykUPQiov64ul60cKTUrLoAvPZOzooQAMS6UhBq1Lr8UEG6cAAesKgiSgVFRrpc1AD61VA2VYVQBsYA7rSkABYq7M0RIEq6ujCkBCyinRNTM2OmRIy67Fq6KroEfoSs1OG6-lpheEcoMIf+Uiz+crajEOPjk9OMosDAWgC633NQ4hM6lIK3Yrxmnx+3zS4wAvktwe9Pv5UIxaDAWKwGgBrOCsfy-OaiTwNEQQdgQRhELpghbve5KWFpABWRBUOLxoiG7VstVZ7NxrC5-IgHI4-kRpwiErpUvOqPRmLFdzSSjQqDmKl6fie+XaiT1QVwCIEwjEBr4QlCOuedRgDVIDQIVNEoiCITgNttumowTgeSS-gAwi7ZnZgpU8EtbSUDc0GqVSMwNA1RKg4Dto97mtB4AaZW8pVnbcSRBoDaWM460xmvd7nr76P782AAMr+qu6LQsWgRuCIcLF70EPpsgjmpLdtF9p2j2jjrnNZFgSUE74RTN7A5nY5y-ywK5gG6MFXG3X18aVjRwfgGzcEfaH493M8X54wYSaCp6JIOFyvt9dBWfgZBvA0-2cAC3xMWgSjApIADEAEEABlW1cc9vRhLCoOeeIknjRNk2rdNM0w20c1gH9zlXKNyOeK9SArDsUxrMjAJ9P0A3OdsyyYqdew9Ac6I4kcxwnLsexnMT5zEbkgmXWjfg3XYH23aUwBOQ8Dx3I84FuMB7lw+tGPg84tJEwCP2oL8RANZC0MgodbRguDb0Q1D0Oc3RsNtXyfKWNI0loEw1hUchiO0T17l0R5LwGCBWCQ9B2HVAASbwInS4lGB0Rg0nhCAwFhb4gA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsIykUPQiov64ul60cKTUrLoAvPZOzooQAMS6AMIAIgCSAMpZuvxQQbpwAB6wqCJKpeVGulzUAPoNUDb1ZVAGxgDutKQAFirsHREgSrq6AII5BQAyfc1w3BgdiIiM80tKAL5pAFZEKq0A1nCsouM9tk38cCZQwqStBPy0ogStJ2eX12A0HgNw6cgAukolGhUCsVEM-BAZh1EiUerhpro+EJQqjscIxIiZjNSDBWm8CIwiKJREEQnAicSZtRgnBqKj-FkqTT7ME6nhMUzKqiOq0qqRmBpWqJUHACIymciesC9El-LtFuFBYrRGy5aRUbqRFKZXKFYrmaz2WqwAU9RpdFoWLQ+XBEFqkRbiQRhqcCGJUU7GC76e9fbR-aCesBgOqFpqwODwRFRIJ6LqDUkzBZNNYwbopp6vcTaPxhU0AIRO9BxW5BCIqYYyIaiCLUIgSCPcdgARjkEXl-hyZTg4V0-gACgB5Ap5AAaGjHk5n8+opH8cjSxaZ7lIgkYEHYKqjQTkwFLlXBW+3hwxRa9Rv1cH4HLAWSnjgAcg4AJoe7dYq8tC1KqyQuHeAFEIwjzuC+SQOOB2oWiYtCVM+qIAGKzIsBSuPeTLXgREGKvESSiuKkpvKag74cSHQqq+Gr-g+9qZroj4mrKNEASy9Bsq+drGgaQYhiI7oCrRTI+n6AZJCJrphjJJ5QDGcZ7ImybsWmGaotmlh5ncBZIV6F4rNWtQcBMuhfBgzwaFBbYdl21C9puxkWru+6HsedZQGeF5Xu5xK3kFMwceQcHjrazhzsxxYwEBIGYdhuHEcWKFoZFWE4XhxaEcS+XXmkaS0CYujsCo5CUdoDKbkZnqiKMECsLM6DsDCAAk3gRJ1uqMDojBpPsShgPs4JAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + diff --git a/man/tm_variable_browser.Rd b/man/tm_variable_browser.Rd index 00d3548b7..460f1a9b2 100644 --- a/man/tm_variable_browser.Rd +++ b/man/tm_variable_browser.Rd @@ -54,16 +54,7 @@ or continuous with a checkbox allowing users to switch how they are treated(if < then the default is discrete, otherwise it is continuous). } \examples{ -library(teal.widgets) - -# Module specification used in apps below -tm_variable_browser_module <- tm_variable_browser( - label = "Variable browser", - ggplot2_args = ggplot2_args( - labs = list(subtitle = "Plot generated by Variable Browser Module") - ) -) - +\dontshow{if (require("sparkline", quietly = TRUE) && require("htmlwidgets", quietly = TRUE) && require("jsonlite", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # general data example data <- teal_data() data <- within(data, { @@ -73,31 +64,54 @@ data <- within(data, { faithful <- faithful CO2 <- CO2 }) -datanames(data) <- c("iris", "mtcars", "women", "faithful", "CO2") app <- init( data = data, - modules = modules(tm_variable_browser_module) + modules = modules( + tm_variable_browser( + label = "Variable browser" + ) + ) ) if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +\dontshow{if (require("sparkline", quietly = TRUE) && require("htmlwidgets", quietly = TRUE) && require("jsonlite", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # CDISC example data +library(sparkline) data <- teal_data() data <- within(data, { - ADSL <- rADSL - ADTTE <- rADTTE + ADSL <- teal.data::rADSL + ADTTE <- teal.data::rADTTE }) -datanames(data) <- c("ADSL", "ADTTE") -join_keys(data) <- default_cdisc_join_keys[datanames(data)] +join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, - modules = modules(tm_variable_browser_module) + modules = modules( + tm_variable_browser( + label = "Variable browser" + ) + ) ) if (interactive()) { shinyApp(app$ui, app$server) } - +\dontshow{\}) # examplesIf} +} +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsKKoLADWdBBw-ri6XrRwpNSsugC89k7OtgBkGbruMb7+ABakMNQA7rT8UqSikdHecQnJqS6Z2bne+WAAVqIkdOS1MQ2JKQ4tSgDEulLhsrr8UKRQunAAHrCoIkoLSwbGXNQA+jtQNtuLy0a65aQFKuwnUSBKuro+tKJ7b4wfL7owpAILE+VwBQMYNQgr1KRHgUKuMLhfxMUFotzM1C+KLRBQxfwAwgB5ABMXyJxKUAF9FBAlGhUF8VGi-FD5hcmo8-nwhCJPilucIxCzXq9ioctCxaFB6CJDkwiKVRDJhSLXtRpXBMSl-AA1SXSkS6eWKmT+P6vGkWpQ02gmXTsFTkZiWHQ2WzPVmiO4QVgAQXQ7HpABJvFFg0rGDpGDTKUowJSALpAA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } + \item{example-2}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsKKoLADWdBBw-ri6XrRwpNSsugC89k7OtgBkGbruMb7+ABakMNQA7rT8UqSikdHecQnJqS6Z2bne+WAAVqIkdOS1MQ2JKQ4tSgDEugDCACIAkgDK07pwAB6wqCK6-FCkUEp0TCwcgSFhcIoQu-sGxlzUAPo3UDZKL3e65aQFKuwvURASl0ugAgrNFgAZT4PDAvRCIRjgqHAsGzOx2ZwwuDcOF7KAIpHozFKAC+Vy6RBUj2CcFYon++NsRh2cBMUGEpEeBH4tFEBEelOptPpwGg8AZLzkAF0lEo0KhPipaKQ-BAQR8UgDUXwhCJRE1dcIxGqQSDio8tCxaFB6CJHkwiKVRDJTWaQdRbXBqE1-AA1a227aO50yfyokFXSNKK60Ey6dgqcjMSw6Gy2IHq3SiX4QVig9DsBUAEm8URLLsYOkYV1JSjApOlQA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } } +} + diff --git a/staged_dependencies.yaml b/staged_dependencies.yaml index 16fdd83d9..d484dfe68 100644 --- a/staged_dependencies.yaml +++ b/staged_dependencies.yaml @@ -5,6 +5,9 @@ upstream_repos: insightsengineering/nestcolor: repo: insightsengineering/nestcolor host: https://github.com + insightsengineering/roxy.shinylive: + repo: insightsengineering/roxy.shinylive + host: https://github.com insightsengineering/teal.logger: repo: insightsengineering/teal.logger host: https://github.com diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R index 3e9e7cf6b..f25a725ce 100644 --- a/tests/testthat/helper-TealAppDriver.R +++ b/tests/testthat/helper-TealAppDriver.R @@ -31,22 +31,18 @@ simple_teal_data <- function() { iris <- iris mtcars <- mtcars }) - teal.data::datanames(data) <- c("iris", "mtcars") data } simple_cdisc_data <- function(datasets = c("ADSL", "ADRS", "ADTTE")) { datasets <- match.arg(datasets, several.ok = TRUE) - data <- within( - teal.data::teal_data(), - { - require(nestcolor) - ADSL <- teal.modules.general::rADSL - ADRS <- teal.modules.general::rADRS - ADTTE <- teal.modules.general::rADTTE - } + + data <- Reduce( + x = datasets, + function(u, x) eval_code(u, sprintf("%1$s <- teal.data::r%1$s", x)), + init = within(teal.data::teal_data(), require(nestcolor)) ) - teal.data::datanames(data) <- datasets + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datasets] data } diff --git a/tests/testthat/helper-functions.R b/tests/testthat/helper-functions.R index 1bc8546bb..4eb8908de 100644 --- a/tests/testthat/helper-functions.R +++ b/tests/testthat/helper-functions.R @@ -10,3 +10,17 @@ mock_data_extract_spec <- function(dataname = "MOCK_DATASET", ) ) } + +normalize_math_italic_text <- function(text) { + # Unicode range for mathematical italic (uppercase/lowercase) + math_italic <- intToUtf8(seq(0x1D434, 0x1D467)) # A-z + + # Standard letters + latin <- c(LETTERS, letters) + + # Replace math italic letters with standard ones + stringr::str_replace_all( + text, + setNames(latin, unlist(stringr::str_split(math_italic, ""))) + ) +} diff --git a/tests/testthat/test-examples.R b/tests/testthat/test-examples.R index a82ee89dc..09f0b9e1c 100644 --- a/tests/testthat/test-examples.R +++ b/tests/testthat/test-examples.R @@ -47,14 +47,21 @@ with_mocked_app_bindings <- function(code) { args <- list(...) args[["launch.browser"]] <- FALSE # needed for RStudio - app_driver <- shinytest2::AppDriver$new( - x, - shiny_args = args, - timeout = 20 * 1000, - load_timeout = 30 * 1000, - check_names = FALSE, # explicit check below - options = options() # https://github.com/rstudio/shinytest2/issues/377 + app_driver <- tryCatch( + shinytest2::AppDriver$new( + x, + shiny_args = args, + timeout = 20 * 1000, + load_timeout = 30 * 1000, + check_names = FALSE, # explicit check below + options = options() # https://github.com/rstudio/shinytest2/issues/377 + ), + error = function(e) { + e$app$stop() # Ensure the R instance is stopped + stop(e) + } ) + on.exit(app_driver$stop(), add = TRUE) app_driver$wait_for_idle() @@ -144,6 +151,7 @@ for (i in rd_files()) { testthat::test_that( paste0("example-", basename(i)), { + testthat::skip_on_cran() skip_if_too_deep(5) testthat::skip_if_not_installed("pkgload") if (basename(i) %in% strict_exceptions) { diff --git a/tests/testthat/test-shinytest2-tm_a_pca.R b/tests/testthat/test-shinytest2-tm_a_pca.R index 9c5bd6b7a..7e3badac7 100644 --- a/tests/testthat/test-shinytest2-tm_a_pca.R +++ b/tests/testthat/test-shinytest2-tm_a_pca.R @@ -5,8 +5,6 @@ app_driver_tm_a_pca <- function() { USArrests <- USArrests # nolint: object_name. }) - teal.data::datanames(data) <- "USArrests" - init_teal_app_driver( data = data, diff --git a/tests/testthat/test-shinytest2-tm_a_regression.R b/tests/testthat/test-shinytest2-tm_a_regression.R index ee09a7656..143956043 100644 --- a/tests/testthat/test-shinytest2-tm_a_regression.R +++ b/tests/testthat/test-shinytest2-tm_a_regression.R @@ -3,7 +3,6 @@ app_driver_tm_a_regression <- function() { require(nestcolor) CO2 <- CO2 # nolint: object_name. }) - teal.data::datanames(data) <- c("CO2") init_teal_app_driver( data = data, diff --git a/tests/testthat/test-shinytest2-tm_g_association.R b/tests/testthat/test-shinytest2-tm_g_association.R index a5219639e..b1ac33d87 100644 --- a/tests/testthat/test-shinytest2-tm_g_association.R +++ b/tests/testthat/test-shinytest2-tm_g_association.R @@ -3,10 +3,9 @@ app_driver_tm_g_association <- function() { require(nestcolor) require(ggplot2) CO2 <- CO2 # nolint: object_name. - factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) - CO2[factors] <- lapply(CO2[factors], as.character) # nolint: object_name. + .factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) + CO2[.factors] <- lapply(CO2[.factors], as.character) # nolint: object_name. }) - teal.data::datanames(data) <- c("CO2") init_teal_app_driver( data = data, diff --git a/tests/testthat/test-shinytest2-tm_g_bivariate.R b/tests/testthat/test-shinytest2-tm_g_bivariate.R index 146f53a4f..9be35efe6 100644 --- a/tests/testthat/test-shinytest2-tm_g_bivariate.R +++ b/tests/testthat/test-shinytest2-tm_g_bivariate.R @@ -4,7 +4,6 @@ app_driver_tm_g_bivariate <- function() { require(nestcolor) CO2 <- data.frame(CO2) # nolint: object_name. }) - teal.data::datanames(data) <- c("CO2") init_teal_app_driver( data = data, diff --git a/tests/testthat/test-shinytest2-tm_g_distribution.R b/tests/testthat/test-shinytest2-tm_g_distribution.R index f65282719..df32d82c4 100644 --- a/tests/testthat/test-shinytest2-tm_g_distribution.R +++ b/tests/testthat/test-shinytest2-tm_g_distribution.R @@ -1,10 +1,7 @@ app_driver_tm_g_distribution <- function() { data <- teal.data::teal_data() - data <- within(data, { - ADSL <- rADSL - }) - teal.data::datanames(data) <- c("ADSL") - teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[teal.data::datanames(data)] + data <- within(data, ADSL <- teal.data::rADSL) + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)] vars1 <- teal.transform::choices_selected( teal.transform::variable_choices(data[["ADSL"]], c("ARM", "COUNTRY", "SEX")), diff --git a/tests/testthat/test-shinytest2-tm_g_response.R b/tests/testthat/test-shinytest2-tm_g_response.R index 0a8bf3f8d..1c3db8098 100644 --- a/tests/testthat/test-shinytest2-tm_g_response.R +++ b/tests/testthat/test-shinytest2-tm_g_response.R @@ -2,10 +2,9 @@ app_driver_tm_g_response <- function() { data <- teal.data::teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) - teal.data::datanames(data) <- c("ADSL") - teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[teal.data::datanames(data)] + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)] init_teal_app_driver( data = data, diff --git a/tests/testthat/test-shinytest2-tm_g_scatterplot.R b/tests/testthat/test-shinytest2-tm_g_scatterplot.R index 09fd72a7b..701ef66d8 100644 --- a/tests/testthat/test-shinytest2-tm_g_scatterplot.R +++ b/tests/testthat/test-shinytest2-tm_g_scatterplot.R @@ -2,10 +2,9 @@ app_driver_tm_g_scatterplot <- function() { data <- teal.data::teal_data() data <- within(data, { require(nestcolor) - ADSL <- rADSL + ADSL <- teal.data::rADSL }) - teal.data::datanames(data) <- c("ADSL") - teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[teal.data::datanames(data)] + teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)] init_teal_app_driver( data = data, diff --git a/tests/testthat/test-shinytest2-tm_misssing_data.R b/tests/testthat/test-shinytest2-tm_misssing_data.R index b1ea91429..cff9b80bc 100644 --- a/tests/testthat/test-shinytest2-tm_misssing_data.R +++ b/tests/testthat/test-shinytest2-tm_misssing_data.R @@ -109,7 +109,7 @@ test_that("e2e - tm_missing_data: Check default settings and visibility of the c ) ) - testthat::expect_equal(app_driver$get_active_module_input("iris-combination_cutoff"), 1L) + testthat::expect_equal(app_driver$get_active_module_input("iris-combination_cutoff"), 2L) app_driver$set_active_module_input("iris-combination_cutoff", 10L) app_driver$expect_no_validation_error() diff --git a/tests/testthat/test-shinytest2-tm_outliers.R b/tests/testthat/test-shinytest2-tm_outliers.R index 33141e7ad..a0b3a206e 100644 --- a/tests/testthat/test-shinytest2-tm_outliers.R +++ b/tests/testthat/test-shinytest2-tm_outliers.R @@ -4,7 +4,6 @@ app_driver_tm_outlier <- function() { CO2 <- CO2 # nolint: object_name CO2[["primary_key"]] <- seq_len(nrow(CO2)) # nolint: object_name }) - teal.data::datanames(data) <- "CO2" teal.data::join_keys(data) <- teal.data::join_keys(join_key("CO2", "CO2", "primary_key")) vars <- teal.transform::choices_selected( @@ -199,7 +198,7 @@ testthat::test_that("e2e - tm_outliers: # IQR METHOD testthat::expect_identical(app_driver$get_active_module_input("method"), "IQR") testthat::expect_match( - app_driver$active_module_element_text("ui_outlier_help"), + normalize_math_italic_text(app_driver$active_module_element_text("ui_outlier_help")), "x ### Introduction -`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. +`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 +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/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/latest-tag/index.html). @@ -39,20 +39,19 @@ See [package functions / modules](https://insightsengineering.github.io/teal.mod ### Example application A simple application featuring the `tm_variable_browser()` module: -```{r, message = FALSE, results = "hide"} +```{r app, message = FALSE, results = "hide", eval = requireNamespace("sparkline", quietly = TRUE)} # load libraries library(teal.modules.general) library(teal.widgets) +library(sparkline) # teal_data object data <- teal_data() data <- within(data, { - ADSL <- rADSL - ADTTE <- rADTTE + ADSL <- teal.data::rADSL + ADTTE <- teal.data::rADTTE }) -datanames <- c("ADSL", "ADTTE") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] # tm_variable_browser module tm_variable_browser_module <- tm_variable_browser( @@ -69,12 +68,28 @@ app <- init( ) ``` -```{r, eval = FALSE} +```{r shinyapp, eval = FALSE} shinyApp(app$ui, app$server) ``` +### Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` + Let's break the above app into pieces: 1: Load the necessary libraries and data. @@ -91,12 +106,10 @@ Following this, we set the `datanames` and `join_keys`. ```r data <- teal_data() data <- within(data, { - ADSL <- rADSL - ADTTE <- rADTTE + ADSL <- teal.data::rADSL + ADTTE <- teal.data::rADTTE }) -datanames <- c("ADSL", "ADTTE") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` 3: Initialize a `teal` application with specified data and modules, in this case, the module: `tm_variable_browser`, datasets:`ADSL` and `ADTTE`. @@ -129,7 +142,7 @@ In a `teal` app, data and modules are decoupled. In the app above: - The app developer specified the module and assigned it to the `modules` argument. - The `init` function took these arguments and returned a list containing `ui` and `server` object, which can be demonstrated by running: -```{r, indent = " "} +```{r, indent = " ", eval = requireNamespace("sparkline", quietly = TRUE)} class(app) names(app) ``` diff --git a/vignettes/using-association-plot.Rmd b/vignettes/using-association-plot.Rmd index dc4660cb8..09ffc4c84 100644 --- a/vignettes/using-association-plot.Rmd +++ b/vignettes/using-association-plot.Rmd @@ -19,7 +19,7 @@ This vignette will guide you through the four parts to create a `teal` applicati ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` @@ -33,30 +33,28 @@ Inside this app 4 datasets will be used 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"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL %>% + ADSL <- teal.data::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) - ADRS <- teal.modules.general::rADRS - ADTTE <- teal.modules.general::rADTTE - ADLB <- teal.modules.general::rADLB %>% + ADRS <- teal.data::rADRS + ADTTE <- teal.data::rADTTE + ADLB <- teal.data::rADLB %>% mutate(CHGC = as.factor(case_when( CHG < 1 ~ "N", CHG > 1 ~ "P", TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for a single wide dataset mod1 <- tm_g_association( label = "Single wide dataset", @@ -296,8 +294,26 @@ app <- init( 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-bivariate-plot.Rmd b/vignettes/using-bivariate-plot.Rmd index 518692b38..c41a7bc65 100644 --- a/vignettes/using-bivariate-plot.Rmd +++ b/vignettes/using-bivariate-plot.Rmd @@ -20,7 +20,7 @@ various types of datasets using the bivariate plot module `tm_g_bivariate()`: ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` @@ -35,23 +35,21 @@ Inside this app 4 datasets will be used 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"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL %>% + ADSL <- teal.data::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) - ADRS <- teal.modules.general::rADRS - ADTTE <- teal.modules.general::rADTTE - ADLB <- teal.modules.general::rADLB %>% + ADRS <- teal.data::rADRS + ADTTE <- teal.data::rADTTE + ADLB <- teal.data::rADLB %>% mutate(CHGC = as.factor(case_when( CHG < 1 ~ "N", CHG > 1 ~ "P", TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -61,7 +59,7 @@ create an app. The data will be handed over using `teal.data::teal_data()`. The 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for the single wide dataset mod1 <- tm_g_bivariate( label = "Single wide dataset", @@ -622,8 +620,26 @@ app <- init( 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-cross-table.Rmd b/vignettes/using-cross-table.Rmd index fd0c98b6d..252f4f5d9 100644 --- a/vignettes/using-cross-table.Rmd +++ b/vignettes/using-cross-table.Rmd @@ -20,9 +20,10 @@ various types of datasets using the cross table module `tm_t_crosstable()`: ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets +library(rtables) ``` ## 2 - Create data sets @@ -32,20 +33,18 @@ Inside this app 2 datasets will be used 1. `ADSL` A wide data set with subject data 2. `ADLB` A long data set with lab measurements for each subject -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide", echo=2:6} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide", echo=2:6} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADLB <- teal.modules.general::rADLB %>% + ADSL <- teal.data::rADSL + ADLB <- teal.data::rADLB %>% mutate(CHGC = as.factor(case_when( CHG < 1 ~ "N", CHG > 1 ~ "P", TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -55,7 +54,7 @@ create an app. The data will be handed over using `teal.data::teal_data()`. The 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for the single wide dataset mod1 <- tm_t_crosstable( label = "Single wide dataset", @@ -138,8 +137,26 @@ app <- init( 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-data-table.Rmd b/vignettes/using-data-table.Rmd index c1a34f450..46ccde3ea 100644 --- a/vignettes/using-data-table.Rmd +++ b/vignettes/using-data-table.Rmd @@ -20,7 +20,7 @@ various types of datasets using the data table module `tm_data_table()`: ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app ``` @@ -32,16 +32,14 @@ Inside this app 3 datasets will be used 2. `ADTTE` A long data set with time to event data 3. `ADLB` A long data set with lab measurements for each subject -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADTTE <- teal.modules.general::rADTTE - ADLB <- teal.modules.general::rADLB + ADSL <- teal.data::rADSL + ADTTE <- teal.data::rADTTE + ADLB <- teal.data::rADLB }) -datanames <- c("ADSL", "ADTTE", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -51,7 +49,7 @@ 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for the two-datasets example mod1 <- tm_data_table( label = "Two datasets", @@ -106,11 +104,29 @@ app <- init( ## 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-outliers-module.Rmd b/vignettes/using-outliers-module.Rmd index 9ed56f0ad..476442b93 100644 --- a/vignettes/using-outliers-module.Rmd +++ b/vignettes/using-outliers-module.Rmd @@ -20,7 +20,7 @@ various types of datasets using the outliers module `tm_outliers()`: ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` @@ -33,16 +33,14 @@ Inside this app 3 datasets will be used 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"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL - ADRS <- teal.modules.general::rADRS - ADLB <- teal.modules.general::rADLB + ADSL <- teal.data::rADSL + ADRS <- teal.data::rADRS + ADLB <- teal.data::rADLB }) -datanames <- c("ADSL", "ADRS", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -52,7 +50,7 @@ create an app. The data will be handed over using `teal.data::teal_data()`. The 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for the single wide dataset mod1 <- tm_outliers( label = "Single wide dataset", @@ -187,11 +185,29 @@ app <- init( ``` ## 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-regression-plots.Rmd b/vignettes/using-regression-plots.Rmd index 93d901012..21f16f3c9 100644 --- a/vignettes/using-regression-plots.Rmd +++ b/vignettes/using-regression-plots.Rmd @@ -21,7 +21,7 @@ various types of datasets using the regression plot module `tm_a_regression()`: ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` @@ -35,23 +35,21 @@ Inside this app 4 datasets will be used 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"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL %>% + ADSL <- teal.data::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) - ADRS <- teal.modules.general::rADRS - ADTTE <- teal.modules.general::rADTTE - ADLB <- teal.modules.general::rADLB %>% + ADRS <- teal.data::rADRS + ADTTE <- teal.data::rADTTE + ADLB <- teal.data::rADLB %>% mutate(CHGC = as.factor(case_when( CHG < 1 ~ "N", CHG > 1 ~ "P", TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -61,7 +59,7 @@ create an app. The data will be handed over using `teal.data::teal_data()`. The 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for the single wide dataset mod1 <- tm_a_regression( label = "Single wide dataset", @@ -269,8 +267,26 @@ app <- init( 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-response-plot.Rmd b/vignettes/using-response-plot.Rmd index 415f095f7..f8a199f76 100644 --- a/vignettes/using-response-plot.Rmd +++ b/vignettes/using-response-plot.Rmd @@ -20,7 +20,7 @@ various types of datasets using the response plot module `tm_g_response()`: ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets ``` @@ -34,23 +34,21 @@ Inside this app 4 datasets will be used 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"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL %>% + ADSL <- teal.data::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) - ADRS <- teal.modules.general::rADRS - ADTTE <- teal.modules.general::rADTTE - ADLB <- teal.modules.general::rADLB %>% + ADRS <- teal.data::rADRS + ADTTE <- teal.data::rADTTE + ADLB <- teal.data::rADLB %>% mutate(CHGC = as.factor(case_when( CHG < 1 ~ "N", CHG > 1 ~ "P", TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -60,7 +58,7 @@ create an app. The data will be handed over using `teal.data::teal_data()`. The 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for the single wide dataset mod1 <- tm_g_response( label = "Single wide dataset", @@ -378,8 +376,26 @@ app <- init( 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-scatterplot-matrix.Rmd b/vignettes/using-scatterplot-matrix.Rmd index befb643fb..805151053 100644 --- a/vignettes/using-scatterplot-matrix.Rmd +++ b/vignettes/using-scatterplot-matrix.Rmd @@ -21,9 +21,10 @@ various types of datasets using the scatter plot matrix module `tm_g_scatterplot ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets +library(lattice) ``` ## 2 - Create data sets @@ -35,23 +36,21 @@ Inside this app 4 datasets will be used 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"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL %>% + ADSL <- teal.data::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) - ADRS <- teal.modules.general::rADRS - ADTTE <- teal.modules.general::rADTTE - ADLB <- teal.modules.general::rADLB %>% + ADRS <- teal.data::rADRS + ADTTE <- teal.data::rADTTE + ADLB <- teal.data::rADLB %>% mutate(CHGC = as.factor(case_when( CHG < 1 ~ "N", CHG > 1 ~ "P", TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -61,7 +60,7 @@ create an app. The data will be handed over using `teal.data::teal_data()`. The 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide"} # configuration for the single wide dataset mod1 <- tm_g_scatterplotmatrix( label = "Single wide dataset", @@ -156,8 +155,26 @@ app <- init( 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +``` diff --git a/vignettes/using-scatterplot.Rmd b/vignettes/using-scatterplot.Rmd index 58e42ef92..18c19114b 100644 --- a/vignettes/using-scatterplot.Rmd +++ b/vignettes/using-scatterplot.Rmd @@ -21,9 +21,12 @@ various types of datasets using the scatter plot module `tm_g_scatterplot()`: ## 1 - Load libraries -```{r echo=TRUE, message=FALSE, warning=FALSE, results="hide"} +```{r library, echo=TRUE, message=FALSE, warning=FALSE, results="hide", eval = requireNamespace("ggpmisc", quietly = TRUE) && requireNamespace("ggExtra", quietly = TRUE) && requireNamespace("colourpicker", quietly = TRUE)} library(teal.modules.general) # used to create the app library(dplyr) # used to modify data sets +library(ggpmisc) +library(ggExtra) +library(colourpicker) ``` ## 2 - Create data sets @@ -35,23 +38,21 @@ Inside this app 4 datasets will be used 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"} +```{r data, echo=TRUE, message=FALSE, warning=FALSE, results="hide", eval = requireNamespace("ggpmisc", quietly = TRUE) && requireNamespace("ggExtra", quietly = TRUE) && requireNamespace("colourpicker", quietly = TRUE)} data <- teal_data() data <- within(data, { - ADSL <- teal.modules.general::rADSL %>% + ADSL <- teal.data::rADSL %>% mutate(TRTDUR = round(as.numeric(TRTEDTM - TRTSDTM), 1)) - ADRS <- teal.modules.general::rADRS - ADTTE <- teal.modules.general::rADTTE - ADLB <- teal.modules.general::rADLB %>% + ADRS <- teal.data::rADRS + ADTTE <- teal.data::rADTTE + ADLB <- teal.data::rADLB %>% mutate(CHGC = as.factor(case_when( CHG < 1 ~ "N", CHG > 1 ~ "P", TRUE ~ "-" ))) }) -datanames <- c("ADSL", "ADRS", "ADTTE", "ADLB") -datanames(data) <- datanames -join_keys(data) <- default_cdisc_join_keys[datanames] +join_keys(data) <- default_cdisc_join_keys[names(data)] ``` ## 3 - Create an `app` variable @@ -61,13 +62,7 @@ create an app. The data will be handed over using `teal.data::teal_data()`. The itself will be constructed by multiple calls of `tm_g_scatterplot()` using different combinations of data sets. -```{r ggExtra, include = FALSE} -ggextra_available <- requireNamespace("ggExtra", quietly = TRUE) -``` -```{r, include = !ggextra_available} -# 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"} +```{r app, echo=TRUE, message=FALSE, warning=FALSE, results="hide", eval = requireNamespace("ggpmisc", quietly = TRUE) && requireNamespace("ggExtra", quietly = TRUE) && requireNamespace("colourpicker", quietly = TRUE)} # configuration for the single wide datasets mod1 <- tm_g_scatterplot( label = "Single wide dataset", @@ -376,8 +371,26 @@ app <- init( 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, results="hide", eval=base::interactive()} +```{r shinyapp, echo=TRUE, results="hide", eval=base::interactive()} shinyApp(app$ui, app$server, options = list(height = 1024, width = 1024)) ``` + +## 5 - Try it out in Shinylive + +```{r shinylive_url, echo = FALSE, results = 'asis', eval = requireNamespace("roxy.shinylive", quietly = TRUE)} +code <- paste0(c( + knitr::knit_code$get("library"), + knitr::knit_code$get("data"), + knitr::knit_code$get("app"), + knitr::knit_code$get("shinyapp") +), collapse = "\n") + +url <- roxy.shinylive::create_shinylive_url(code) +cat(sprintf("[Open in Shinylive](%s)\n\n", url)) +``` + +```{r shinylive_iframe, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")} +knitr::include_url(url, height = "800px") +```