Merge pull request #237 from NEST/prf/234_change_minimal_records_requ…

…ired changed minimum records required in all modules
insightsengineering · Mar 16, 2021 · 6030246 · 6030246
2 parents e68e16c + 80129d9
commit 6030246
Show file tree

Hide file tree

Showing 8 changed files with 21 additions and 17 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -8,6 +8,9 @@
   - Fixed displaying the number of messages, warnings and errors on the Debug Info button.
   - Fixed treatment variable having values with with symbols (e.g. ':').
   - Allow treatment variables with different arm levels.
+
+### Miscellaneous
+* Reduced minimum number of records required in dataset to either 1 or 2 in all modules.
 
 # teal.goshawk 0.1.6
 

diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R
@@ -289,7 +289,7 @@ srv_g_boxplot <- function(input,
   # reused in all modules
   anl_chunks <- constr_anl_chunks(
     session, input, datasets, dataname,
-    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group
+    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 2
   )
   # update sliders for axes taking constraints into account
   yrange_slider <- callModule(toggle_slider_server, "yrange_scale")
@@ -445,7 +445,7 @@ srv_g_boxplot <- function(input,
     boxplot_brush <- boxplot_data$brush()
 
     ANL <- isolate(anl_chunks()$ANL) %>% droplevels() #nolint
-    validate_has_data(ANL, 5)
+    validate_has_data(ANL, 2)
 
     xvar <- isolate(input$xaxis_var)
     yvar <- isolate(input$yaxis_var)

diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R
@@ -280,7 +280,7 @@ srv_g_correlationplot <- function(input,
 
     dataset_var <- paste0(dataname, "_FILTERED")
     ANL_FILTERED <- datasets$get_data(dataname, filtered = TRUE) # nolint
-    validate_has_data(ANL_FILTERED, 5)
+    validate_has_data(ANL_FILTERED, 1)
 
 
     validate_has_variable(ANL_FILTERED, param_var)
@@ -373,7 +373,7 @@ srv_g_correlationplot <- function(input,
     )
 
     ANL <- chunks_safe_eval(private_chunks) # nolint
-    validate_has_data(ANL, 5)
+    validate_has_data(ANL, 1)
 
     return(list(ANL = ANL, chunks = private_chunks))
   })
@@ -450,7 +450,7 @@ srv_g_correlationplot <- function(input,
     }
   })
 
-  anl_constraint <- create_anl_constraint_reactive(anl_param, input, param_id = "xaxis_param")
+  anl_constraint <- create_anl_constraint_reactive(anl_param, input, param_id = "xaxis_param", min_rows = 1)
 
   # update sliders for axes taking constraints into account
   xrange_slider <- callModule(toggle_slider_server, "xrange_scale")

diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R
@@ -268,7 +268,7 @@ srv_g_density_distribution_plot <- function(input, # nolint
   init_chunks()
   anl_chunks <- constr_anl_chunks(
     session, input, datasets, dataname,
-    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group
+    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 2
   )
 
   # update sliders for axes taking constraints into account

diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R
@@ -312,7 +312,8 @@ srv_lineplot <- function(input,
     dataname = dataname,
     param_id = "xaxis_param",
     param_var =  param_var,
-    trt_group = input$trt_group)
+    trt_group = input$trt_group,
+    min_rows = 2)
   keep_data_const_opts_updated(session, input, anl_chunks, "xaxis_param")
 
   yrange_slider <- callModule(toggle_slider_server, "yrange_scale")

diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R
@@ -265,7 +265,7 @@ srv_g_scatterplot <- function(input,
   # reused in all modules
   anl_chunks <- constr_anl_chunks(
     session, input, datasets, dataname,
-    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group
+    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 1
   )
 
   # update sliders for axes taking constraints into account
@@ -366,7 +366,7 @@ srv_g_scatterplot <- function(input,
     plot_brush <- plot_data$brush()
 
     ANL <- isolate(anl_chunks()$ANL) # nolint
-    validate_has_data(ANL, 5)
+    validate_has_data(ANL, 1)
 
     xvar <- isolate(input$xaxis_var)
     yvar <- isolate(input$yaxis_var)

diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R
@@ -291,7 +291,7 @@ srv_g_spaghettiplot <- function(input,
   # reused in all modules
   anl_chunks <- constr_anl_chunks(
     session, input, datasets, dataname,
-    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group
+    param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 1
   )
 
   # update sliders for axes taking constraints into account
@@ -372,7 +372,7 @@ srv_g_spaghettiplot <- function(input,
     plot_brush <- plot_data$brush()
 
     ANL <- isolate(anl_chunks()$ANL) # nolint
-    validate_has_data(ANL, 5)
+    validate_has_data(ANL, 1)
 
     xvar <- isolate(input$xaxis_var)
     yvar <- isolate(input$yaxis_var)

diff --git a/R/utils.R b/R/utils.R
@@ -142,7 +142,7 @@ keep_range_slider_updated <- function(session, input, update_slider_fcn, id_var,
 # param_var: currently only "PARAMCD" is supported
 #' @importFrom dplyr filter sym
 #' @importFrom shinyjs hide show
-constr_anl_chunks <- function(session, input, datasets, dataname, param_id, param_var, trt_group) {
+constr_anl_chunks <- function(session, input, datasets, dataname, param_id, param_var, trt_group, min_rows) {
   dataset_var <- paste0(dataname, "_FILTERED")
   if (!identical(param_var, "PARAMCD")) {
     # why is there a variable param_id which is provided to this function and always equal to "param"?
@@ -155,7 +155,7 @@ constr_anl_chunks <- function(session, input, datasets, dataname, param_id, para
     stopifnot(is_character_single(param_var_value))
 
     ANL_FILTERED <- datasets$get_data(dataname, filtered = TRUE) # nolint
-    validate_has_data(ANL_FILTERED, 5)
+    validate_has_data(ANL_FILTERED, min_rows)
 
     validate_has_variable(ANL_FILTERED, param_var)
     validate_has_variable(ANL_FILTERED, "AVISITCD")
@@ -178,7 +178,7 @@ constr_anl_chunks <- function(session, input, datasets, dataname, param_id, para
     )
 
     ANL <- chunks_safe_eval(private_chunks) # nolint
-    validate_has_data(ANL, 5)
+    validate_has_data(ANL, min_rows)
 
     return(list(ANL = ANL, chunks = private_chunks))
   })
@@ -256,7 +256,7 @@ constr_anl_chunks <- function(session, input, datasets, dataname, param_id, para
     }
   })
 
-  anl_constraint <- create_anl_constraint_reactive(anl_param, input, param_id = param_id)
+  anl_constraint <- create_anl_constraint_reactive(anl_param, input, param_id = param_id, min_rows = min_rows)
 
   return(anl_constraint)
 }
@@ -266,7 +266,7 @@ constr_anl_chunks <- function(session, input, datasets, dataname, param_id, para
 # `param_id.constraint_var` in the specified range
 # constraint var means that `param_id.constraint_var` is constrained to the filtered range (or NA),
 # e.g. `ALT.BASE2` (i.e. `PARAMCD = ALT & range_filter_on(BASE2)`)
-create_anl_constraint_reactive <- function(anl_param, input, param_id) {
+create_anl_constraint_reactive <- function(anl_param, input, param_id, min_rows) {
   reactive({
     private_chunks <- anl_param()$chunks$clone(deep = TRUE)
 
@@ -312,7 +312,7 @@ create_anl_constraint_reactive <- function(anl_param, input, param_id) {
       )
 
       ANL <- chunks_safe_eval(private_chunks) # nolint
-      validate_has_data(ANL, 5)
+      validate_has_data(ANL, min_rows)
     }
 
     chunks_push_new_line(private_chunks)