From 08e291715b254f40e97e9bbf1cae7ac2f8cb6000 Mon Sep 17 00:00:00 2001 From: Andrew Bates Date: Wed, 5 Apr 2023 11:43:34 -0700 Subject: [PATCH] Documentation fixes for release review (#819) Fixes a few documentation issues that need to be addressed for release. Note that not all items from #815 are in this PR. Some of them need discussion, so I opened #818. Closes #815 --- DESCRIPTION | 1 - NAMESPACE | 3 - NEWS.md | 1 + R/get_rcode.R | 278 ------------------------------ R/get_rcode_utils.R | 115 +++++------- R/module_nested_tabs.R | 6 +- R/show_rcode_modal.R | 4 +- R/validations.R | 4 +- _pkgdown.yml | 7 +- man/fold_lines.Rd | 20 --- man/get_datasets_code.Rd | 2 +- man/get_rcode.Rd | 80 --------- man/get_rcode_header.Rd | 24 --- man/get_rcode_srv.Rd | 38 ---- man/get_rcode_ui.Rd | 17 -- man/pad.Rd | 20 --- man/show_rcode_modal.Rd | 4 +- man/srv_nested_tabs.Rd | 21 ++- man/validate_has_variable.Rd | 2 +- man/validate_n_levels.Rd | 2 +- tests/testthat/test-get_rcode.R | 93 ---------- tests/testthat/test-rcode_utils.R | 86 +++------ 22 files changed, 100 insertions(+), 728 deletions(-) delete mode 100644 R/get_rcode.R delete mode 100644 man/fold_lines.Rd delete mode 100644 man/get_rcode.Rd delete mode 100644 man/get_rcode_header.Rd delete mode 100644 man/get_rcode_srv.Rd delete mode 100644 man/get_rcode_ui.Rd delete mode 100644 man/pad.Rd delete mode 100644 tests/testthat/test-get_rcode.R diff --git a/DESCRIPTION b/DESCRIPTION index 522eb76e2f..bee900c94b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -78,7 +78,6 @@ RoxygenNote: 7.2.3 Collate: 'dummy_functions.R' 'example_module.R' - 'get_rcode.R' 'get_rcode_utils.R' 'include_css_js.R' 'modules.R' diff --git a/NAMESPACE b/NAMESPACE index 3eb78536df..3628b5ac63 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,9 +24,6 @@ export(example_module) export(get_code_tdata) export(get_join_keys) export(get_metadata) -export(get_rcode) -export(get_rcode_srv) -export(get_rcode_ui) export(init) export(module) export(modules) diff --git a/NEWS.md b/NEWS.md index 08b4eb30ad..070eae6c31 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * The use of `datasets` argument in `modules` has been deprecated and will be removed in a future release. Please use `data` argument instead. `data` is of type `tdata`; see "Creating custom modules" vignettes and function documentation of `teal::new_tdata` for further details. * Due to deprecation of `chunks` in `teal.code`, the `teal` framework now uses their replacement (`qenv`) instead. The documentation in `teal` has been updated to reflect this and custom modules written with `chunks` should be updated to use `qenv`. +* Due to deprecation of `chunks` in `teal.code`, `get_rcode`, `get_rcode_srv`, and `get_rcode_ui` have been removed. ### New features diff --git a/R/get_rcode.R b/R/get_rcode.R deleted file mode 100644 index d32c726005..0000000000 --- a/R/get_rcode.R +++ /dev/null @@ -1,278 +0,0 @@ -#' Returns R Code from a teal module -#' -#' @description `r lifecycle::badge("deprecated")` -#' Return the R-code used to create a teal::teal] module analysis. This function -#' will return all analysis code as a character string. In case of a good setup it will -#' not only return the code used create the module analysis, but also the code used by -#' the app author to create the app. The main feature of this function is encapsulating -#' the R code to merge datasets by [teal.transform::merge_datasets()] and all the R code stored inside -#' code [teal.code::chunks]. -#' -#' @param datasets (`list`) list of `FilteredData` available inside the -#' server function of any [teal::teal] module. -#' @param datanames (`character`)\cr -#' names of datasets which code should be returned for. Due to fact that -#' `teal` filter panel depending on `"ADSL"`, code for `ADSL` -#' is always returned even if not specified. -#' @param chunks (`chunks`) \cr -#' object of class `chunks` that stores code chunks. These code -#' chunks are used in [teal::teal] to enable reproducibility. Normally these chunks -#' are stored within the [shiny::shiny-package] session. The default value -#' can normally be used. -#' @param selected_chunk_ids (`character` vector)\cr -#' vector of code chunks to be shown -#' in the code. If chunk id's are available this can be used to limit the -#' chunks that appear in the `"Show R-Code"` modal. Please only use this -#' feature if all chunks were set with designated IDs. -#' -#' @param session (`environment`) deprecated. -#' -#' @inheritParams get_rcode_header -#' -#' @note -#' The `teal.load_nest_code` option is being used to customize the code that sets correct library paths -#' with all packages available. If empty (the default), a placeholder string is being used. -#' -#' @export -#' -#' @return Return the R Code needed to reproduce a teal module. The [get_rcode_header()] part allows -#' to install the module. Additionally if the user filtered data by -#' teal inherited functions, the code to filter the data is included. If the teal module -#' is using [teal.transform::data_extract_srv()] the extraction and merging -#' code will be returned, too. -#' If code chunks were used, these will also be used to derive module R Code. -#' -#' @examples -#' \dontrun{ -#' show_rcode_modal( -#' title = "R Code for a Regression Plot", -#' rcode = get_rcode( -#' datasets = datasets, -#' title = title, -#' description = description -#' ) -#' ) -#' } -#' @references [show_rcode_modal()], [get_rcode_header()] -get_rcode <- function(datasets = NULL, - datanames = `if`(is.null(datasets), datasets, datasets$datanames()), - chunks = teal.code::get_chunks_object(), - selected_chunk_ids = character(0), - session = NULL, - title = NULL, - description = NULL) { - checkmate::assert_class(datasets, "FilteredData", null.ok = TRUE) - - lifecycle::deprecate_warn( - when = "0.12.1", - what = "get_rcode()", - details = "Reproducibility in teal apps has changed. - See the teal.code package and example modules for further details" - ) - - if (!inherits(chunks, "chunks")) { - stop("No code chunks given") - } - checkmate::assert_string(title, null.ok = TRUE) - checkmate::assert_string(description, null.ok = TRUE) - rlang::push_options(width = 120) - - if (!is.null(session)) { - lifecycle::deprecate_warn("0.12.1", "get_rcode(session)") - } - - if (!is.null(datasets)) { - if (inherits(datasets, "CDISCFilteredData")) { - datanames <- unique(c(datanames, unlist(lapply(datanames, datasets$get_parentname)))) - } - str_header <- paste( - c(get_rcode_header(title = title, description = description), ""), - collapse = "\n" - ) - str_install <- paste(c(get_rcode_str_install(), ""), collapse = "\n") - str_libs <- paste(get_rcode_libraries(), "\n") - - hashes <- calculate_hashes(datanames, datasets) - str_code <- c(get_datasets_code(datanames, datasets, hashes), teal.slice::get_filter_expr(datasets, datanames)) - } else { - str_header <- get_rcode_header(title = title, description = description) - str_install <- character(0) - str_libs <- character(0) - str_code <- character(0) - } - str_chunks <- paste0( - chunks$get_rcode(chunk_ids = selected_chunk_ids), - collapse = "\n" - ) - - code_not_to_style <- paste( - c( - "\n", - str_header, - str_install, - str_libs - ), - collapse = "\n" - ) - - - code_to_style <- paste( - c( - str_code, - "", - str_chunks, - "\n" - ), - collapse = "\n" - ) - - # remove error with curly brace - code_to_style <- gsub("}\n\\s*else", "} else", code_to_style) - code_to_style <- paste0(styler::style_text(code_to_style), collapse = "\n") - paste(code_not_to_style, code_to_style, sep = "\n") -} - - -#' Get datasets code -#' -#' Get combined code from `FilteredData` and from `CodeClass` object. -#' -#' @param datanames (`character`) names of datasets to extract code from -#' @param datasets (`FilteredData`) object -#' @param hashes named (`list`) of hashes per dataset -#' -#' @return `character(3)` containing following elements: -#' - code from `CodeClass` (data loading code) -#' - hash check of loaded objects -#' -#' @keywords internal -get_datasets_code <- function(datanames, datasets, hashes) { - str_code <- datasets$get_code(datanames) - if (length(str_code) == 0 || (length(str_code) == 1 && str_code == "")) { - str_code <- "message('Preprocessing is empty')" - } else if (length(str_code) > 0) { - str_code <- paste0(str_code, "\n\n") - } - - if (!datasets$get_check()) { - check_note_string <- paste0( - c( - "message(paste(\"Reproducibility of data import and preprocessing was not explicitly checked\",", - " \" ('check = FALSE' is set). Contact app developer if this is an issue.\n\"))" - ), - collapse = "\n" - ) - str_code <- paste0(str_code, "\n\n", check_note_string) - } - - str_hash <- paste( - paste0( - vapply( - datanames, - function(dataname) { - sprintf( - "stopifnot(%s == %s)", - deparse1(bquote(rlang::hash(.(as.name(dataname))))), - deparse1(hashes[[dataname]]) - ) - }, - character(1) - ), - collapse = "\n" - ), - "\n\n" - ) - - c(str_code, str_hash) -} - -## Module ---- -#' Server part of get R code module -#' -#' @description `r lifecycle::badge("deprecated")` -#' -#' @inheritParams get_rcode -#' @inheritParams shiny::moduleServer -#' -#' @param modal_title optional, (`character`) title of the modal -#' @param code_header optional, (`character`) header inside R -#' @param disable_buttons optional, (`reactive`) -#' a shiny reactive value. Should be a single boolean value, indicating whether to disable -#' or enable the show R code and Debug info buttons. Default: `reactiveVal(FALSE)`. -#' -#' @export -#' -get_rcode_srv <- function(id, - datasets, - datanames = datasets$datanames(), - modal_title = "R Code", - code_header = "Automatically generated R code", - disable_buttons = reactiveVal(FALSE)) { - checkmate::assert_class(disable_buttons, c("reactive", "function")) - - lifecycle::deprecate_warn( - when = "0.12.1", - what = "get_rcode_srv()", - with = "teal.widgets::verbatim_popup_srv()", - details = "Show R Code behaviour has changed, - see example modules in vignettes for more details" - ) - - moduleServer(id, function(input, output, server) { - chunks <- teal.code::get_chunks_object(parent_idx = 1L) - observeEvent(input$show_rcode, { - progress <- Progress$new() - progress$set(message = "Getting R Code", value = 0) - show_rcode_modal( - title = modal_title, - rcode = get_rcode( - datasets = datasets, - datanames = datanames, - chunks = chunks, - title = code_header - ) - ) - progress$set(message = "Getting R Code", value = 1) - progress$close() - }) - - teal.code::get_eval_details_srv( - id = "show_eval_details", - chunks = chunks - ) - - observeEvent(disable_buttons(), { - if (disable_buttons()) { - shinyjs::disable("show_rcode") - shinyjs::disable("show_eval_details-evaluation_details") - } else { - shinyjs::enable("show_rcode") - shinyjs::enable("show_eval_details-evaluation_details") - } - }) - }) -} - -#' Ui part of get R code module -#' -#' @description `r lifecycle::badge("deprecated")` -#' @param id (`character`) id of shiny module -#' -#' @return (`shiny.tag`) -#' -#' @export -get_rcode_ui <- function(id) { - lifecycle::deprecate_warn( - when = "0.12.1", - what = "get_rcode_ui()", - with = "teal.widgets::verbatim_popup_ui()", - details = "Show R Code behaviour has changed, - see example modules in vignettes for more details" - ) - - ns <- NS(id) - tagList( - tags$div(actionButton(ns("show_rcode"), "Show R code", width = "100%")), - tags$div(teal.code::get_eval_details_ui(ns("show_eval_details"))) - ) -} diff --git a/R/get_rcode_utils.R b/R/get_rcode_utils.R index 194495a917..ebea4ea389 100644 --- a/R/get_rcode_utils.R +++ b/R/get_rcode_utils.R @@ -1,37 +1,3 @@ -#' Generates header text for analysis items -#' -#' @param title A character title of the module -#' @param description A character description of the module with additional -#' information not reflected in the title -#' -#' @return A character string for the header text -#' -#' @author Sebastian Wolf -#' @keywords internal -get_rcode_header <- function(title = NULL, description = NULL) { - # Derive sys Info - info <- Sys.info() - packages <- sapply(utils::sessionInfo()$otherPkgs, function(x) sprintf("%s (%s)", x$Package, x$Version)) - head <- - c( - pad(title, pre = "", post = ""), - pad(description, post = c("", "")), - pad( - c( - paste(" Running:", getwd()), - paste(" on:", info["nodename"]), - paste("R version:", utils::sessionInfo()[["R.version"]][["version.string"]]), - paste(" Date:", date()) - ) - ), - "Current libraries loaded (derived by .libPaths()):", - paste0(" - ", .libPaths()), - "", - fold_lines(paste("Packages versions:", paste(packages, collapse = ", ")), 80, indent_from = ":") - ) - paste0("# ", head) -} - #' Generates library calls from current session info #' #' Function to create multiple library calls out of current session info to make reproducible code works. @@ -63,46 +29,55 @@ get_rcode_str_install <- function() { return("# Add any code to install/load your NEST environment here") } -#' Pads a string +#' Get datasets code +#' +#' Get combined code from `FilteredData` and from `CodeClass` object. #' -#' Including elements before or after string. If NULL is provided no elements included. Padding in this case means -#' appending additional element before or after \code{character} vector. -#' @param str (\code{character}) vector of lines to be padded -#' @param pre (\code{character}) elements to be appended before \code{str} -#' @param post (\code{character}) elements to be appended after \code{str} +#' @param datanames (`character`) names of datasets to extract code from +#' @param datasets (`FilteredData`) object +#' @param hashes named (`list`) of hashes per dataset +#' +#' @return `character(3)` containing following elements: +#' - code from `CodeClass` (data loading code) +#' - hash check of loaded objects #' #' @keywords internal -pad <- function(str, pre = NULL, post = "") { - if (length(str) == 0 || (length(str) == 1 && str == "")) { - NULL - } else { - c(pre, str, post) +get_datasets_code <- function(datanames, datasets, hashes) { + str_code <- datasets$get_code(datanames) + if (length(str_code) == 0 || (length(str_code) == 1 && str_code == "")) { + str_code <- "message('Preprocessing is empty')" + } else if (length(str_code) > 0) { + str_code <- paste0(str_code, "\n\n") } -} -#' Fixed line width folding -#' -#' @description `r lifecycle::badge("stable")` -#' Folds lines longer than specified width. -#' @param txt (\code{character}) text to be adjusted -#' @param width (\code{integer}) maximum number of characters in vector -#' @param indent_from (\code{character}) character which begins the indent. -#' @keywords internal -fold_lines <- function(txt, width = 80, indent_from = NULL) { - unlist(sapply(txt, USE.NAMES = FALSE, FUN = function(x) { - if (nchar(x) < width) { - return(x) - } - idx <- if (!is.null(indent_from)) { - gregexpr(indent_from, x)[[1]] - } else { - 0 - } - strwrap( - x = x, - width = width, - prefix = strrep(" ", idx + 1), - initial = "" + if (!datasets$get_check()) { + check_note_string <- paste0( + c( + "message(paste(\"Reproducibility of data import and preprocessing was not explicitly checked\",", + " \" ('check = FALSE' is set). Contact app developer if this is an issue.\n\"))" + ), + collapse = "\n" ) - })) + str_code <- paste0(str_code, "\n\n", check_note_string) + } + + str_hash <- paste( + paste0( + vapply( + datanames, + function(dataname) { + sprintf( + "stopifnot(%s == %s)", + deparse1(bquote(rlang::hash(.(as.name(dataname))))), + deparse1(hashes[[dataname]]) + ) + }, + character(1) + ), + collapse = "\n" + ), + "\n\n" + ) + + c(str_code, str_hash) } diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index e9b7b0a5fd..cdaa15ced3 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -133,14 +133,14 @@ srv_nested_tabs <- function(id, datasets, modules, reporter = teal.reporter::Rep #' @rdname srv_nested_tabs #' @export #' @keywords internal -srv_nested_tabs.default <- function(id, datasets, modules, reporter) { +srv_nested_tabs.default <- function(id, datasets, modules, reporter = teal.reporter::Reporter$new()) { stop("Modules class not supported: ", paste(class(modules), collapse = " ")) } #' @rdname srv_nested_tabs #' @export #' @keywords internal -srv_nested_tabs.teal_modules <- function(id, datasets, modules, reporter) { +srv_nested_tabs.teal_modules <- function(id, datasets, modules, reporter = teal.reporter::Reporter$new()) { moduleServer(id = id, module = function(input, output, session) { logger::log_trace( paste( @@ -172,7 +172,7 @@ srv_nested_tabs.teal_modules <- function(id, datasets, modules, reporter) { #' @rdname srv_nested_tabs #' @export #' @keywords internal -srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) { +srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter = teal.reporter::Reporter$new()) { logger::log_trace( paste( "srv_nested_tabs.teal_module initializing the module with:", diff --git a/R/show_rcode_modal.R b/R/show_rcode_modal.R index 4f1855bbc4..c6333d4442 100644 --- a/R/show_rcode_modal.R +++ b/R/show_rcode_modal.R @@ -7,12 +7,12 @@ #' @param title (`character(1)`)\cr #' Title of the modal, displayed in the first comment of the R-code. #' @param rcode (`character`)\cr -#' vector with R code to show inside the modal. You can use [get_rcode()] to derive this R +#' vector with R code to show inside the modal. You can use [teal.code::get_code()] to derive this R #' code inside a module. #' @param session (`ShinySession` optional)\cr #' `shiny` Session object, if missing then [shiny::getDefaultReactiveDomain()] is used. #' -#' @references [shiny::showModal()] [get_rcode()] +#' @references [shiny::showModal()] [teal.code::get_code()] show_rcode_modal <- function(title = NULL, rcode, session = getDefaultReactiveDomain()) { rcode <- paste(rcode, collapse = "\n") diff --git a/R/validations.R b/R/validations.R index e9b662a812..56fee633d4 100644 --- a/R/validations.R +++ b/R/validations.R @@ -262,7 +262,7 @@ validate_no_intersection <- function(x, y, msg) { #' #' ui <- fluidPage( #' selectInput("arm", "Select treatment", -#' choices = c("ARM", "ARMCD", "ACTARM", "ACTARMCD", "TRT01P", "TRT01A"), +#' choices = c("ARM", "ARMCD", "ACTARM", "TRT"), #' selected = "ARM", multiple = TRUE #' ), #' verbatimTextOutput("arm_summary") @@ -327,7 +327,7 @@ validate_has_variable <- function(data, varname, msg) { #' server <- function(input, output) { #' output$arm_summary <- renderText({ #' validate_n_levels(ADSL[[input$arm]], -#' min_levels = 1, max_levels = 15, +#' min_levels = 2, max_levels = 15, #' var_name = input$arm #' ) #' paste0( diff --git a/_pkgdown.yml b/_pkgdown.yml index 7d96c4e7cb..56abb18ec4 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -46,15 +46,10 @@ reference: - get_join_keys - get_metadata - tdata2env + - show_rcode_modal # - title: Functions moved to other packages # desc: These functions have been moved from teal and will be deprecated. # contents: - title: Validation functions contents: - starts_with("validate_") - - title: Deprecated functions - contents: - - get_rcode - - get_rcode_srv - - get_rcode_ui - - show_rcode_modal diff --git a/man/fold_lines.Rd b/man/fold_lines.Rd deleted file mode 100644 index 45758a2ce5..0000000000 --- a/man/fold_lines.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rcode_utils.R -\name{fold_lines} -\alias{fold_lines} -\title{Fixed line width folding} -\usage{ -fold_lines(txt, width = 80, indent_from = NULL) -} -\arguments{ -\item{txt}{(\code{character}) text to be adjusted} - -\item{width}{(\code{integer}) maximum number of characters in vector} - -\item{indent_from}{(\code{character}) character which begins the indent.} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Folds lines longer than specified width. -} -\keyword{internal} diff --git a/man/get_datasets_code.Rd b/man/get_datasets_code.Rd index 09a4dfbe0e..ad0457094c 100644 --- a/man/get_datasets_code.Rd +++ b/man/get_datasets_code.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rcode.R +% Please edit documentation in R/get_rcode_utils.R \name{get_datasets_code} \alias{get_datasets_code} \title{Get datasets code} diff --git a/man/get_rcode.Rd b/man/get_rcode.Rd deleted file mode 100644 index 16471ba245..0000000000 --- a/man/get_rcode.Rd +++ /dev/null @@ -1,80 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rcode.R -\name{get_rcode} -\alias{get_rcode} -\title{Returns R Code from a teal module} -\usage{ -get_rcode( - datasets = NULL, - datanames = if (is.null(datasets)) datasets else datasets$datanames(), - chunks = teal.code::get_chunks_object(), - selected_chunk_ids = character(0), - session = NULL, - title = NULL, - description = NULL -) -} -\arguments{ -\item{datasets}{(\code{list}) list of \code{FilteredData} available inside the -server function of any \link{teal} module.} - -\item{datanames}{(\code{character})\cr -names of datasets which code should be returned for. Due to fact that -\code{teal} filter panel depending on \code{"ADSL"}, code for \code{ADSL} -is always returned even if not specified.} - -\item{chunks}{(\code{chunks}) \cr -object of class \code{chunks} that stores code chunks. These code -chunks are used in \link{teal} to enable reproducibility. Normally these chunks -are stored within the \link[shiny:shiny-package]{shiny::shiny-package} session. The default value -can normally be used.} - -\item{selected_chunk_ids}{(\code{character} vector)\cr -vector of code chunks to be shown -in the code. If chunk id's are available this can be used to limit the -chunks that appear in the \code{"Show R-Code"} modal. Please only use this -feature if all chunks were set with designated IDs.} - -\item{session}{(\code{environment}) deprecated.} - -\item{title}{A character title of the module} - -\item{description}{A character description of the module with additional -information not reflected in the title} -} -\value{ -Return the R Code needed to reproduce a teal module. The \code{\link[=get_rcode_header]{get_rcode_header()}} part allows -to install the module. Additionally if the user filtered data by -teal inherited functions, the code to filter the data is included. If the teal module -is using \code{\link[teal.transform:data_extract_srv]{teal.transform::data_extract_srv()}} the extraction and merging -code will be returned, too. -If code chunks were used, these will also be used to derive module R Code. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -Return the R-code used to create a teal::teal] module analysis. This function -will return all analysis code as a character string. In case of a good setup it will -not only return the code used create the module analysis, but also the code used by -the app author to create the app. The main feature of this function is encapsulating -the R code to merge datasets by \code{\link[teal.transform:merge_datasets]{teal.transform::merge_datasets()}} and all the R code stored inside -code \link[teal.code:chunks]{teal.code::chunks}. -} -\note{ -The \code{teal.load_nest_code} option is being used to customize the code that sets correct library paths -with all packages available. If empty (the default), a placeholder string is being used. -} -\examples{ -\dontrun{ -show_rcode_modal( - title = "R Code for a Regression Plot", - rcode = get_rcode( - datasets = datasets, - title = title, - description = description - ) -) -} -} -\references{ -\code{\link[=show_rcode_modal]{show_rcode_modal()}}, \code{\link[=get_rcode_header]{get_rcode_header()}} -} diff --git a/man/get_rcode_header.Rd b/man/get_rcode_header.Rd deleted file mode 100644 index bcf31f93e9..0000000000 --- a/man/get_rcode_header.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rcode_utils.R -\name{get_rcode_header} -\alias{get_rcode_header} -\title{Generates header text for analysis items} -\usage{ -get_rcode_header(title = NULL, description = NULL) -} -\arguments{ -\item{title}{A character title of the module} - -\item{description}{A character description of the module with additional -information not reflected in the title} -} -\value{ -A character string for the header text -} -\description{ -Generates header text for analysis items -} -\author{ -Sebastian Wolf -} -\keyword{internal} diff --git a/man/get_rcode_srv.Rd b/man/get_rcode_srv.Rd deleted file mode 100644 index 95978238b4..0000000000 --- a/man/get_rcode_srv.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rcode.R -\name{get_rcode_srv} -\alias{get_rcode_srv} -\title{Server part of get R code module} -\usage{ -get_rcode_srv( - id, - datasets, - datanames = datasets$datanames(), - modal_title = "R Code", - code_header = "Automatically generated R code", - disable_buttons = reactiveVal(FALSE) -) -} -\arguments{ -\item{id}{An ID string that corresponds with the ID used to call the module's -UI function.} - -\item{datasets}{(\code{list}) list of \code{FilteredData} available inside the -server function of any \link{teal} module.} - -\item{datanames}{(\code{character})\cr -names of datasets which code should be returned for. Due to fact that -\code{teal} filter panel depending on \code{"ADSL"}, code for \code{ADSL} -is always returned even if not specified.} - -\item{modal_title}{optional, (\code{character}) title of the modal} - -\item{code_header}{optional, (\code{character}) header inside R} - -\item{disable_buttons}{optional, (\code{reactive}) -a shiny reactive value. Should be a single boolean value, indicating whether to disable -or enable the show R code and Debug info buttons. Default: \code{reactiveVal(FALSE)}.} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -} diff --git a/man/get_rcode_ui.Rd b/man/get_rcode_ui.Rd deleted file mode 100644 index ede2bb078a..0000000000 --- a/man/get_rcode_ui.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rcode.R -\name{get_rcode_ui} -\alias{get_rcode_ui} -\title{Ui part of get R code module} -\usage{ -get_rcode_ui(id) -} -\arguments{ -\item{id}{(\code{character}) id of shiny module} -} -\value{ -(\code{shiny.tag}) -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -} diff --git a/man/pad.Rd b/man/pad.Rd deleted file mode 100644 index e30d60cb8c..0000000000 --- a/man/pad.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_rcode_utils.R -\name{pad} -\alias{pad} -\title{Pads a string} -\usage{ -pad(str, pre = NULL, post = "") -} -\arguments{ -\item{str}{(\code{character}) vector of lines to be padded} - -\item{pre}{(\code{character}) elements to be appended before \code{str}} - -\item{post}{(\code{character}) elements to be appended after \code{str}} -} -\description{ -Including elements before or after string. If NULL is provided no elements included. Padding in this case means -appending additional element before or after \code{character} vector. -} -\keyword{internal} diff --git a/man/show_rcode_modal.Rd b/man/show_rcode_modal.Rd index 902ab1c95e..7f03222fea 100644 --- a/man/show_rcode_modal.Rd +++ b/man/show_rcode_modal.Rd @@ -11,7 +11,7 @@ show_rcode_modal(title = NULL, rcode, session = getDefaultReactiveDomain()) Title of the modal, displayed in the first comment of the R-code.} \item{rcode}{(\code{character})\cr -vector with R code to show inside the modal. You can use \code{\link[=get_rcode]{get_rcode()}} to derive this R +vector with R code to show inside the modal. You can use \code{\link[teal.code:get_code]{teal.code::get_code()}} to derive this R code inside a module.} \item{session}{(\code{ShinySession} optional)\cr @@ -22,5 +22,5 @@ code inside a module.} Use the \code{\link[shiny:showModal]{shiny::showModal()}} function to show the R code inside. } \references{ -\code{\link[shiny:showModal]{shiny::showModal()}} \code{\link[=get_rcode]{get_rcode()}} +\code{\link[shiny:showModal]{shiny::showModal()}} \code{\link[teal.code:get_code]{teal.code::get_code()}} } diff --git a/man/srv_nested_tabs.Rd b/man/srv_nested_tabs.Rd index 450886719e..e6944607cf 100644 --- a/man/srv_nested_tabs.Rd +++ b/man/srv_nested_tabs.Rd @@ -14,11 +14,26 @@ srv_nested_tabs( reporter = teal.reporter::Reporter$new() ) -\method{srv_nested_tabs}{default}(id, datasets, modules, reporter) +\method{srv_nested_tabs}{default}( + id, + datasets, + modules, + reporter = teal.reporter::Reporter$new() +) -\method{srv_nested_tabs}{teal_modules}(id, datasets, modules, reporter) +\method{srv_nested_tabs}{teal_modules}( + id, + datasets, + modules, + reporter = teal.reporter::Reporter$new() +) -\method{srv_nested_tabs}{teal_module}(id, datasets, modules, reporter) +\method{srv_nested_tabs}{teal_module}( + id, + datasets, + modules, + reporter = teal.reporter::Reporter$new() +) } \arguments{ \item{id}{(\code{character})\cr diff --git a/man/validate_has_variable.Rd b/man/validate_has_variable.Rd index d1858b3a78..5794ecc53c 100644 --- a/man/validate_has_variable.Rd +++ b/man/validate_has_variable.Rd @@ -25,7 +25,7 @@ ADSL <- synthetic_cdisc_data("latest")$adsl ui <- fluidPage( selectInput("arm", "Select treatment", - choices = c("ARM", "ARMCD", "ACTARM", "ACTARMCD", "TRT01P", "TRT01A"), + choices = c("ARM", "ARMCD", "ACTARM", "TRT"), selected = "ARM", multiple = TRUE ), verbatimTextOutput("arm_summary") diff --git a/man/validate_n_levels.Rd b/man/validate_n_levels.Rd index 0fb310f7b0..485a2ab33a 100644 --- a/man/validate_n_levels.Rd +++ b/man/validate_n_levels.Rd @@ -40,7 +40,7 @@ ui <- fluidPage( server <- function(input, output) { output$arm_summary <- renderText({ validate_n_levels(ADSL[[input$arm]], - min_levels = 1, max_levels = 15, + min_levels = 2, max_levels = 15, var_name = input$arm ) paste0( diff --git a/tests/testthat/test-get_rcode.R b/tests/testthat/test-get_rcode.R deleted file mode 100644 index bdcfcf0f39..0000000000 --- a/tests/testthat/test-get_rcode.R +++ /dev/null @@ -1,93 +0,0 @@ -testthat::test_that("get_rcode returns header only for empty chunks", { - rlang::local_options(lifecycle_verbosity = "quiet") - ch <- teal.code::chunks_new() - - r_code_from_chunks <- strsplit(get_rcode(chunks = ch), "\n")[[1]] - r_code_from_header <- strsplit(sprintf("\n\n%s\n", paste(get_rcode_header(), collapse = "\n")), "\n")[[1]] - - # removing the Date line from the header as the seconds may be different - # in the two strings - testthat::expect_identical( - r_code_from_chunks[c(1:5, 7:length(r_code_from_chunks))], - r_code_from_header[c(1:5, 7:length(r_code_from_header))] - ) -}) - -testthat::test_that("get_rcode returns code from chunks at the end", { - rlang::local_options(lifecycle_verbosity = "quiet") - ch <- teal.code::chunks_new() - teal.code::chunks_push(id = "test", chunks = ch, quote(a <- 1)) - r_code_from_chunks <- strsplit(get_rcode(chunks = ch), "\n")[[1]] - testthat::expect_true("a <- 1" %in% r_code_from_chunks) -}) - -testthat::test_that("get_rcode returns data-loading, filter-panel and chunks code combined", { - rlang::local_options(lifecycle_verbosity = "quiet") - ch <- teal.code::chunks_new() - teal.code::chunks_push(id = "test", chunks = ch, quote(a <- 1)) - - datasets <- teal.slice::init_filtered_data( - teal.data::teal_data( - teal.data::dataset("IRIS", x = iris, code = "IRIS <- iris"), - teal.data::dataset("MTCARS", x = mtcars, code = "MTCARS <- mtcars") - ) - ) - - testthat::expect_true( - all( - c( - "IRIS <- iris", - "MTCARS <- mtcars", - "a <- 1" - ) %in% - strsplit(shiny::isolate(get_rcode(datasets = datasets, chunks = ch)), "\n")[[1]] - ) - ) -}) - -testthat::test_that("style nested expressions", { - rlang::local_options(lifecycle_verbosity = "quiet") - testthat::expect_silent({ - cs <- teal.code::chunks_new() - - cs$push(quote(a <- 1)) - cs$push(quote({ - a <- 1 - b <- 2 - })) # nolint - cs$push(substitute(c <- 3)) - cs$push(substitute(if (TRUE) d <- 4 else d <- 44)) - # this is special case where default styler failed - cs$push(substitute({ - if (TRUE) e <- 5 else e <- 55 - })) # nolint - }) - - testthat::expect_silent( - styler::style_text(cs$get_rcode()) - ) -}) - - -testthat::test_that("get_datasets_code returns code only for specified datanames", { - datasets <- teal.slice::init_filtered_data( - teal.data::teal_data( - teal.data::dataset("IRIS", x = iris, code = "IRIS <- iris"), - teal.data::dataset("MTCARS", x = mtcars, code = "MTCARS <- mtcars") - ) - ) - - hashes <- calculate_hashes(datasets$datanames(), datasets) - testthat::expect_true( - !grepl( - "mtcars", - paste(get_datasets_code(datasets = datasets, dataname = "IRIS", hashes = hashes), collapse = "\n"), - ignore.case = TRUE - ) && - grepl( - "iris", - paste(get_datasets_code(datasets = datasets, dataname = "IRIS", hashes = hashes), collapse = "\n"), - ignore.case = TRUE - ) - ) -}) diff --git a/tests/testthat/test-rcode_utils.R b/tests/testthat/test-rcode_utils.R index 91cf94eff0..09e3ab7c65 100644 --- a/tests/testthat/test-rcode_utils.R +++ b/tests/testthat/test-rcode_utils.R @@ -1,66 +1,3 @@ -testthat::test_that("Check padding", { - testthat::expect_identical(pad(str = "test"), c("test", "")) - - testthat::expect_identical(pad(str = "test", pre = "pre", post = c("post", "post")), c("pre", "test", "post", "post")) - - testthat::expect_identical(pad(str = NULL), NULL) - - testthat::expect_identical(pad(str = ""), NULL) - - testthat::expect_identical(pad(str = character(0)), NULL) - - testthat::expect_identical(pad(str = character(0), pre = ""), NULL) -}) - -testthat::test_that("No arguments", { - testthat::expect_silent(get_rcode_header()) -}) - -testthat::test_that("Check title", { - testthat::expect_identical( - get_rcode_header(title = "Teal App")[1:3], - pad("# Teal App", pre = "# ", post = "# ") - ) -}) - -testthat::test_that("Check description", { - testthat::expect_identical( - get_rcode_header(title = "Teal App", description = "Test Description")[4:6], - pad("# Test Description", post = c("# ", "# ")) - ) -}) - -testthat::test_that("Check Running on", { - compare <- paste("#", c( - paste(" Running:", getwd()), - paste(" on:", Sys.info()["nodename"]), - paste("R version:", utils::sessionInfo()[["R.version"]][["version.string"]]) - )) - - testthat::expect_true(all(compare %in% get_rcode_header())) -}) - -testthat::test_that("Check .libPaths()", { - compare <- paste0("# - ", .libPaths()) - testthat::expect_true(all(compare %in% get_rcode_header(title = NULL))) -}) - -testthat::test_that("Check package versions", { - packages <- sapply(utils::sessionInfo()$otherPkgs, function(x) sprintf("%s (%s)", x$Package, x$Version)) - compare <- paste( - "#", - fold_lines( - paste("Packages versions:", paste(packages, collapse = ", ")), - 80, - indent_from = ":" - ) - ) - - - testthat::expect_true(all(compare %in% get_rcode_header())) -}) - - testthat::test_that("With no teal.load_nest_code option set get_rcode_str_install returns default string", { withr::with_options( list(teal.load_nest_code = NULL), @@ -106,3 +43,26 @@ testthat::test_that("get_rcode_libraries returns current session packages", { ) ) }) + +testthat::test_that("get_datasets_code returns code only for specified datanames", { + datasets <- teal.slice::init_filtered_data( + teal.data::teal_data( + teal.data::dataset("IRIS", x = iris, code = "IRIS <- iris"), + teal.data::dataset("MTCARS", x = mtcars, code = "MTCARS <- mtcars") + ) + ) + + hashes <- calculate_hashes(datasets$datanames(), datasets) + testthat::expect_true( + !grepl( + "mtcars", + paste(get_datasets_code(datasets = datasets, dataname = "IRIS", hashes = hashes), collapse = "\n"), + ignore.case = TRUE + ) && + grepl( + "iris", + paste(get_datasets_code(datasets = datasets, dataname = "IRIS", hashes = hashes), collapse = "\n"), + ignore.case = TRUE + ) + ) +})