Measure output

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

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]])

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)
 }

renv.lock

@@ -1239,7 +1239,7 @@
       "RemoteUsername": "posit-dev",
       "RemoteRepo": "commons",
       "RemoteRef": "rich-output-56",
-      "RemoteSha": "db59dde67ba1e8dcfd707e049c996eb0333b7095"
+      "RemoteSha": "a48ba1c35593b7fe1322242cb17de6b42c91f59d"
     },
     "coro": {
       "Package": "coro",

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, "<table", fixed = TRUE)
-    expect_identical(result$model_content, result$html)
+    expect_s7_class(result, ellmer::ContentToolResult)
+    expect_s3_class(result@value, "data.frame")
+    expect_s3_class(result@extra$display$html, "shiny.tag")
+    expect_true(methods::is(result@extra$data, "VTableTree"))
+    expect_true(result@extra$display$open)
+    expect_true(result@extra$display$full_screen)
   }
 })
 
 test_that("frequent adverse events preserve grouped column headers", {
   result <- measure_env$ae_frequent_by_grade()
+  html <- as.character(result@extra$display$html)
 
-  expect_match(result$html, "Any Grade (%)", fixed = TRUE)
-  expect_match(result$html, "Grade 3-4 (%)", fixed = TRUE)
-  expect_match(result$html, "Grade 5 (%)", fixed = TRUE)
-  expect_match(result$html, "colspan=", fixed = TRUE)
+  expect_match(html, "Any Grade (%)", fixed = TRUE)
+  expect_match(html, "Grade 3-4 (%)", fixed = TRUE)
+  expect_match(html, "Grade 5 (%)", fixed = TRUE)
+  expect_match(html, "colspan=", fixed = TRUE)
 })