Skip to content

Migrate tm_g_terms_id to picks #341

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
osenan wants to merge 5 commits into from
Closed

Migrate tm_g_terms_id to picks #341

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
7d2ca7e
refactor: do not use S3 dispatch
osenan Jul 9, 2026
c1f209e
chore: fix failing checks
osenan Jul 9, 2026
90dea42
[skip style] [skip vbump] Restyle files
github-actions[bot] Jul 9, 2026
d91552a
[skip roxygen] [skip vbump] Roxygen Man Pages Auto Update
github-actions[bot] Jul 9, 2026
dbe53a3
Merge branch 'redesign_extraction@main' into tm_g_events-term_id@rede…
llrs-roche Jul 13, 2026
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
1 change: 0 additions & 1 deletion NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ export(tm_g_ae_oview)
export(tm_g_ae_sub)
export(tm_g_butterfly)
export(tm_g_events_term_id)
export(tm_g_events_term_id.picks)
export(tm_g_heat_bygrade)
export(tm_g_patient_profile)
export(tm_g_spiderplot)
Expand Down
191 changes: 110 additions & 81 deletions R/tm_g_events_term_id.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,15 +1,21 @@
#' Events by Term Plot Teal Module
#'
#' Display an events-by-term plot as a Shiny module using [teal.picks::picks()] encodings.
#' Display an events-by-term plot as a Shiny module using [teal.picks::variables()] encodings.
#'
#' @inheritParams teal.widgets::standard_layout
#' @inheritParams teal::module
#' @inheritParams argument_convention
#' @param term_var (`picks`)\cr
#' [teal.picks::picks()] object for the event term variable (single selection).
#' @param arm_var (`picks`)\cr
#' [teal.picks::picks()] object for the treatment arm variable (single selection).
#' The arm variable must be a factor in the analysis data.
#' @param term_dataname optional (`character(1)`) dataset name used to initialize
#' `term_var` when provided as [teal.picks::variables()] or a legacy
#' `choices_selected` object.
#' @param term_var Either [teal.picks::variables()] (preferred) or a legacy
#' `choices_selected`-style object for the event term variable (single selection).
#' @param arm_dataname dataset name used to initialize
#' `arm_var` when provided as [teal.picks::variables()] or a legacy
#' `choices_selected` object.
#' @param arm_var Either [teal.picks::variables()] (preferred) or a legacy
#' `choices_selected`-style object for the treatment arm variable (single selection).
#' The selected arm variable must be a factor in the analysis data.
#'
#' @inherit argument_convention return
#' @inheritSection teal::example_module Reporting
Expand All @@ -33,19 +39,15 @@
#' modules = modules(
#' tm_g_events_term_id(
#' label = "Common AE",
#' term_var = teal.picks::picks(
#' teal.picks::datasets("ADAE"),
#' teal.picks::variables(
#' choices = teal.picks::is_categorical(min.len = 2),
#' selected = "AEDECOD"
#' )
#' term_dataname = "ADAE",
#' term_var = teal.picks::variables(
#' choices = teal.picks::is_categorical(min.len = 2),
#' selected = "AEDECOD"
#' ),
#' arm_var = teal.picks::picks(
#' teal.picks::datasets("ADSL"),
#' teal.picks::variables(
#' choices = teal.picks::is_categorical(min.len = 2),
#' selected = "ACTARMCD"
#' )
#' arm_dataname = "ADSL",
#' arm_var = teal.picks::variables(
#' choices = teal.picks::is_categorical(min.len = 2),
#' selected = "ACTARMCD"
#' ),
#' plot_height = c(600, 200, 2000)
#' )
Expand All @@ -55,38 +57,45 @@
#' shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_events_term_id <- function(label = "Common AE",
term_var = teal.picks::picks(
teal.picks::datasets(),
teal.picks::variables(
choices = teal.picks::is_categorical(min.len = 2),
selected = 1L
)
term_dataname = NULL,
term_var = teal.picks::variables(
choices = teal.picks::is_categorical(min.len = 2),
selected = 1L
),
arm_var = teal.picks::picks(
teal.picks::datasets(),
teal.picks::variables(
choices = teal.picks::is_categorical(min.len = 2),
selected = 1L
)
arm_dataname = NULL,
arm_var = teal.picks::variables(
choices = teal.picks::is_categorical(min.len = 2),
selected = 1L
),
fontsize = c(5, 3, 7),
plot_height = c(600L, 200L, 2000L),
plot_width = NULL,
transformators = list()) {
message("Initializing tm_g_event_term_id")
checkmate::assert_string(label)
checkmate::assert_string(term_dataname, null.ok = TRUE)
checkmate::assert_string(arm_dataname, null.ok = TRUE)

term_var <- migrate_choices_selected_to_variables(term_var, arg_name = "term_var", multiple = FALSE)
arm_var <- migrate_choices_selected_to_variables(arm_var, arg_name = "arm_var", multiple = FALSE)

term_datasets <- if (is.null(term_dataname)) teal.picks::datasets() else teal.picks::datasets(term_dataname)
arm_datasets <- if (is.null(arm_dataname)) teal.picks::datasets() else teal.picks::datasets(arm_dataname)

checkmate::assert_class(term_var, "picks", .var.name = "term_var")
checkmate::assert_false(
teal.picks::is_pick_multiple(term_var$variables),
.var.name = "`term_var` must use variables(..., multiple = FALSE)"
term_var <- create_picks_helper(
term_datasets,
term_var
)
checkmate::assert_class(arm_var, "picks", .var.name = "arm_var")
checkmate::assert_false(
teal.picks::is_pick_multiple(arm_var$variables),
.var.name = "`arm_var` must use variables(..., multiple = FALSE)"
arm_var <- create_picks_helper(
arm_datasets,
arm_var
)

.assert_picks_single_var(term_var, "term_var")
.assert_picks_single_var(arm_var, "arm_var")
Comment on lines +96 to +97

@osenan osenan Jul 9, 2026

Copy link
Copy Markdown
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This util needs to be refactored to be consistent with other modules that force the picks to be single

@llrs-roche llrs-roche Jul 13, 2026

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Do you mean that this line needs to change or that there are further changes needed on utils.R or on teal.picks to provide this functionality?


checkmate::assert(
checkmate::check_number(fontsize, finite = TRUE),
checkmate::assert(
Expand Down Expand Up @@ -334,15 +343,19 @@ srv_g_events_term_id <- function(id,

output_q <- reactive({
merged_vars <- merge_vars()
validate(
need(
length(merged_vars[["term_var"]]) > 0L,
"Please select a term variable"
),
need(
length(merged_vars[["arm_var"]]) > 0L,
"Please select an arm variable"
)
teal::validate_input(
"term_var",
condition = function(term_var_input) {
length(merged_vars[["term_var"]]) > 0L
},
message = "Please select a term variable"
)
teal::validate_input(
"arm_var",
condition = function(arm_var_input) {
length(merged_vars[["arm_var"]]) > 0L
},
message = "Please select an arm variable"
)

term_var_name <- merged_vars[["term_var"]][[1L]]
Expand All @@ -355,19 +368,27 @@ srv_g_events_term_id <- function(id,
qenv <- anl_q()
ANL <- qenv[["ANL"]]

validate(
need(
is.factor(ANL[[arm_var_name]]),
"Arm Variable must be a factor variable."
),
need(
input$arm_trt %in% ANL[[arm_var_name]] && input$arm_ref %in% ANL[[arm_var_name]],
"Cannot generate plot. The dataset does not contain subjects from both the control and treatment arms."
),
need(
!isTRUE(input$arm_trt == input$arm_ref),
"Control and Treatment must be different."
)
teal::validate_input(
"arm_var",
condition = function(arm_var_input) {
is.factor(ANL[[arm_var_name]])
},
message = "Arm Variable must be a factor variable."
)
teal::validate_input(
c("arm_trt", "arm_ref"),
condition = function(arm_trt, arm_ref) {
arm_trt %in% ANL[[arm_var_name]] && arm_ref %in% ANL[[arm_var_name]]
},
message = "Cannot generate plot. The dataset does not contain subjects
from both the control and treatment arms."
)
teal::validate_input(
c("arm_trt", "arm_ref"),
condition = function(arm_trt, arm_ref) {
!isTRUE(arm_trt == arm_ref)
},
message = "Control and Treatment must be different."
)

teal::validate_has_data(
Expand All @@ -378,28 +399,36 @@ srv_g_events_term_id <- function(id,

teal.reporter::teal_card(qenv) <- c(teal.reporter::teal_card(qenv), "### Plot")

teal.code::eval_code(
qenv,
code = bquote(
plot <- osprey::g_events_term_id(
term = ANL[[.(term_var_name)]],
id = ANL$USUBJID,
arm = ANL[[.(arm_var_name)]],
arm_N = table(.(as.name(arm_dataset))[[.(arm_var_orig)]]),
ref = .(input$arm_ref),
trt = .(input$arm_trt),
sort_by = .(input$sort),
rate_range = .(input$raterange),
diff_range = .(input$diffrange),
reversed = .(input$reverse),
conf_level = .(input$conf_level),
diff_ci_method = .(input$diff_ci_method),
axis_side = .(input$axis),
fontsize = .(font_size()),
draw = TRUE
)
arm_ref <- input$arm_ref
arm_trt <- input$arm_trt
sort_by <- input$sort
rate_range <- input$raterange
diff_range <- input$diffrange
reversed <- input$reverse
conf_level <- input$conf_level
diff_ci_method <- input$diff_ci_method
axis_side <- input$axis
fontsize <- font_size()

within(qenv, {
plot <- osprey::g_events_term_id(
term = ANL[[term_var_name]],
id = ANL$USUBJID,
arm = ANL[[arm_var_name]],
arm_N = table(get(arm_dataset)[[arm_var_orig]]),
ref = arm_ref,
trt = arm_trt,
sort_by = sort_by,
rate_range = rate_range,
diff_range = diff_range,
reversed = reversed,
conf_level = conf_level,
diff_ci_method = diff_ci_method,
axis_side = axis_side,
fontsize = fontsize,
draw = TRUE
)
)
})

@llrs-roche llrs-roche Jul 13, 2026

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Remember to pass the variables inside the reactive that are not present on the qenv:

Suggested change
})
},
term_var_name = term_var_name,)

You'll need to do the same with other variables that are passed as arguments.Line 418, shouldn't need to use get().

})

plot_r <- reactive(output_q()[["plot"]])
Expand Down
Loading
Loading