Ccommitting latest and final updates

Author: typoumet

R/check_call_auto.R

@@ -4,9 +4,9 @@
 
 # dv.explorer.parameter::mod_boxplot
 check_mod_boxplot_auto <- function(afmm, datasets, module_id, bm_dataset_name, group_dataset_name, receiver_id,
-    cat_var, par_var, value_vars, visit_var, anlfl_vars, subjid_var, quantile_type, default_cat, default_par,
-    default_visit, default_value, default_main_group, default_sub_group, default_page_group, server_wrapper_func,
-    err) {
+    cat_var, par_var, value_vars, visit_var, x_axis_vars, anlfl_vars, subjid_var, quantile_type, default_cat,
+    default_par, default_visit, default_x_axis_vals, default_x_axis_var, default_value, default_main_group,
+    default_sub_group, default_page_group, server_wrapper_func, err) {
     OK <- logical(0)
     used_dataset_names <- new.env(parent = emptyenv())
     OK[["module_id"]] <- CM$check_module_id("module_id", module_id, err)
@@ -33,9 +33,14 @@ check_mod_boxplot_auto <- function(afmm, datasets, module_id, bm_dataset_name, g
         subkind, flags, bm_dataset_name, datasets[[bm_dataset_name]], err)
     subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor"), list(kind = "numeric",
         min = NA, max = NA)))
-    flags <- list(map_character_to_factor = TRUE)
+    flags <- list(optional = TRUE, map_character_to_factor = TRUE)
     OK[["visit_var"]] <- OK[["bm_dataset_name"]] && CM$check_dataset_colum_name("visit_var", visit_var,
         subkind, flags, bm_dataset_name, datasets[[bm_dataset_name]], err)
