Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
72 changes: 45 additions & 27 deletions R/tm_t_abnormality_by_worst_grade.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -359,9 +360,6 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length.
worst_high_flag_var <- migrate_choices_selected_to_variables(worst_high_flag_var)
worst_low_flag_var <- migrate_choices_selected_to_variables(worst_low_flag_var)
worst_flag_indicator <- migrate_choices_selected_to_values(worst_flag_indicator)
worst_flag_value <- as.character(worst_flag_indicator$selected)
checkmate::assert_character(worst_flag_value, min.len = 1L, .var.name = "worst_flag_indicator$selected")
worst_flag_value <- worst_flag_value[[1]]

checkmate::assert_string(label)
checkmate::assert_string(dataname)
Expand Down Expand Up @@ -399,7 +397,7 @@ ui_t_abnormality_by_worst_grade <- function(id, # nolint: object_length.
atoxgr_var,
worst_high_flag_var,
worst_low_flag_var,
worst_flag_value,
worst_flag_indicator,
add_total,
drop_arm_levels,
id_var,
Expand Down Expand Up @@ -444,9 +442,13 @@ ui_t_abnormality_by_worst_grade <- function(id, # nolint: object_length.
),
tags$div(
tags$label("Value Indicating Worst Grade"),
tags$p(
class = "tm-abnormality-worst-grade-worst-flag-value text-muted mb-0",
worst_flag_value
teal.widgets::optionalSelectInput(
ns("worst_flag_indicator"),
label = NULL,
choices = worst_flag_indicator$choices,
selected = if (is.function(worst_flag_indicator$selected)) NULL else worst_flag_indicator$selected,
multiple = FALSE,
fixed = teal.picks::is_pick_fixed(worst_flag_indicator)
)
),
checkboxInput(
Expand All @@ -471,7 +473,6 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length.
arm_var,
paramcd,
atoxgr_var,
worst_flag_value,
worst_low_flag_var,
worst_high_flag_var,
add_total,
Expand Down Expand Up @@ -522,26 +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(
teal::need_input(
inputId = "worst_flag_indicator",
condition = !is.null(input$worst_flag_indicator),
message = "Please select a value indicating the worst grade."
)
)

Expand All @@ -552,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."
)
)

Expand Down Expand Up @@ -632,7 +648,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length.
atoxgr_var = as.vector(anl_selectors$atoxgr_var()$variables$selected),
worst_high_flag_var = as.vector(anl_selectors$worst_high_flag_var()$variables$selected),
worst_low_flag_var = as.vector(anl_selectors$worst_low_flag_var()$variables$selected),
worst_flag_indicator = worst_flag_value,
worst_flag_indicator = input$worst_flag_indicator,
add_total = input$add_total,
total_label = total_label,
drop_arm_levels = input$drop_arm_levels,
Expand All @@ -641,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(
Expand Down
2 changes: 1 addition & 1 deletion R/tm_t_binary_outcome.R
Original file line number Diff line number Diff line change
Expand Up @@ -827,7 +827,7 @@ srv_t_binary_outcome <- function(id,
paramcd_pick$values$selected
}

if (c(any(!is.data.frame(anl), nrow(anl) == 0L, length(aval_var) == 0L, length(paramcd_sel) == 0L))){
if (c(any(!is.data.frame(anl), nrow(anl) == 0L, length(aval_var) == 0L, length(paramcd_sel) == 0L))) {
return(invisible(NULL))
}

Expand Down
8 changes: 6 additions & 2 deletions R/tm_t_summary_by.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
#' )
#' )
#' )
#' )
Expand Down Expand Up @@ -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)
Expand Down
10 changes: 7 additions & 3 deletions man/tm_t_summary_by.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 4 additions & 0 deletions tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}

Expand Down Expand Up @@ -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)
}

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -94,7 +94,7 @@ testthat::test_that(
"WGRLOFL"
)
testthat::expect_equal(
app_driver$get_text(".tm-abnormality-worst-grade-worst-flag-value"),
app_driver$get_active_module_input("worst_flag_indicator"),
"Y"
)
}
Expand Down
11 changes: 9 additions & 2 deletions tests/testthat/test-tm_t_summary_by.R
Original file line number Diff line number Diff line change
Expand Up @@ -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", {
Expand Down
Loading