diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index 08013cae3..8745bde03 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -221,6 +221,7 @@ template_abnormality_by_worst_grade <- function(parentname, # nolint: object_len y$table <- substitute( expr = { + stopifnot("No common arm levels in data, please check input." = nrow(parent) > 0) table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list(parent = as.name(parentname)) @@ -522,32 +523,40 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. anl_q <- merged_adsl_anl$data validate_checks <- reactive({ - input_arm <- anl_selectors$arm_var()$variables$selected validate( - need(length(input_arm) == 1L, "Please select a treatment variable.") + teal::need_input( + inputId = "arm_var-variables-selected", + condition = length(anl_selectors$arm_var()$variables$selected) == 1L, + message = "Please select a treatment variable." + ) ) validate( - need( - length(anl_selectors$id_var()$variables$selected) >= 1L, - "Please select a Subject Identifier." + teal::need_input( + inputId = "id_var-variables-selected", + condition = length(anl_selectors$id_var()$variables$selected) >= 1L, + message = "Please select a Subject Identifier." ), - need( - length(anl_selectors$atoxgr_var()$variables$selected) >= 1L, - "Please select Analysis Toxicity Grade variable." + teal::need_input( + inputId = "atoxgr_var-variables-selected", + condition = length(anl_selectors$atoxgr_var()$variables$selected) >= 1L, + message = "Please select Analysis Toxicity Grade variable." ), - need( - length(anl_selectors$worst_low_flag_var()$variables$selected) >= 1L, - "Please select the Worst Low Grade flag variable." + teal::need_input( + inputId = "worst_low_flag_var-variables-selected", + condition = length(anl_selectors$worst_low_flag_var()$variables$selected) >= 1L, + message = "Please select the Worst Low Grade flag variable." ), - need( - length(anl_selectors$worst_high_flag_var()$variables$selected) >= 1L, - "Please select the Worst High Grade flag variable." + teal::need_input( + inputId = "worst_high_flag_var-variables-selected", + condition = length(anl_selectors$worst_high_flag_var()$variables$selected) >= 1L, + message = "Please select the Worst High Grade flag variable." ) ) validate( - need( - !is.null(input$worst_flag_indicator) && nzchar(input$worst_flag_indicator), - "Please select a value indicating the worst grade." + teal::need_input( + inputId = "worst_flag_indicator", + condition = !is.null(input$worst_flag_indicator), + message = "Please select a value indicating the worst grade." ) ) @@ -558,9 +567,10 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. pcd$values$selected } validate( - need( - length(pcd_vals) >= 1L, - "Please select at least one Laboratory parameter." + teal::need_input( + inputId = "paramcd-values-selected", + condition = length(pcd_vals) >= 1L, + message = "Please select at least one Laboratory parameter." ) ) @@ -647,7 +657,9 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. obj <- anl_q() teal.reporter::teal_card(obj) <- c(teal.reporter::teal_card(obj), "### Table") - teal.code::eval_code(obj, as.expression(unlist(my_calls))) + obj <- teal.code::eval_code(obj, as.expression(unlist(my_calls))) + validate(need(!inherits(obj, "qenv.error"), obj$message)) + obj }) decorated_table_q <- teal::srv_transform_teal_data( diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index 7ad8ac17b..6aa8c5921 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -404,7 +404,11 @@ template_summary_by <- function(parentname, #' by_vars = variables(choices = c("PARAM", "AVISIT"), selected = "AVISIT"), #' summarize_vars = variables(choices = c("AVAL", "CHG"), selected = "AVAL"), #' useNA = "ifany", -#' paramcd = variables(choices = "PARAMCD") +#' paramcd = picks( +#' variables(choices = "PARAMCD"), +#' values(selected = "ALT"), +#' check_dataset = FALSE +#' ) #' ) #' ) #' ) @@ -444,7 +448,7 @@ tm_t_summary_by <- function(label, summarize_vars <- migrate_choices_selected_to_variables(summarize_vars) id_var <- migrate_choices_selected_to_variables(id_var) denominator <- migrate_choices_selected_to_values(denominator) - if (!is.null(paramcd)) paramcd <- migrate_value_choices_to_picks(paramcd, multiple = FALSE) + if (!is.null(paramcd)) paramcd <- migrate_value_choices_to_picks(paramcd, multiple = TRUE) checkmate::assert_string(label) checkmate::assert_string(dataname) diff --git a/man/tm_t_summary_by.Rd b/man/tm_t_summary_by.Rd index 42e01bb14..36260331c 100644 --- a/man/tm_t_summary_by.Rd +++ b/man/tm_t_summary_by.Rd @@ -179,7 +179,11 @@ app <- init( by_vars = variables(choices = c("PARAM", "AVISIT"), selected = "AVISIT"), summarize_vars = variables(choices = c("AVAL", "CHG"), selected = "AVAL"), useNA = "ifany", - paramcd = variables(choices = "PARAMCD") + paramcd = picks( + variables(choices = "PARAMCD"), + values(selected = "ALT"), + check_dataset = FALSE + ) ) ) ) @@ -195,8 +199,8 @@ apps implementing this module can be found. \section{Examples in Shinylive}{ \describe{ \item{example-1}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMBOhFoFuASgA60snGYFStAG5wABAB4AtDoBmgiOtol2cnQBUsAVQCiSpfyiko+o12oB9d09rNw8vQx0Ad1pSAAtaCHZAqFwdECUdHQBBABEAZQAZbx1SGAI-OAAPPyh+UWp0rOz8gCEikrLK6v5qeiUAX0UIACsieL8AazhWUUTQm3D+OGMoYVI-An5aUTKRscnp4Gh4GaS5AF1XaHQi+Oj2BqSdAF4dJNwGviERUWedT+ExPcIBkMiU-GtRIIYDAWKw-PQOA0QTpqFB6HBqL8FGBclCYWwdAidFgiBEdABxRhEQSoH62NEibHvYHI16hI66F7YnItJlIkEsGB+TQsX4ixi0BmAggxUYEMS-Aj3MCZLAAWSZOm56oAwtlsXI5MzWToavxwURPJiXvZnMbWQjhSwfi9xZL6N92DK5QqXkrsQAFVWZDV4LUqgBqAElclHbAaUqIMXB1HB+FjIzG4wn+RlIdCWLQAF5wJ2MF06N1SmbemS+nT+yOZfKa7E6gAS5ITOiTIlT6a5TZbYCNuZ0giTADlMhnaMsIKw+SzkagWLANmLC9WvbK6xXA8G1XqDfzBhlBoM5zp2PFyGoNNprDY0izRHEF5l0Ow0KgACSCWgUh-X8k0YbRGEGPolDAPoziAA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMBOhFoFuASgA60snGYFStAG5wABAB4AtDoBmgiOtol2cnQBUsAVQCiSpfyiko+o12oB9d09rNw8vQx0Ad1pSAAtaCHZAqFwdECUdHQBBABEAZQAZbx1SGAI-OAAPPyh+UWp0rOz8gCEikrLK6v5qeiUAX0UIACsieL8AazhWUUTQm3D+OGMoYVI-An5aUTKRscnp4Gh4GaS5AF1XaHQi+Oj2BqSdAF4dJNwGviERUWedT+ExPcIBkMiU-GtRIIYDAWKw-PQOA0QTpqFB6HBqL8FGBclCYWwdAidFgiBEdABxRhEQSoH62NEibHvYHI16hI66F7YnItJlIkEsGB+TQsX4ixi0BmAggxUYEMS-Aj3MCZLAAWSZOm56oAwtlsXI5MzWToavxwURPJiXvZnMbWQjhSwfi9xZL6N92DK5QqXkrsQAFVWZDV4LUqgBqAElclHbAaUqIMXB1HB+FjIzG4wn+RlIdCWLQAF5wJ2MF06N1SmbemS+nT+yOZfKa7E6gAS5ITOiTIlT6a5TZbYCNuZ0giTADlMhnaMsIKw+SzkagWLANr9UDJxjMxxkqx7pbK6xXA8G1Xqc8vWSLqIJAb2U+QB+Hm-GR-aTTKU+MAqEk6QvwAGLNrkLjXhkgzIlBOiDIMc46Ow8TkGoGjaNYNhpCyohxAumToOwaCoAAJIItApERxFJow2iMIMfRKGAfRnEAA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } } diff --git a/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md b/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md index 4171b4066..6fada8d3c 100644 --- a/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md +++ b/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md @@ -41,6 +41,8 @@ $table { + stopifnot(`No common arm levels in data, please check input.` = nrow(adsl) > + 0) table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -88,6 +90,8 @@ $table { + stopifnot(`No common arm levels in data, please check input.` = nrow(myadsl) > + 0) table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = myadsl) } diff --git a/tests/testthat/test-tm_t_summary_by.R b/tests/testthat/test-tm_t_summary_by.R index 2429a448d..ce4bb0f80 100644 --- a/tests/testthat/test-tm_t_summary_by.R +++ b/tests/testthat/test-tm_t_summary_by.R @@ -112,9 +112,16 @@ testthat::describe("template_summary_by rtables output for different statistics" parentname = "ADSL", arm_var = teal.picks::variables(choices = "ARM", selected = "ARM", fixed = TRUE), by_vars = teal.picks::variables(choices = "AVISIT", selected = "AVISIT", fixed = TRUE), - summarize_vars = teal.picks::variables(choices = "AVALC", selected = "AVALC", fixed = TRUE), + summarize_vars = teal.picks::variables(choices = "AVALC", selected = "AVALC", fixed = TRUE, multiple = TRUE), categorical_stats = "count", - paramcd = teal.picks::variables(choices = "PARAMCD") + paramcd = suppressWarnings( + teal.picks::picks( + teal.picks::variables(choices = "PARAMCD", selected = "PARAMCD"), + teal.picks::values(selected = "ALT", multiple = TRUE), + check_dataset = FALSE + ), + classes = "pick_delayed" + ) ) it("adds 'fraction' to the statistics", {