+    subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor"), list(kind = "numeric",
+        min = NA, max = NA)))
+    flags <- list(one_or_more = TRUE, map_character_to_factor = TRUE)
+    OK[["x_axis_vars"]] <- OK[["bm_dataset_name"]] && CM$check_dataset_colum_name("x_axis_vars", x_axis_vars,
+        subkind, flags, bm_dataset_name, datasets[[bm_dataset_name]], err)
     subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor")))
     flags <- list(zero_or_more = TRUE, optional = TRUE)
     OK[["anlfl_vars"]] <- OK[["bm_dataset_name"]] && CM$check_dataset_colum_name("anlfl_vars", anlfl_vars,
@@ -57,6 +62,12 @@ check_mod_boxplot_auto <- function(afmm, datasets, module_id, bm_dataset_name, g
     OK[["default_visit"]] <- OK[["visit_var"]] && CM$check_choice_from_col_contents("default_visit",
         default_visit, flags, "bm_dataset_name", datasets[[bm_dataset_name]], visit_var, err)
     flags <- list(optional = TRUE)
+    OK[["default_x_axis_vals"]] <- OK[["x_axis_vars"]] && CM$check_choice_from_col_contents("default_x_axis_vals",
+        default_x_axis_vals, flags, "bm_dataset_name", datasets[[bm_dataset_name]], x_axis_vars, err)
+    flags <- list(optional = TRUE)
+    OK[["default_x_axis_var"]] <- OK[["x_axis_vars"]] && CM$check_choice("default_x_axis_var", default_x_axis_var,
+        flags, "x_axis_vars", x_axis_vars, err)
+    flags <- list(optional = TRUE)
     OK[["default_value"]] <- OK[["value_vars"]] && CM$check_choice("default_value", default_value, flags,
         "value_vars", value_vars, err)
     subkind <- list(kind = "or", options = list(list(kind = "character"), list(kind = "factor")))

R/mock_boxplot.R

@@ -5,7 +5,6 @@
 #' @param ui_defaults,srv_defaults a list of values passed to the ui/server function
 #' @param anlfl_flags indicates that the input data contain analysis flag variables or not
 #' @export
-
 mock_app_boxplot <- function(dry_run = FALSE, update_query_string = TRUE, srv_defaults = list(), ui_defaults = list(), anlfl_flags = FALSE) {
   data <- test_data(anlfl_flags = anlfl_flags)
   bm_dataset <- shiny::reactive({
@@ -63,7 +62,6 @@ mock_app_boxplot <- function(dry_run = FALSE, update_query_string = TRUE, srv_de
 #' @keywords mock
 #' @inheritParams mock_app_boxplot
 #' @export
-
 mock_app_boxplot_mm <- function(update_query_string = TRUE, anlfl_flags = FALSE) {
   if (!requireNamespace("dv.manager")) {
     stop("Install dv.manager")
@@ -105,9 +103,6 @@ mock_app_boxplot_mm <- function(update_query_string = TRUE, anlfl_flags = FALSE)
 #' @keywords mock
 #' @inheritParams mock_app_boxplot
 #' @export
-
-
-
 mock_app_boxplot_mm_depr <- function(update_query_string = TRUE, anlfl_flags = FALSE) {
   if (!requireNamespace("dv.manager")) {
     stop("Install dv.manager")
@@ -135,7 +130,7 @@ mock_app_boxplot_mm_depr <- function(update_query_string = TRUE, anlfl_flags = F
         cat_var = "PARCAT",
         anlfl_vars = anlfl_vars,
         default_visit = "VISIT1",
-        default_main_group = "GENDER"
+        default_main_group = "CAT1"
       )
     ),
     filter_data = "adsl",
@@ -150,10 +145,6 @@ mock_app_boxplot_mm_depr <- function(update_query_string = TRUE, anlfl_flags = F
 #' @keywords mock
 #' @inheritParams mock_app_boxplot
 #' @export
-
-
-
-
 set.seed(42)
 
 subjects <- sprintf("SUBJ%03d", 1:24)
@@ -164,12 +155,19 @@ sequences <- c(
   rep("T3-R-T1-T2", 6)
 )
 
-# assign COUNTRY and GENDER per subject
+# assign COUNTRY, GENDER and BMI_STATUS per subject
 countries <- c("USA", "Germany", "UK")
 genders <- c("Male", "Female")
+bmi_statuses <- c(
+  "Underweight",
+  "Normal Weight",
+  "Overweight",
+  "Obese"
+)
 
 subject_country <- sample(countries, length(subjects), replace = TRUE)
 subject_gender  <- sample(genders, length(subjects), replace = TRUE)
+subject_bmi     <- sample(bmi_statuses, length(subjects), replace = TRUE)
 
 trt_map <- list(
   "R-T1-T2-T3" = c("R", "T1", "T2", "T3"),
@@ -189,6 +187,7 @@ for (i in seq_along(subjects)) {
   # subject-level attributes
   country <- subject_country[i]
   gender  <- subject_gender[i]
+  bmi     <- subject_bmi[i]
 
   for (visit in 1:4) {
     trt <- trts[visit]
@@ -198,7 +197,8 @@ for (i in seq_along(subjects)) {
     rows[[k]] <- data.frame(
       USUBJID = subj,
       COUNTRY = country,
-      GENDER  = gender,
+      GENDER = gender,
+      BMI_STATUS = bmi,
       PARCAT = "EFFICACY",
       PARAM = "CHANGE_FROM_BASELINE",
       AVISIT = paste("Visit", visit),
@@ -212,12 +212,12 @@ for (i in seq_along(subjects)) {
     k <- k + 1
   }
 }
+
 # create data frame with multiple records per subject
 df <- do.call(rbind, rows)
 
 # create subject level data frame
-adsl <- unique(df[c("USUBJID", "COUNTRY", "GENDER")])
-
+adsl <- unique(df[c("USUBJID", "COUNTRY", "GENDER", "BMI_STATUS")])
 
 mock_app_boxplot_mm_crossover <- function(update_query_string = TRUE, anlfl_flags = FALSE) {
   if (!requireNamespace("dv.manager")) {
@@ -241,9 +241,10 @@ mock_app_boxplot_mm_crossover <- function(update_query_string = TRUE, anlfl_flag
         subjid_var = "USUBJID",
         cat_var = "PARCAT",
         anlfl_vars = anlfl_vars,
-        x_axis_vars = c("AVISIT", "TRT"),
+        x_axis_vars = c("AVISIT", "AVISITN", "TRT"),
         default_cat = "EFFICACY",
-        default_par = "CHANGE_FROM_BASELINE"
+        default_par = "CHANGE_FROM_BASELINE",
+        default_x_axis_var = "TRT"
       )
     ),
     filter_data = "adsl",