Merge pull request #35 from Boehringer-Ingelheim/test

Release version 2.0.2

Author: iglauss

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dv.edish
 Title: eDISH Plot Module for DILI assessment
-Version: 2.0.1
+Version: 2.0.2
 Authors@R: c(
     person("Boehringer-Ingelheim Pharma GmbH & Co.KG", role = c("cph", "fnd")),
     person("Isabel", "Glauss", , "isabel.glauss@boehringer-ingelheim.com", role = c("aut", "cre")),
@@ -11,7 +11,7 @@ Description: This DaVinci package contains a module which is meant to
     (modified) evaluation of Drug-Induced Serious Hepatotoxicity plot.
 License: Apache License (>= 2)
 Depends: 
-    R (>= 4.0)
+    R (>= 4.1)
 Imports:
     checkmate (>= 2.1.0),
     dplyr (>= 1.0.5),

NEWS.md

@@ -1,3 +1,7 @@
+# dv.edish 2.0.2
+
+- [NOT USER-FACING] Update early error feedback snippets, communication with papo test snippet and test snapshot.
+
 # dv.edish 2.0.1
 
 - Reinstate UI selection of liver function parameter on y-axis.

R/CM.R

@@ -1,4 +1,4 @@
-# YT#VH6cbb4db897d00c26bed7291a0f2f8658#VH00000000000000000000000000000000#
+# YT#VHb8d7094dccccb00c0c217628906ca717#VH6cbb4db897d00c26bed7291a0f2f8658#
 DR <- local({ # _D_ressing _R_oom
   inline_shiny_input <- function(elem, label = NULL, name_selector = NULL, label_elem = NULL) {
     if (is.character(label) && length(label) == 1 && nchar(label) > 0) {
@@ -90,9 +90,9 @@ DR <- local({ # _D_ressing _R_oom
   explorer_ui <- function() {
     panel <- function(...) {
       shiny::div(
-        class = "panel panel-default",
+        class = "card",
         style = "background-color:#eff7ff;",
-        shiny::div(class = "panel-body", style = "padding-bottom:0.5rem;", ...)
+        shiny::div(class = "card-body", style = "padding-bottom:0.5rem;", ...)
       )
     }
 

R/DR.R

@@ -6,69 +6,66 @@
 check_mod_edish_auto <- function(afmm, datasets, module_id, subject_level_dataset_name, lab_dataset_name,
     lb_date_var, subjectid_var, arm_var, arm_default_vals, visit_var, baseline_visit_val, lb_test_var,
     at_choices, at_default_val, tbili_choices, tbili_default_val, alp_choice, lb_result_var, ref_range_upper_lim_var,
-    default_by_visit, window_days, receiver_id, warn, err) {
+    default_by_visit, window_days, receiver_id, err) {
     OK <- logical(0)
     used_dataset_names <- new.env(parent = emptyenv())
-    OK[["module_id"]] <- CM$check_module_id("module_id", module_id, warn, err)
+    OK[["module_id"]] <- CM$check_module_id("module_id", module_id, err)
     flags <- list(subject_level_dataset_name = TRUE)
     OK[["subject_level_dataset_name"]] <- CM$check_dataset_name("subject_level_dataset_name", subject_level_dataset_name,
-        flags, datasets, used_dataset_names, warn, err)
+        flags, datasets, used_dataset_names, err)
     flags <- structure(list(), names = character(0))
     OK[["lab_dataset_name"]] <- CM$check_dataset_name("lab_dataset_name", lab_dataset_name, flags, datasets,
-        used_dataset_names, warn, err)
+        used_dataset_names, err)
     subkind <- list(kind = "or", options = list(list(kind = "date"), list(kind = "datetime")))
     flags <- structure(list(), names = character(0))
     OK[["lb_date_var"]] <- OK[["lab_dataset_name"]] && CM$check_dataset_colum_name("lb_date_var", lb_date_var,
-        subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], warn, err)
+        subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], err)
     subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor")))
     flags <- list(subjid_var = TRUE)
     OK[["subjectid_var"]] <- OK[["subject_level_dataset_name"]] && CM$check_dataset_colum_name("subjectid_var",
         subjectid_var, subkind, flags, subject_level_dataset_name, datasets[[subject_level_dataset_name]],
-        warn, err)
+        err)
     subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor")))
     flags <- structure(list(), names = character(0))
     OK[["arm_var"]] <- OK[["subject_level_dataset_name"]] && CM$check_dataset_colum_name("arm_var", arm_var,
-        subkind, flags, subject_level_dataset_name, datasets[[subject_level_dataset_name]], warn, err)
+        subkind, flags, subject_level_dataset_name, datasets[[subject_level_dataset_name]], err)
     "NOTE: arm_default_vals (choice_from_col_contents) tagged as \"manual_check\""
     "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
     subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor")))
     flags <- structure(list(), names = character(0))
     OK[["visit_var"]] <- OK[["lab_dataset_name"]] && CM$check_dataset_colum_name("visit_var", visit_var,
-        subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], warn, err)
+        subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], err)
     flags <- structure(list(), names = character(0))
     OK[["baseline_visit_val"]] <- OK[["visit_var"]] && CM$check_choice_from_col_contents("baseline_visit_val",
-        baseline_visit_val, flags, "lab_dataset_name", datasets[[lab_dataset_name]], visit_var, warn,
-        err)
+        baseline_visit_val, flags, "lab_dataset_name", datasets[[lab_dataset_name]], visit_var, err)
     subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor")))
     flags <- structure(list(), names = character(0))
     OK[["lb_test_var"]] <- OK[["lab_dataset_name"]] && CM$check_dataset_colum_name("lb_test_var", lb_test_var,
-        subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], warn, err)
+        subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], err)
     flags <- list(one_or_more = TRUE)
     OK[["at_choices"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("at_choices", at_choices,
-        flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn, err)
+        flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, err)
     flags <- list(optional = TRUE)
     OK[["at_default_val"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("at_default_val",
-        at_default_val, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn, err)
+        at_default_val, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, err)
     flags <- list(one_or_more = TRUE)
     OK[["tbili_choices"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("tbili_choices",
-        tbili_choices, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn, err)
+        tbili_choices, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, err)
     flags <- list(optional = TRUE)
     OK[["tbili_default_val"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("tbili_default_val",
-        tbili_default_val, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn,
-        err)
+        tbili_default_val, flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, err)
     flags <- list(optional = TRUE)
     OK[["alp_choice"]] <- OK[["lb_test_var"]] && CM$check_choice_from_col_contents("alp_choice", alp_choice,
-        flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, warn, err)
+        flags, "lab_dataset_name", datasets[[lab_dataset_name]], lb_test_var, err)
     subkind <- list(kind = "numeric", min = NA, max = NA)
     flags <- structure(list(), names = character(0))
     OK[["lb_result_var"]] <- OK[["lab_dataset_name"]] && CM$check_dataset_colum_name("lb_result_var",
-        lb_result_var, subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], warn, err)
+        lb_result_var, subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], err)
     subkind <- list(kind = "numeric", min = NA, max = NA)
     flags <- list(optional = TRUE)
     OK[["ref_range_upper_lim_var"]] <- OK[["lab_dataset_name"]] && CM$check_dataset_colum_name("ref_range_upper_lim_var",
-        ref_range_upper_lim_var, subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], warn,
-        err)
+        ref_range_upper_lim_var, subkind, flags, lab_dataset_name, datasets[[lab_dataset_name]], err)
     "NOTE: default_by_visit (logical) tagged as \"manual_check\""
     "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
