add to specs.R and create corresponding test

Author: gm-ebs-ext

R/mod_patient_profile.R

@@ -356,6 +356,13 @@ mod_patient_profile <- function(module_id = "",
       grading_vals <- get_grading_vals(plots[["range_plots"]], afmm[["data"]])
       plots[["palette"]] <- fill_palette(grading_vals, plots[["palette"]])
 
+      testing <- isTRUE(getOption("shiny.testmode"))
+      if (testing) {
+        filled_palette <<- plots[["palette"]]
+        gradings <<- grading_vals
+        shiny::exportTestValues(gradings = gradings, filled_palette = filled_palette)
+      }
+
       filtered_mapped_datasets <- shiny::reactive(
         T_honor_map_to_flag(afmm$filtered_dataset(), mod_patient_profile_API, args)
       )

inst/validation/specs.R

@@ -22,7 +22,8 @@ specs <- list(
     common = list(
       tooltips = "Hovering over salient plot elements provides extra information",
       palettes = "Plots can be customized by assigning specific colors to elements denoted by text strings",
-      no_data_message = "Plots explain there is no data when there is no data"
+      no_data_message = "Plots explain there is no data when there is no data",
+      palette_is_filled = "Color palette will be completed with colors for all grading values if any are missing."
     ),
     value = list(
       parameter_selection = "User can select parameters for value plots"

tests/testthat/apps/grading_palette_colors/app.R

@@ -0,0 +1,115 @@
+dataset_list <- list("demo" = dv.papo:::prep_safety_data(5))
+
+module_list <- list(
+  "Papo" = dv.papo::mod_patient_profile(
+    module_id = "grading_app", subjid_var = "USUBJID", sender_ids = NULL,
+    subject_level_dataset_name = "adsl",
+    summary = list(
+      vars = c("SITEID", "AGE", "SEX", "RACE", "ETHNIC", "ARM", "DCREASCD", "TRT01A"),
+      column_count = 3
+    ),
+    plots = list(
+      timeline_info = c(
+        trt_start_date = "TRTSDT",
+        trt_end_date = "TRTEDT",
+        icf_date = "RFICDT", # optional
+        part_end_date = "RFENDT" # optional
+      ),
+      vline_vars = c(
+        "Informed Consent Day" = "RFICDT", # because optional above
+        # "Study Treatment Start Day" = "TRTSDT", #added by me
+        "Study Treatment Stop Day" = "TRTEDT"
+      ),
+      vline_day_numbers = c("Study Treatment Start Day : Day 1" = 1), # optional
+      range_plots = list(
+        "Adverse Events Plot" = list(
+          dataset = "adae",
+          vars = c(
+            start_date = "ASTDT",
+            end_date = "AENDT",
+            decode = "AEDECOD",
+            grading = "AESEV", # optional
+            serious_ae = "AESER" # optional
+          ),
+          tooltip = c(
+            "AE Term: " = "AEDECOD",
+            "AE Reported Term: " = "AETERM",
+            "Primary SOC: " = "AESOC",
+            "Intensity: " = "AESEV",
+            "Serious Event: " = "AESER",
+            "AE Start Date: " = "ASTDT",
+            "AE Stop Date: " = "AENDT",
+            "AE Start Day: " = "ASTDY",
+            "AE Stop Day: " = "AENDY"
+          )
+        ),
+        "Concomitant Medication Plot" = list(
+          dataset = "cm",
+          vars = c(
+            start_date = "CMSTDT",
+            end_date = "CMENDT",
+            decode = "CMDECOD",
+            grading = "CMINDC"
+          ),
+          tooltip = c(
+            "Standardized Medication Name: " = "CMDECOD",
+            "Indication: " = "CMINDC",
+            "CM Dose: " = "CMDOSE",
+            "CM Dose Unit: " = "CMDOSU",
+            "CM START Date: " = "CMSTDTC",
+            "CM End Date: " = "CMENDTC",
+            "CM START Day: " = "CMSTDY",
+            "CM END Day: " = "CMENDY"
+          )
+        )
+      ),
+      value_plots = list(
+        "Lab plot" = list(
+          dataset = "lb",
+          vars = c(
+            analysis_param = "PARAM",
+            analysis_val = "AVAL",
+            analysis_date = "ADT",
+            analysis_indicator = "ANRIND",
+            range_low_limit = "A1LO",
+            range_high_limit = "A1HI"
+          ),
+          tooltip = c(
+            "Lab Parameter: " = "PARAM",
+            "Lab Test Date: " = "ADT",
+            "Lab Test Visit :" = "AVISIT",
+            "<br>High Limit: " = "A1HI",
+            "Lab Standard Value: " = "AVAL",
+            "Lower Limit: " = "A1LO",
+            "<br>Analysis Indicator: " = "ANRIND"
+          )
+        ),
+        "Vital Sign Plot" = list(
+          dataset = "vs",
+          vars = c(
+            analysis_param = "PARAM",
+            analysis_val = "AVAL",
+            analysis_date = "ADT",
+            analysis_indicator = "VISIT",
+            range_low_limit = NULL,
+            range_high_limit = NULL,
+            summary_stats = "AVAL_MEAN"
+          ),
+          tooltip = c(
+            "Vital sign Parameter: " = "PARAM",
+            "Vital sign Date: " = "ADT",
+            "Vital sign Visit: " = "AVISIT",
+            "<br>Vital sign Value: " = "AVAL",
+            "Vital sign mean value by visits: " = "AVAL_MEAN"
+          )
+        )
+      )
+    )
+  )
+)
+
+dv.manager::run_app(
+  data = dataset_list,
+  module_list = module_list,
+  filter_data = "adsl"
+)

tests/testthat/test-all.R

@@ -350,3 +350,29 @@ test_that(
     app$stop()
   }
 )
+
+test_that(
+  "Color palette is filled when there are missing entries for grading values" |>
+    vdoc[["add_spec"]](c(specs$plots$common$palette_is_filled)), {
+
+  app <- shinytest2::AppDriver$new(
+    app_dir = "apps/grading_palette_colors/",
+    name = "grading_colors_app"
+  )
+
+  app_grading_vals <- setdiff(app$get_value(export = "gradings"), NA)
+  app_filled_palette <- app$get_value(export = "filled_palette")
+
+  expect_true(all(app_grading_vals %in% names(app_filled_palette))) # check all grading vals present in palette.
+
+  grading_palette <- app_filled_palette[app_grading_vals]
+  expect_length(grading_palette |> unique, length(app_grading_vals))
+
+  #check colors were filled.
+  # i. check which grading vals had no color assigned in CONST default palette
+  unmapped_grading_vals <- setdiff(app_grading_vals, names(dv.papo:::CONST$default_palette))
+
+  # ii. check a color was then assigned.
+  expect_length(grading_palette[unmapped_grading_vals], length(unmapped_grading_vals))
+
+})