Skip to content

Commit aaca31b

Browse files
iglaussiglauss
authored
Merge pull request #18 from Boehringer-Ingelheim/257261_default_col_palette
add colours for grading values without assigned col in palette
2 parents 47545d2 + e6beb71 commit aaca31b

11 files changed

Lines changed: 309 additions & 8 deletions

File tree

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: dv.papo
22
Title: Patient Profile
3-
Version: 2.0.6-900
3+
Version: 2.0.7.9000
44
Date: 2024-08-13
55
Authors@R:
66
c(person("Boehringer-Ingelheim Pharma GmbH & Co.KG", role = c("cph", "fnd")),
@@ -21,7 +21,7 @@ License: Apache License (>= 2)
2121
Encoding: UTF-8
2222
LazyData: true
2323
Roxygen: list(markdown = TRUE)
24-
RoxygenNote: 7.3.0
24+
RoxygenNote: 7.3.2
2525
Depends:
2626
R (>= 4.1.0)
2727
Imports:

‎NEWS.md‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,19 @@
1-
# dv.papo 2.0.6-900
1+
# dv.papo 2.0.7.9000
2+
- Fixes missing palette colours for AE, CM grading values.
3+
4+
# dv.papo 2.0.6.9000
25
- Update to provide early error feedback if a sender_id is not available in list of modules.
36

4-
# dv.papo 2.0.4-900
7+
# dv.papo 2.0.4.9000
58
- Fixes issue with labels not working fully if a data.frame is passed as input.
69

7-
# dv.papo 2.0.3-900
10+
# dv.papo 2.0.3.9000
811
- Fixes y-axis getting squashed if blank values present in DECODE variable for AE/CM plots.
912

10-
# dv.papo 2.0.2-900
13+
# dv.papo 2.0.2.9000
1114
- Fixes Serious AE labels mapping when the column is a "Y/N" `character` or `factor` variable instead of `logical`.
1215

16+
1317
# dv.papo 2.0.1
1418

1519
- Fixes failed first interaction when a participant is selected from another module

‎R/mod_patient_profile.R‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -352,6 +352,17 @@ mod_patient_profile <- function(module_id = "",
352352
ui = dv.papo::mod_patient_profile_UI(module_id)
353353
)
354354

355+
# set palette colours for range_plots
356+
grading_vals <- get_grading_vals(plots[["range_plots"]], afmm[["data"]])
357+
plots[["palette"]] <- fill_palette(grading_vals, plots[["palette"]])
358+
359+
testing <- isTRUE(getOption("shiny.testmode"))
360+
if (testing) {
361+
filled_palette <<- plots[["palette"]]
362+
gradings <<- grading_vals
363+
shiny::exportTestValues(gradings = gradings, filled_palette = filled_palette)
364+
}
365+
355366
filtered_mapped_datasets <- shiny::reactive(
356367
T_honor_map_to_flag(afmm$filtered_dataset(), mod_patient_profile_API, args)
357368
)

‎R/utils-palette.R‎

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
#' Extract grading values using plot vars list and afmm data
2+
#'
3+
#' @param input_plots `[list(1+)]`
4+
#' @param afmm_data `[list(1+)]`
5+
#'
6+
#' @return `[character(1+)]`
7+
#' @keywords internal
8+
get_grading_vals <- function(input_plots, afmm_data) {
9+
grading_vals <- sapply(afmm_data, function(dataset) {
10+
sapply(input_plots, function(plot_type) {
11+
dataset[[plot_type$dataset]][plot_type$vars[["grading"]]]
12+
})
13+
}) |> unlist() |> unique()
14+
return(grading_vals)
15+
}
16+
17+
#' Create/complete a colour palette which maps colours to grading levels.
18+
#'
19+
#' @param grading_vals `[character(1+)]` vector of grading values/levels.
20+
#' @param user_palette `[character(1+) | NULL]` named character vector mapping colour(s) to grading level(s).
21+
#'
22+
#' @return `[character(1+)]` an updated colour palette where colours are mapped to ALL grading levels.
23+
#' @keywords internal
24+
fill_palette <- function(grading_vals, user_palette = NULL) {
25+
26+
# user palette complements default
27+
existing_palette <- unlist(
28+
utils::modifyList(
29+
as.list(CONST[["default_palette"]]),
30+
as.list(user_palette)
31+
)
32+
)
33+
34+
unmapped_vals <- setdiff(grading_vals, c(names(existing_palette), NA))
35+
36+
available_colours <- c("orange",
37+
"green",
38+
"cyan",
39+
"blue",
40+
"magenta",
41+
"purple",
42+
"black",
43+
"pink",
44+
"khaki",
45+
"turquoise",
46+
"navyblue",
47+
"violet",
48+
"yellowgreen",
49+
"skyblue",
50+
"indianred",
51+
"cornsilk",
52+
"chocolate",
53+
"darkgoldenrod",
54+
"coral",
55+
"dodgerblue")
56+
57+
if (length(unmapped_vals) > 0) {
58+
unused_colours <- setdiff(available_colours, existing_palette)
59+
60+
#to ensure there is always a color that can be assigned.
61+
if (!length(unused_colours) || length(unused_colours) < length(unmapped_vals)) {
62+
unused_colours <- setdiff(colors(), c(existing_palette, "white"))
63+
}
64+
65+
pal_generator <- colorRampPalette(unused_colours)
66+
new_palette <- structure(pal_generator(length(unmapped_vals)), names = unmapped_vals)
67+
68+
return(c(existing_palette, new_palette))
69+
70+
} else {
71+
return(existing_palette)
72+
}
73+
}
74+

‎inst/validation/specs.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,8 @@ specs <- list(
2222
common = list(
2323
tooltips = "Hovering over salient plot elements provides extra information",
2424
palettes = "Plots can be customized by assigning specific colors to elements denoted by text strings",
25-
no_data_message = "Plots explain there is no data when there is no data"
25+
no_data_message = "Plots explain there is no data when there is no data",
26+
palette_is_filled = "Color palette will be completed with colors for all grading values if any are missing."
2627
),
2728
value = list(
2829
parameter_selection = "User can select parameters for value plots"

‎man/fill_palette.Rd‎

Lines changed: 20 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/get_grading_vals.Rd‎

Lines changed: 20 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/apps/grading_palette_colors/app.R‎

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
dataset_list <- list("demo" = dv.papo:::prep_safety_data(5))
2+
3+
module_list <- list(
4+
"Papo" = dv.papo::mod_patient_profile(
5+
module_id = "grading_app", subjid_var = "USUBJID", sender_ids = NULL,
6+
subject_level_dataset_name = "adsl",
7+
summary = list(
8+
vars = c("SITEID", "AGE", "SEX", "RACE", "ETHNIC", "ARM", "DCREASCD", "TRT01A"),
9+
column_count = 3
10+
),
11+
plots = list(
12+
timeline_info = c(
13+
trt_start_date = "TRTSDT",
14+
trt_end_date = "TRTEDT",
15+
icf_date = "RFICDT", # optional
16+
part_end_date = "RFENDT" # optional
17+
),
18+
vline_vars = c(
19+
"Informed Consent Day" = "RFICDT", # because optional above
20+
# "Study Treatment Start Day" = "TRTSDT", #added by me
21+
"Study Treatment Stop Day" = "TRTEDT"
22+
),
23+
vline_day_numbers = c("Study Treatment Start Day : Day 1" = 1), # optional
24+
range_plots = list(
25+
"Adverse Events Plot" = list(
26+
dataset = "adae",
27+
vars = c(
28+
start_date = "ASTDT",
29+
end_date = "AENDT",
30+
decode = "AEDECOD",
31+
grading = "AESEV", # optional
32+
serious_ae = "AESER" # optional
33+
),
34+
tooltip = c(
35+
"AE Term: " = "AEDECOD",
36+
"AE Reported Term: " = "AETERM",
37+
"Primary SOC: " = "AESOC",
38+
"Intensity: " = "AESEV",
39+
"Serious Event: " = "AESER",
40+
"AE Start Date: " = "ASTDT",
41+
"AE Stop Date: " = "AENDT",
42+
"AE Start Day: " = "ASTDY",
43+
"AE Stop Day: " = "AENDY"
44+
)
45+
),
46+
"Concomitant Medication Plot" = list(
47+
dataset = "cm",
48+
vars = c(
49+
start_date = "CMSTDT",
50+
end_date = "CMENDT",
51+
decode = "CMDECOD",
52+
grading = "CMINDC"
53+
),
54+
tooltip = c(
55+
"Standardized Medication Name: " = "CMDECOD",
56+
"Indication: " = "CMINDC",
57+
"CM Dose: " = "CMDOSE",
58+
"CM Dose Unit: " = "CMDOSU",
59+
"CM START Date: " = "CMSTDTC",
60+
"CM End Date: " = "CMENDTC",
61+
"CM START Day: " = "CMSTDY",
62+
"CM END Day: " = "CMENDY"
63+
)
64+
)
65+
),
66+
value_plots = list(
67+
"Lab plot" = list(
68+
dataset = "lb",
69+
vars = c(
70+
analysis_param = "PARAM",
71+
analysis_val = "AVAL",
72+
analysis_date = "ADT",
73+
analysis_indicator = "ANRIND",
74+
range_low_limit = "A1LO",
75+
range_high_limit = "A1HI"
76+
),
77+
tooltip = c(
78+
"Lab Parameter: " = "PARAM",
79+
"Lab Test Date: " = "ADT",
80+
"Lab Test Visit :" = "AVISIT",
81+
"<br>High Limit: " = "A1HI",
82+
"Lab Standard Value: " = "AVAL",
83+
"Lower Limit: " = "A1LO",
84+
"<br>Analysis Indicator: " = "ANRIND"
85+
)
86+
),
87+
"Vital Sign Plot" = list(
88+
dataset = "vs",
89+
vars = c(
90+
analysis_param = "PARAM",
91+
analysis_val = "AVAL",
92+
analysis_date = "ADT",
93+
analysis_indicator = "VISIT",
94+
range_low_limit = NULL,
95+
range_high_limit = NULL,
96+
summary_stats = "AVAL_MEAN"
97+
),
98+
tooltip = c(
99+
"Vital sign Parameter: " = "PARAM",
100+
"Vital sign Date: " = "ADT",
101+
"Vital sign Visit: " = "AVISIT",
102+
"<br>Vital sign Value: " = "AVAL",
103+
"Vital sign mean value by visits: " = "AVAL_MEAN"
104+
)
105+
)
106+
)
107+
)
108+
)
109+
)
110+
111+
dv.manager::run_app(
112+
data = dataset_list,
113+
module_list = module_list,
114+
filter_data = "adsl"
115+
)

‎tests/testthat/test-all.R‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -350,3 +350,31 @@ test_that(
350350
app$stop()
351351
}
352352
)
353+
354+
test_that(
355+
"Color palette is filled when there are missing entries for grading values" |>
356+
vdoc[["add_spec"]](c(specs$plots$common$palette_is_filled)),
357+
{
358+
359+
app <- shinytest2::AppDriver$new(
360+
app_dir = "apps/grading_palette_colors/",
361+
name = "grading_colors_app"
362+
)
363+
364+
app_grading_vals <- setdiff(app$get_value(export = "gradings"), NA)
365+
app_filled_palette <- app$get_value(export = "filled_palette")
366+
367+
expect_true(all(app_grading_vals %in% names(app_filled_palette))) # check all grading vals present in palette.
368+
369+
grading_palette <- app_filled_palette[app_grading_vals]
370+
expect_length(grading_palette |> unique(), length(app_grading_vals))
371+
372+
#check colors were filled.
373+
# i. check which grading vals had no color assigned in CONST default palette
374+
unmapped_grading_vals <- setdiff(app_grading_vals, names(dv.papo:::CONST$default_palette))
375+
376+
# ii. check a color was then assigned.
377+
expect_length(grading_palette[unmapped_grading_vals], length(unmapped_grading_vals))
378+
379+
}
380+
)

‎tests/testthat/test-utils-palette.R‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
testthat::test_that("colour palette is completed if it misses colours for grading values", {
2+
# Let 'n' denote number of grading values
3+
n <- 20
4+
sample_data <- data.frame(GRADING = LETTERS[1:n])
5+
grading_col_pal <- structure(sample(colours(), n - 10), names = LETTERS[1:(n - 10)])
6+
grading_col_pal_filled <- fill_palette(sample_data[["GRADING"]], grading_col_pal)
7+
testthat::expect_length(grading_col_pal_filled, n + length(CONST$default_palette))
8+
})
9+
10+
testthat::test_that("colour palette is filled even if pre-defined colors used up", {
11+
sample_data <- data.frame(GRADING = c(LETTERS[1:20], "AA", "BB", "CC"))
12+
grading_col_pal <- structure(
13+
c(
14+
"orange", "green", "cyan", "blue",
15+
"magenta", "purple", "black", "pink", "khaki",
16+
"turquoise", "navyblue", "violet", "yellowgreen", "skyblue",
17+
"indianred", "cornsilk", "chocolate", "darkgoldenrod",
18+
"coral", "dodgerblue"
19+
),
20+
names = LETTERS[1:20]
21+
)
22+
grading_col_pal_filled <- fill_palette(sample_data[["GRADING"]], grading_col_pal)
23+
testthat::expect_length(
24+
grading_col_pal_filled,
25+
nrow(sample_data) + length(CONST$default_palette)
26+
)
27+
})

0 commit comments

Comments
 (0)