diff --git a/dictionaries/adam.data-dict.yaml b/dictionaries/adam.data-dict.yaml index b709b9f..cbbd634 100644 --- a/dictionaries/adam.data-dict.yaml +++ b/dictionaries/adam.data-dict.yaml @@ -622,8 +622,9 @@ tables: values: [WEEKS, YEARS] - name: CNSR label: Censor - type: enum - values: {0: "Event occurred", 1: "Censored (no event observed)"} + type: number(id) + examples: [0, 1] + details: 0 means the event occurred; 1 means no event was observed. - name: EVNTDESC label: Event or Censoring Description type: string diff --git a/measures/helpers.R b/measures/helpers.R index ff75adb..ab6cccd 100644 --- a/measures/helpers.R +++ b/measures/helpers.R @@ -10,8 +10,8 @@ # random.cdisc.data. A measure body mirrors the catalog recipe (same tern / # rtables composition), with the inputs a monitor would vary lifted to # documented @param arguments; everything else stays hardcoded as vetted. -# Measures return either a tidy data frame or, when the table's hierarchy is -# meaningful, a rich table whose authored HTML is shared with the agent. Each +# Table measures give the agent a tidy data frame, show the user the formatted +# table, and retain the original rtables object for follow-up computation. Each # measure carries an @provenance tag pinning the exact catalog source it came # from. # @@ -45,12 +45,26 @@ filter_population <- function( dplyr::filter(adsl, .data[[flag]] == "Y") } -# Convert a built rtables TableTree into a flat, labelled data frame for the -# agent: one row per statistic, one column per treatment arm, cells as the -# standard "n (%)" / "mean (sd)" / "min - max" strings. Drops as_result_df()'s -# internal layout metadata, keeping the human-readable row label and the arm -# value columns. Formatted strings (rather than numeric list-columns) are the -# one shape that is uniform across count and descriptive-statistic tables. +tlg_result <- function(tt) { + ellmer::ContentToolResult( + value = tidy_tlg(tt), + extra = list( + display = shinychat::tool_result_display( + html = rtables::as_html(tt, width = "100%"), + open = TRUE, + full_screen = TRUE + ), + data = tt + ) + ) +} + +# Convert a built rtables table into a flat, labelled data frame for the agent: +# one row per statistic, one column per treatment arm, cells as the standard +# "n (%)" / "mean (sd)" / "min - max" strings. Drops as_result_df()'s internal +# layout metadata, keeping the human-readable row label and the arm value +# columns. Formatted strings (rather than numeric list-columns) are the one +# shape that is uniform across count and descriptive-statistic tables. tidy_tlg <- function(tt) { df <- as_result_df(tt, data_format = "strings", keep_label_rows = TRUE) meta <- c( @@ -65,13 +79,6 @@ tidy_tlg <- function(tt) { df } -rich_tlg <- function(tt) { - commons::rich_table( - tt, - html = rtables::as_html(tt, width = "100%") - ) -} - measure_choice <- function(value, choices, arg, call = rlang::caller_env()) { if (length(value) > 1 && identical(value, choices)) { return(value[[1]]) diff --git a/measures/tables.R b/measures/tables.R index 79bc9de..f3c9b7e 100644 --- a/measures/tables.R +++ b/measures/tables.R @@ -90,7 +90,7 @@ ae_overview <- function(population = c("SAF", "ITT"), result_adae[3:nrow(result_adae), ] ) - tidy_tlg(result) + tlg_result(result) } #' Patient disposition @@ -131,7 +131,7 @@ disposition <- function(population = c("SAF", "ITT"), analyze_vars("DCSREAS", .stats = "count_fraction", denom = "N_col", show_labels = "hidden") result <- prune_table(build_table(lyt, df = adsl)) - tidy_tlg(result) + tlg_result(result) } #' Study drug exposure @@ -173,7 +173,7 @@ exposure_summary <- function(population = c("SAF", "ITT"), analyze_vars(vars = "AVAL") result <- build_table(lyt, df = adex, alt_counts_df = adsl) - tidy_tlg(result) + tlg_result(result) } #' Demographics and baseline characteristics @@ -228,7 +228,7 @@ demography <- function(population = c("SAF", "ITT"), analyze_vars(vars = vars, var_labels = var_labels) %>% build_table(adsl) - tidy_tlg(result) + tlg_result(result) } #' Adverse events by system organ class and preferred term @@ -309,7 +309,7 @@ ae_by_soc_pt <- function(population = c("SAF", "ITT"), ) } - rich_tlg(result) + tlg_result(result) } #' Adverse events by highest toxicity grade @@ -379,7 +379,7 @@ ae_by_grade <- function(population = c("SAF", "ITT"), sort_at_path(path = "AEBODSYS", scorefun = score_all_sum, decreasing = TRUE) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_all_sum, decreasing = TRUE) - tidy_tlg(result) + tlg_result(result) } #' Deaths @@ -415,7 +415,7 @@ deaths <- function(population = c("SAF", "ITT"), analyze_vars(vars = "DTHCAT", var_labels = "Primary Cause of Death") result <- build_table(lyt, df = adsl) - tidy_tlg(result) + tlg_result(result) } #' Laboratory abnormalities not present at baseline @@ -462,7 +462,7 @@ lab_abnormalities <- function(population = c("SAF", "ITT"), append_varlabels(adlb, "ANRIND", indent = 1L) result <- build_table(lyt, df = adlb, alt_counts_df = adsl) - tidy_tlg(result) + tlg_result(result) } #' Adverse events by greatest intensity @@ -530,7 +530,7 @@ ae_by_intensity <- function(population = c("SAF", "ITT"), sort_at_path(path = "AEBODSYS", scorefun = cont_n_allcols, decreasing = TRUE) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = cont_n_allcols, decreasing = TRUE) - tidy_tlg(result) + tlg_result(result) } #' Most frequent adverse events by highest toxicity grade @@ -616,7 +616,7 @@ ae_frequent_by_grade <- function(population = c("SAF", "ITT"), trim_rows(criteria = criteria_fun) %>% prune_table(keep_rows(at_least_10percent_any)) - rich_tlg(result) + tlg_result(result) } #' Adverse events by sex @@ -684,7 +684,7 @@ ae_by_sex <- function(population = c("SAF", "ITT"), sort_at_path(path = c("AEBODSYS"), scorefun = cont_n_allcols) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_occurrences) - rich_tlg(result) + tlg_result(result) } #' Adverse events related to study drug @@ -755,7 +755,7 @@ ae_related <- function(population = c("SAF", "ITT"), sort_at_path(path = c("AEBODSYS"), scorefun = cont_n_allcols) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_occurrences) - tidy_tlg(result) + tlg_result(result) } #' Most frequent adverse events @@ -799,7 +799,7 @@ ae_most_frequent <- function(population = c("SAF", "ITT"), ) result <- sort_at_path(tbl, path = c("AEDECOD"), scorefun = score_occurrences) - tidy_tlg(result) + tlg_result(result) } #' Adverse event rate adjusted for patient-years at risk @@ -837,5 +837,5 @@ ae_incidence_rate <- function(population = c("SAF", "ITT"), ) result <- build_table(lyt, anl, alt_counts_df = adsl) - tidy_tlg(result) + tlg_result(result) } diff --git a/renv.lock b/renv.lock index 0fa75ef..70d84a5 100644 --- a/renv.lock +++ b/renv.lock @@ -1239,7 +1239,7 @@ "RemoteUsername": "posit-dev", "RemoteRepo": "commons", "RemoteRef": "rich-output-56", - "RemoteSha": "db59dde67ba1e8dcfd707e049c996eb0333b7095" + "RemoteSha": "a48ba1c35593b7fe1322242cb17de6b42c91f59d" }, "coro": { "Package": "coro", diff --git a/tests/testthat/test-tables.R b/tests/testthat/test-tables.R index 52d8950..b3bde78 100644 --- a/tests/testthat/test-tables.R +++ b/tests/testthat/test-tables.R @@ -1,27 +1,39 @@ -test_that("complex table measures return rich rtables output", { +test_that("table measures return model, display, and computation values", { measure_names <- c( + "ae_overview", + "disposition", + "exposure_summary", + "demography", "ae_by_soc_pt", + "ae_by_grade", + "deaths", + "lab_abnormalities", + "ae_by_intensity", "ae_frequent_by_grade", - "ae_by_sex" + "ae_by_sex", + "ae_related", + "ae_most_frequent", + "ae_incidence_rate" ) for (measure_name in measure_names) { - result <- measure_env[[measure_name]]() + result <- suppressWarnings(measure_env[[measure_name]]()) - expect_s3_class(result, "commons_rich_table") - expect_s4_class(result$value, "TableTree") - expect_type(result$html, "character") - expect_length(result$html, 1) - expect_match(result$html, "