Merge pull request #42 from Boehringer-Ingelheim/feat/multi_ref_range

Multiple reference values

.gitignore

@@ -4,4 +4,3 @@
 .Rhistory
 *.Rproj
 docs/
-man/*.Rd

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dv.explorer.parameter
 Type: Package
 Title: Parameter exploration modules
-Version: 0.1.2-9000
+Version: 0.1.3-9000
 Authors@R: c(
         person("Boehringer-Ingelheim Pharma GmbH & Co.KG", role = c("cph", "fnd")),
         person(given = "Luis", family = "Moris Fernandez", role = c("aut", "cre"), email = "luis.moris.fernandez@gmail.com"),
@@ -29,4 +29,4 @@ Date: Tue May 31 12:12:27 2022
 Branch: dev
 ParentCommit: 9edd5ae0b32a3c7afbcf7215187748f310087a8a
 VignetteBuilder: knitr
-Remotes: boehringer-ingelheim/dv.manager@v2.1.4
+Remotes: boehringer-ingelheim/dv.manager@v2.1.5

NAMESPACE

@@ -19,6 +19,7 @@ export(mock_app_hmcat)
 export(mock_app_hmcont)
 export(mock_app_hmpar)
 export(mock_app_lineplot)
+export(mock_app_lineplot_mm_safetyData)
 export(mock_app_scatterplot)
 export(mock_app_scatterplotmatrix)
 export(mock_app_wf)

NEWS.md

@@ -1,3 +1,10 @@
+# dv.explorer.parameter 0.1.3-9000
+
+* All modules:
+    * Reduce `value_vars` default values to "AVAL".
+* lineplot:
+    * Improved display of simultaneous reference values.
+
 # dv.explorer.parameter 0.1.2-9000
 
 * All modules:

R/CM.R

@@ -1,4 +1,4 @@
-# YT#VHa2daae307c5e4f729658fd67108835d5#VH2dafca7d199f5ea8393d6b6ab99fb2c0#
+# YT#VHcdeeee4cd0eadba37e2b7e0c950d1cd1#VH9a9fddb547d03737e47db25dba988fc7#
 CM <- local({ # _C_hecked _M_odule
   message_well <- function(title, contents, color = "f5f5f5") { # repeats #iewahg
     style <- sprintf(r"---(
@@ -437,36 +437,63 @@ CM <- local({ # _C_hecked _M_odule
       return(TRUE)
     }
 
-    ok <- FALSE
-
+    ok <- assert(err, is.character(value), 
+                 paste(sprintf("The value assigned to parameter `%s` should be of type `character`", name),
+                       sprintf("and it's instead of type `%s`.", class(value)[[1]])))
+
     valid_column_names <- list_columns_of_kind(dataset_value, subkind)
+    invalid_column_names <- value[!value %in% valid_column_names]
+    wrong_subkind_column_names <- invalid_column_names[invalid_column_names %in% names(dataset_value)]
+
+    ok <- ok && assert(
+      err, length(wrong_subkind_column_names) == 0, {
+        cnames <- paste(sprintf('"%s"', wrong_subkind_column_names), collapse = ", ")
+        type_desc <- TC$get_type_as_text(subkind)
+        types_found <- unname(sapply(dataset_value[wrong_subkind_column_names], function(x) class(x)[[1]]))
+        types_found_desc <- paste(sprintf("`%s`", types_found), collapse = ", ")
+        paste(
+          sprintf("Variables assigned to parameter <b>`%s`</b> should refer to columns of dataset <b>`%s`</b>",
+                  name, dataset_name),
+          sprintf("of type `%s`, but some (<b>%s</b>) have other types (%s).", 
+                  type_desc, cnames, types_found_desc)
+        )
+      }
+    )
+
+    ok <- ok && assert(
+      err, length(invalid_column_names) == 0, {
+        cnames <- paste(sprintf('"%s"', invalid_column_names), collapse = ", ")
+        paste(
+          sprintf("The value of parameter <b>`%s`</b> includes one or more variables (<b>%s</b>)", name, cnames),
+          sprintf("that are not columns of the <b>`%s`</b> dataset.", dataset_name)
+        )
+      }
+    )
 
     zero_or_more <- isTRUE(flags[["zero_or_more"]])
     one_or_more <- isTRUE(flags[["one_or_more"]])
     zero_or_one_or_more <- zero_or_more || one_or_more
     if (zero_or_one_or_more) {
       min_len <- 0
       if (one_or_more) min_len <- 1
-      ok <- assert(
+
+      ok <- ok && assert(
         err,
-        is.character(value) &&
-          all(value %in% valid_column_names) &&
-          length(value) >= min_len,
-        paste(
-          sprintf(
-            "`%s` should be a character vector of length greater than %s referring to one of the following columns of dataset `%s`: ",
-            name, c("zero", "one")[[min_len + 1]], dataset_name
-          ),
-          paste(sprintf('"%s"', valid_column_names), collapse = ", "), "."
-        )
+        length(value) >= min_len, {
+          col_names <- paste(sprintf('"%s"', valid_column_names), collapse = ", ")
+          paste0(
+            sprintf("`%s` should be a character vector of length greater than %s ", name, c("zero", "one")[[min_len + 1]]),
+            sprintf("referring to the following columns of dataset `%s`: ", dataset_name),
+            col_names, "."
+          )
+        }
       )
     } else {
-      ok <- assert(
+      ok <- ok && assert(
         err,
-        test_string(value) &&
-          all(value %in% valid_column_names),
+        length(value) == 1,
         paste(
-          sprintf("`%s` should be a string referring to one of the following columns of dataset `%s`: ", name, dataset_name),
+          sprintf("`%s` should be a string referring to a single column of dataset `%s`: ", name, dataset_name),
           paste(sprintf('"%s"', valid_column_names), collapse = ", "), "."
         )
       )

R/TC.R

@@ -1,4 +1,4 @@
-# YT#VH5cf018ae9cef0cbf83422a7d2b6b6b04#VH00000000000000000000000000000000#
+# YT#VH6fdb3d19d5c72c6488f3bcfe86c03095#VH5cf018ae9cef0cbf83422a7d2b6b6b04#
 TC <- local({ # _T_ype C_hecks
   # basic types
   T_logical <- function() list(kind = "logical")
@@ -362,6 +362,7 @@ TC <- local({ # _T_ype C_hecks
     honor_as_array_flag_inner = T_honor_as_array_flag_inner,
     honor_as_array_flag = T_honor_as_array_flag,
     honor_map_to_flag_inner = T_honor_map_to_flag_inner,
-    honor_map_to_flag = T_honor_map_to_flag
+    honor_map_to_flag = T_honor_map_to_flag,
+    get_type_as_text = T_get_type_as_text
   )
 })

R/check_call_auto.R

@@ -252,7 +252,7 @@ check_mod_lineplot_auto <- function(afmm, datasets, module_id, bm_dataset_name,
     OK[["additional_listing_vars"]] <- OK[["bm_dataset_name"]] && CM$check_dataset_colum_name("additional_listing_vars",
         additional_listing_vars, subkind, flags, bm_dataset_name, datasets[[bm_dataset_name]], warn,
         err)
-    subkind <- list(kind = "anything")
+    subkind <- list(kind = "numeric", min = NA, max = NA)
     flags <- list(zero_or_more = TRUE, optional = TRUE)
     OK[["ref_line_vars"]] <- OK[["bm_dataset_name"]] && CM$check_dataset_colum_name("ref_line_vars",
         ref_line_vars, subkind, flags, bm_dataset_name, datasets[[bm_dataset_name]], warn, err)

R/mock_lineplot.R

@@ -154,6 +154,9 @@ mock_app_lineplot_mm <- function() {
   )
 }
 
+#' Mock module manager lineplot app displaying safetyData dataset
+#' @keywords mock
+#' @export
 mock_app_lineplot_mm_safetyData <- function() {
   if (!requireNamespace("dv.manager")) {
     stop("Install dv.manager")

R/mod_boxplot.R

@@ -82,13 +82,15 @@ BP <- poc( # nolint
 #' It also includes a set of listings with information about the population, distribution and statistical comparisons.
 #'
 #' @name mod_boxplot
+#' @inheritParams boxplot_server
 #'
 #' @keywords main
 #'
 NULL
 
-#' @describeIn mod_boxplot UI
+#' Boxplot UI function
 #' @param id Shiny ID `[character(1)]`
+#' @keywords developers
 #' @export
 boxplot_UI <- function(id) { # nolint
   # id assert ---- It goes on its own as id is used to provide context to the other assertions
@@ -188,7 +190,8 @@ boxplot_UI <- function(id) { # nolint
   }
 }
 
-#' @describeIn mod_boxplot Server
+#' Boxplot server function
+#' @keywords developers
 #'
 #' @description
 #'
@@ -249,7 +252,7 @@ boxplot_server <- function(id,
                            dataset_name = shiny::reactive(character(0)),
                            cat_var = "PARCAT",
                            par_var = "PARAM",
-                           value_vars = c("AVAL", "CHG", "PCHG"),
+                           value_vars = "AVAL",
                            visit_var = "AVISIT",
                            subjid_var = "SUBJID",
                            default_cat = NULL,
@@ -727,6 +730,8 @@ boxplot_server <- function(id,
 #' Shiny ID of the module receiving the selected subject ID in the data listing. This ID must
 #' be present in the app or be NULL.
 #'
+#' inheritParams boxplot_server
+#'
 #' @name mod_boxplot
 #'
 #' @keywords main
@@ -739,7 +744,7 @@ mod_boxplot <- function(module_id,
                         receiver_id = NULL,
                         cat_var = "PARCAT",
                         par_var = "PARAM",
-                        value_vars = c("AVAL", "CHG", "PCHG"),
+                        value_vars = "AVAL",
                         visit_var = "AVISIT",
                         subjid_var = "SUBJID",
                         default_cat = NULL,
@@ -861,7 +866,8 @@ dataset_info_boxplot <- function(bm_dataset_name, group_dataset_name, ...) {
 
 mod_boxplot <- CM$module(mod_boxplot, check_mod_boxplot, dataset_info_boxplot)
 
-#' @describeIn mod_boxplot Boxplot wrapper when its output is fed into papo module
+#' Boxplot wrapper when its output is fed into the papo module
+#' @keywords main
 #' @export
 mod_boxplot_papo <- function(...) {
   .Deprecated("mod_boxplot_papo", msg = "'mod_boxplot_papo' is no longer required and should be replaced by 'mod_boxplot'. It is still available for compatibility purposes") # nolint

R/mod_corr_hm.R

@@ -71,23 +71,21 @@ CH_MSG <- poc( # nolint
 
 #' Correlation Heatmap module
 #'
-#' @param id Shiny ID `[character(1)]`
-#'
 #' @param default_cat Default selected categories
 #'
 #' @param default_par Default selected parameters
 #'
 #' @param default_visit Default selected visits
 #'
-#' @param default_corr_method Name of default correlation method
-#'
 #' @name mod_corr_hm
 #'
 #' @keywords main
 #'
 NULL
 
-#' @describeIn mod_corr_hm UI
+#' Correlation heatmap UI function
+#'
+#' @keywords developers
 #'
 #' @param id `[character(1)]`
 #'
@@ -462,7 +460,9 @@ scatter_plot <- function(df, x_var, y_var) {
 }
 
 
-#' @describeIn mod_corr_hm Server
+#' Correlation heatmap server function
+#'
+#' @keywords developers
 #'
 #' @param id `[character(1)]`
 #'
@@ -503,7 +503,7 @@ corr_hm_server <- function(id,
                            cat_var = "PARCAT",
                            par_var = "PARAM",
                            visit_var = "AVISIT",
-                           value_vars = c("AVAL", "PCHG"),
+                           value_vars = "AVAL",
                            default_value = NULL) {
   # module constants ----
   VAR <- poc( # nolint Parameters from the function that will be considered constant across the function
@@ -862,6 +862,8 @@ ch_subset_data <- function(sel, cat_col, par_col, val_col, vis_col, bm_ds, subj_
 #'
 #' @name mod_corr_hm
 #'
+#' @inheritParams corr_hm_server
+#'
 #' @keywords main
 #'
 #' @export

R/mod_forest.R

@@ -99,15 +99,16 @@ FP_MSG <- poc(
 
 #' Forest plot module
 #'
-#' @param id Shiny ID `[character(1)]`
-#'
 #' @name mod_forest
+#' @inheritParams forest_server
 #'
 #' @keywords main
 #'
 NULL
 
-#' @describeIn mod_forest UI
+#' Forest plot UI function
+#'
+#' @keywords developers
 #'
 #' @param id `[character(1)]`
 #'
@@ -461,7 +462,9 @@ gen_result_table_fun_ <- function(ds, sl, fun, label) {
 gen_result_table_fun <- strict(gen_result_table_fun_)
 
 
-#' @describeIn mod_forest Server
+#' Forest plot server function
+#'
+#' @keywords developers
 #'
 #' @param id `[character(1)]`
 #'
@@ -537,7 +540,7 @@ forest_server <- function(id,
                           cat_var = "PARCAT",
                           par_var = "PARAM",
                           visit_var = "AVISIT",
-                          value_vars = c("AVAL", "PCHG"),
+                          value_vars = "AVAL",
                           default_cat = NULL,
                           default_par = NULL,
                           default_visit = NULL,
@@ -1209,7 +1212,7 @@ mod_forest <- function(module_id,
                        cat_var = "PARCAT",
                        par_var = "PARAM",
                        visit_var = "AVISIT",
-                       value_vars = c("AVAL", "PCHG"),
+                       value_vars = "AVAL",
                        default_cat = NULL,
                        default_par = NULL,
                        default_visit = NULL,