diff --git a/DESCRIPTION b/DESCRIPTION index 2b57217..8f8101a 100644 --- a/DESCRIPTION +++ b/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 = "luis.moris.fernandez@gmail.com"), diff --git a/NEWS.md b/NEWS.md index 6c42be2..da3b461 100644 --- a/NEWS.md +++ b/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: diff --git a/R/mod_wfphm.R b/R/mod_wfphm.R index f848ec8..b845fde 100644 --- a/R/mod_wfphm.R +++ b/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" diff --git a/tests/testthat/_snaps/wfphm/filename.png b/tests/testthat/_snaps/wfphm/filename.png index d736246..3fb7f39 100644 Binary files a/tests/testthat/_snaps/wfphm/filename.png and b/tests/testthat/_snaps/wfphm/filename.png differ diff --git a/tests/testthat/_snaps/wfphm/filename.svg b/tests/testthat/_snaps/wfphm/filename.svg index 8c00156..197e2af 100644 --- a/tests/testthat/_snaps/wfphm/filename.svg +++ b/tests/testthat/_snaps/wfphm/filename.svg @@ -1,4 +1,4 @@ -123456789101112131415161718192002468101214161820PARAM11 (Label of VALUE1) at VISIT1YNYYNYYYNNYYYYYNNNNYLabel of CAT1514262432142451822786570877075811001340Label of CONT12019181716151413121110987654321Label of SUBJIDPARAM11VALUE151015205101520 +123456789101112131415161718192002468101214161820PARAM11 (Label of VALUE1) at VISIT1YNYYNYYYNNYYYYYNNNNYLabel of CAT1514262432142451822786570877075811001340Label of CONT12019181716151413121110987654321Label of SUBJIDPARAM11VALUE151015205101520 Label of CAT1 diff --git a/tests/testthat/test-heatmap.R b/tests/testthat/test-heatmap.R index e84d6b9..e928cd7 100644 --- a/tests/testthat/test-heatmap.R +++ b/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)"), { diff --git a/tests/testthat/test-wfphm.R b/tests/testthat/test-wfphm.R index aca457b..f6e7152 100644 --- a/tests/testthat/test-wfphm.R +++ b/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) } )