@@ -80,7 +77,7 @@ check_mod_edish_auto <- function(afmm, datasets, module_id, subject_level_datase
     "      the caller of this function has written manual checks near the call site."
     for (ds_name in names(used_dataset_names)) {
         OK[["subjectid_var"]] <- OK[["subjectid_var"]] && CM$check_subjid_col(datasets, ds_name, get(ds_name),
-            "subjectid_var", subjectid_var, warn, err)
+            "subjectid_var", subjectid_var, err)
     }
     return(OK)
 }

R/check_call_auto.R

@@ -644,7 +644,6 @@ check_mod_edish <- function(
     at_choices, at_default_val, tbili_choices, tbili_default_val, alp_choice, lb_result_var,
     ref_range_upper_lim_var, default_by_visit, window_days, receiver_id
 ) {
-  warn <- CM$container()
   err <- CM$container()
 
   OK <- check_mod_edish_auto(
@@ -653,7 +652,7 @@ check_mod_edish <- function(
     subjectid_var, arm_var, arm_default_vals, visit_var, baseline_visit_val, lb_test_var,
     at_choices, at_default_val, tbili_choices, tbili_default_val, alp_choice, lb_result_var,
     ref_range_upper_lim_var, window_days, default_by_visit, receiver_id,
-    warn, err
+    err
   )
 
   # Check only if `arm_default_vals` is a character vector
@@ -729,7 +728,7 @@ check_mod_edish <- function(
     )
   }
 
-  res <- list(warnings = warn[["messages"]], errors = err[["messages"]])
+  res <- list(errors = err[["messages"]])
   return(res)
 }