Merge pull request #13 from Boehringer-Ingelheim/rc/v0.0.8

rc/v0.0.8

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dv.explorer.parameter
 Type: Package
 Title: Parameter exploration modules
-Version: 0.0.7
+Version: 0.0.8
 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 = "[email protected]"),

NEWS.md

@@ -1,3 +1,8 @@
+# dv.explorer.parameter 0.0.8
+
+* WFPHM:
+    * Fixes the error in conditional panels that prevented conditional panels in other modules to work properly.
+
 # dv.explorer.parameter 0.0.7
 
 * Lineplot:

R/mod_wfphm.R

@@ -1023,9 +1023,6 @@ wfphm_hmcat_server <- function(id,
 
     v_sorted_x <- shiny::reactive(
       {
-        checkmate::assert_subset(sorted_x(), as.character(levels(v_dataset()[[subjid_var]])),
-          .var.name = paste_ctxt(sorted_x)
-        )
         sorted_x()
       },
       label = ns(" v_sorted_x")
@@ -1335,9 +1332,6 @@ wfphm_hmcont_server <- function(id,
 
     v_sorted_x <- shiny::reactive(
       {
-        checkmate::assert_subset(sorted_x(), as.character(levels(v_dataset()[[subjid_var]])),
-          .var.name = paste_ctxt(sorted_x)
-        )
         sorted_x()
       },
       label = ns(" v_sorted_x")
@@ -1758,9 +1752,6 @@ wfphm_hmpar_server <- function(id,
 
     v_sorted_x <- shiny::reactive(
       {
-        checkmate::assert_subset(sorted_x(), as.character(levels(v_dataset()[[subjid_var]])),
-          .var.name = paste_ctxt(sorted_x)
-        )
         sorted_x()
       },
       label = ns(" v_sorted_x")
@@ -1870,8 +1861,6 @@ wfphm_hmpar_subset <- function(
     subj_col = subjid_var
   )
 
-  checkmate::assert_set_equal(levels(df[[CNT$SBJ]]), sorted_x) # Ignore
-
   shiny::validate(
     need_one_row_per_sbj(df, CNT$SBJ, CNT$PAR, msg = WFPHM_MSG$HMPAR$VALIDATE$TOO_MANY_ROWS)
   )
@@ -1882,6 +1871,9 @@ wfphm_hmpar_subset <- function(
   df[["y"]] <- droplevels(df[["y"]])
   df[["y"]] <- factor(df[["y"]], levels = par_selection)
 
+  # Not all values in sorted_x are present in the df subjid_var
+  # There maybe subjects with no measures at all
+
   df[["x"]] <- factor(df[["x"]], levels = sorted_x)
 
   df <- scale(df, "y", "z")
@@ -2046,17 +2038,24 @@ wfphm_UI <- function(id, tr_choices = names(tr_mapper_def())) { # nolint
       shiny::div(
         id = ns(WFPHM_ID$WFPHM$CHART_CONTAINER),
         wf_ui[["chart"]],
-        shiny::conditionalPanel(condition = "input['hmcat-cat-col-gen'].length>0", hmcat_ui[["chart"]], ns = ns),
-        shiny::conditionalPanel(condition = "input['hmcont-cont-col-gen'].length>0", hmcont_ui[["chart"]], ns = ns),
-        shiny::conditionalPanel(condition = " input['hmpar-par-par-val-gen'].length>0 && input['hmpar-value-col-gen'].length>0 && input['hmpar-visit-val-gen'].length>0 && input['hmpar-transform-gen'].length>0", hmpar_ui[["chart"]], ns = ns), # nolint
+        # nolint start
+        shiny::conditionalPanel(condition = "input['hmcat-cat-val']!== undefined && Object.hasOwn(input['hmcat-cat-val'], \"length\") ? input['hmcat-cat-val'].length>0 : false", hmcat_ui[["chart"]], ns = ns),
+        shiny::conditionalPanel(condition = "input['hmcont-cont-val']!== undefined &&Object.hasOwn(input['hmcont-cont-val'], \"length\") ? input['hmcont-cont-val'].length>0 : false", hmcont_ui[["chart"]], ns = ns),
+        shiny::conditionalPanel(condition = "
+          (input['hmpar-par-par_val']!== undefined && Object.hasOwn(input['hmpar-par-par_val'], \"length\") ? input['hmpar-par-par_val'].length>0 : false) &&
+          (input['hmpar-value-val']!== undefined && Object.hasOwn(input['hmpar-value-val'], \"length\") ? input['hmpar-value-val'].length>0 : false) &&
+          (input['hmpar-visit-val']!== undefined && Object.hasOwn(input['hmpar-visit-val'], \"length\") ? input['hmpar-visit-val'].length>0 : false) &&
+          (input['hmpar-transform']!== undefined && Object.hasOwn(input['hmpar-transform'], \"length\") ? input['hmpar-transform'].length>0 : false)
+          ", hmpar_ui[["chart"]], ns = ns), # nolint
         shiny::conditionalPanel(
-          condition = "input['hmcat-cat-col-gen'].length>0",
+          condition = "input['hmcat-cat-val']!== undefined && Object.hasOwn(input['hmcat-cat-val'], \"length\") ? input['hmcat-cat-val'].length>0 : false",
           shiny::div(
             shiny::h5("Categorical legend"),
             hmcat_ui[["legend"]]
           ),
           ns = ns
         )
+        # nolint end
       )
     ),
     style = "position:relative"

tests/testthat/test-heatmap.R

@@ -119,8 +119,6 @@ get_rect_center <- function(n, app) {
   return(c(x, y))
 }
 
-browser()
-
 test_that(
   paste(component, "should show a heatmap with all the components when correct input is passed (continuous Z) (snapshot)"),
   {

tests/testthat/test-wfphm.R

@@ -145,13 +145,19 @@ test_that(
     app$click(C$SAVE_SVG)
     app$wait_for_idle()
 
-    expect_snapshot_file(
-      path = file.path(down_dir, "filename.png")
-    )
+    png_file <- file.path(down_dir, sprintf("%s.png", filename))
+    svg_file <- file.path(down_dir, sprintf("%s.svg", filename))
+
+    retry <- 10
+    file_found <- FALSE
+    while (!file_found && retry > 0) {
+      file_found <- file.exists(png_file)
+      retry <- retry - 1
+    }
 
-    expect_snapshot_file(
-      path = file.path(down_dir, "filename.svg")
-    )
+    expect_true(file_found)
+    expect_snapshot_file(path = png_file)
+    expect_snapshot_file(path = svg_file)
   }
 )