From 8b4617b1f747990e190b349141a2bc015d403696 Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Mon, 19 Feb 2024 16:25:33 +0100 Subject: [PATCH 1/8] initial commit for xenon mediation tests --- scripts/release/release-test.R | 100 +++++++++++++++++++++++++++++++++ 1 file changed, 100 insertions(+) diff --git a/scripts/release/release-test.R b/scripts/release/release-test.R index 29871c76e..42a6959f3 100755 --- a/scripts/release/release-test.R +++ b/scripts/release/release-test.R @@ -41,6 +41,8 @@ library(DSMolgenisArmadillo) library(resourcer) +library(dsMediationClient) + # set when admin password given + question answered with y update_auto = "" do_run_spinner <- TRUE @@ -449,6 +451,98 @@ verify_ds_obtained_mean <- function(ds_mean, expected_mean, expected_valid_and_t } } +verify_mediate_class <- function(){ + +ds.glmSLMA(formula = 'agebirth_m_y ~ ethn3_m + sex', family = 'gaussian', dataName = 'core_nonrep', + newobj = 'med.fit.1a') + +ds.glmSLMA(formula = 'preg_dia ~ agebirth_m_y + ethn3_m + sex', family = 'gaussian', + dataName = 'core_nonrep', newobj = 'out.fit.1a') + +med_out <- ds.mediate(model.m = 'med.fit.1a', model.y = 'out.fit.1a', treat = "ethn3_m", + mediator = "agebirth_m_y", boot = FALSE, conf.level = 0.95, + robustSE = TRUE, sims = 100, seed = 123, newobj = 'med.out.1a') + +med_class <- ds.class("med.out.1a") + +if(med_class == "mediate"){ + cli_alert_success("ds.mediate passed") +} else{ + cli_alert_danger("ds.mediate failed") + exit_test("ds.mediate did not return the expected class") + +} + +} + +verify_ne_weight_class <- function(){ +ds.glmSLMA(formula = 'agebirth_m_y ~ ethn3_m + sex', family = 'gaussian', dataName = 'core_nonrep', + newobj = 'med.fit.1b') + +ds.neWeight(object = 'med.fit.1b', newobj = 'expData') + +med_class <- ds.class("expData") + +if(identical(med_class$armadillo, c("data.frame", "expData", "weightData"))){ + cli_alert_success("ds.neWeight passed") +} else{ + cli_alert_danger("ds.neWeight failed") + exit_test("ds.neWeight did not return the expected class") +} + +} + +verify_ne_model_class <- function(){ + +med.out.1b <- ds.neModel(formula = 'preg_dia ~ ethn3_m0 + ethn3_m1 + sex', + family = 'gaussian', se = 'robust', expData = 'expData', + newobj = 'med.out.1b') + +med_class <- ds.class("med.out.1b") + +if(med_class == "neModel"){ + cli_alert_success("ds.neModel passed") +} else{ + cli_alert_danger("ds.neModel failed") + exit_test("ds.neModel did not return the expected class") + +} + +} + +verify_ne_imp_class <- function(){ + +out.fit.1c <- ds.glmSLMA(formula = 'preg_dia ~ agebirth_m_y + ethn3_m + sex', + family = 'gaussian', dataName = 'core_nonrep', newobj ='out.fit.1c') + +ds.neImpute(object = 'out.fit.1c', nMed = 1, newobj = 'impData') + +med_class <- ds.class("impData") + +if(identical(med_class$armadillo, c("data.frame", "expData", "impData"))){ + cli_alert_success("ds.neImpute passed") +} else{ + cli_alert_danger("ds.neImpute failed") + exit_test("ds.neImpute did not return the expected class") +} + +} + +verify_ne_lht_class <- function(){ + +lht.out.1b <- ds.neLht(model = "med.out.1b", linfct = c('ethn3_m0=0', 'ethn3_m1=0', 'ethn3_m0+ethn3_m1=0')) + +med_class <- class(lht.out.1b$armadillo) + +if(med_class == "summary.neLht"){ + cli_alert_success("ds.neLht passed") +} else{ + cli_alert_danger("ds.neLht failed") + exit_test("ds.neLht did not return the expected class") +} + +} + # here we start the script chronologically cli_alert_success("Loaded Armadillo/DataSHIELD libraries:") show_version_info(c("MolgenisArmadillo", "DSI", "dsBaseClient", "DSMolgenisArmadillo", "resourcer")) @@ -825,6 +919,12 @@ compare_list_values(hist$density, density) cli_alert_info("Validating histogram mids") compare_list_values(hist$mids, mids) +verify_mediate_class() +verify_ne_weight_class() +verify_ne_model_class() +verify_ne_imp_class() +verify_ne_lht_class() + datashield.logout(conns) if (ADMIN_MODE) { From 9db57e27e45232a7e47fa2295cc1c2a599afc9e0 Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Tue, 20 Feb 2024 09:50:36 +0100 Subject: [PATCH 2/8] test: added dsMediation install --- scripts/release/install_release_script_dependencies.R | 1 + 1 file changed, 1 insertion(+) diff --git a/scripts/release/install_release_script_dependencies.R b/scripts/release/install_release_script_dependencies.R index 9b6f35cb5..2eec837bd 100755 --- a/scripts/release/install_release_script_dependencies.R +++ b/scripts/release/install_release_script_dependencies.R @@ -55,5 +55,6 @@ warnings() library("devtools") install_github("datashield/dsBaseClient") +install_github("datashield/dsMediationClient") #check if all packages are installed cli_alert_success("All packages are installed") \ No newline at end of file From 07790c0aced5a5a1c492928e046b4c29a6c7b8cc Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Tue, 20 Feb 2024 10:01:52 +0100 Subject: [PATCH 3/8] test: added dsMediation to whitelist --- scripts/release/release-test.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/release/release-test.R b/scripts/release/release-test.R index 42a6959f3..ea81958db 100755 --- a/scripts/release/release-test.R +++ b/scripts/release/release-test.R @@ -55,7 +55,7 @@ profile_defaults = data.frame( port = c("", ""), # Multiple packages can be concatenated using ,, then using stri_split_fixed() to break them up again # Not adding dsBase since that is always(?) required - whitelist = c("resourcer", ""), + whitelist = c("resourcer", "dsMediation"), blacklist = c("", "") ) From ebde42ba527a1b11a8e836f450c937159ae278cd Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Tue, 20 Feb 2024 10:57:04 +0100 Subject: [PATCH 4/8] test: fixed whitelist of dsMediation --- scripts/release/release-test.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/release/release-test.R b/scripts/release/release-test.R index ea81958db..fc3bdf2f9 100755 --- a/scripts/release/release-test.R +++ b/scripts/release/release-test.R @@ -55,7 +55,7 @@ profile_defaults = data.frame( port = c("", ""), # Multiple packages can be concatenated using ,, then using stri_split_fixed() to break them up again # Not adding dsBase since that is always(?) required - whitelist = c("resourcer", "dsMediation"), + whitelist = c("resourcer,dsMediation", ""), blacklist = c("", "") ) From 2216a8dfae0e6a547363129e66af975b6970b8be Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Tue, 20 Feb 2024 12:07:54 +0100 Subject: [PATCH 5/8] style: added indent --- scripts/release/release-test.R | 105 ++++++++++++++++----------------- 1 file changed, 51 insertions(+), 54 deletions(-) diff --git a/scripts/release/release-test.R b/scripts/release/release-test.R index fc3bdf2f9..b476580e1 100755 --- a/scripts/release/release-test.R +++ b/scripts/release/release-test.R @@ -453,93 +453,90 @@ verify_ds_obtained_mean <- function(ds_mean, expected_mean, expected_valid_and_t verify_mediate_class <- function(){ -ds.glmSLMA(formula = 'agebirth_m_y ~ ethn3_m + sex', family = 'gaussian', dataName = 'core_nonrep', - newobj = 'med.fit.1a') + ds.glmSLMA(formula = 'agebirth_m_y ~ ethn3_m + sex', family = 'gaussian', dataName = 'core_nonrep', + newobj = 'med.fit.1a') -ds.glmSLMA(formula = 'preg_dia ~ agebirth_m_y + ethn3_m + sex', family = 'gaussian', - dataName = 'core_nonrep', newobj = 'out.fit.1a') + ds.glmSLMA(formula = 'preg_dia ~ agebirth_m_y + ethn3_m + sex', family = 'gaussian',dataName = 'core_nonrep', + newobj = 'out.fit.1a') -med_out <- ds.mediate(model.m = 'med.fit.1a', model.y = 'out.fit.1a', treat = "ethn3_m", - mediator = "agebirth_m_y", boot = FALSE, conf.level = 0.95, - robustSE = TRUE, sims = 100, seed = 123, newobj = 'med.out.1a') + med_out <- ds.mediate(model.m = 'med.fit.1a', model.y = 'out.fit.1a', treat = "ethn3_m", mediator = "agebirth_m_y", + boot = FALSE, conf.level = 0.95, robustSE = TRUE, sims = 100, seed = 123, newobj = 'med.out.1a') -med_class <- ds.class("med.out.1a") - -if(med_class == "mediate"){ - cli_alert_success("ds.mediate passed") -} else{ - cli_alert_danger("ds.mediate failed") - exit_test("ds.mediate did not return the expected class") - -} + med_class <- ds.class("med.out.1a") + if(med_class == "mediate"){ + cli_alert_success("ds.mediate passed") + } else{ + cli_alert_danger("ds.mediate failed") + exit_test("ds.mediate did not return the expected class") + } } verify_ne_weight_class <- function(){ -ds.glmSLMA(formula = 'agebirth_m_y ~ ethn3_m + sex', family = 'gaussian', dataName = 'core_nonrep', - newobj = 'med.fit.1b') + ds.glmSLMA(formula = 'agebirth_m_y ~ ethn3_m + sex', family = 'gaussian', dataName = 'core_nonrep', + newobj = 'med.fit.1b') -ds.neWeight(object = 'med.fit.1b', newobj = 'expData') + ds.neWeight(object = 'med.fit.1b', newobj = 'expData') -med_class <- ds.class("expData") + med_class <- ds.class("expData") -if(identical(med_class$armadillo, c("data.frame", "expData", "weightData"))){ - cli_alert_success("ds.neWeight passed") -} else{ - cli_alert_danger("ds.neWeight failed") - exit_test("ds.neWeight did not return the expected class") -} + if(identical(med_class$armadillo, c("data.frame", "expData", "weightData"))){ + cli_alert_success("ds.neWeight passed") + } else{ + cli_alert_danger("ds.neWeight failed") + exit_test("ds.neWeight did not return the expected class") + } } verify_ne_model_class <- function(){ -med.out.1b <- ds.neModel(formula = 'preg_dia ~ ethn3_m0 + ethn3_m1 + sex', - family = 'gaussian', se = 'robust', expData = 'expData', - newobj = 'med.out.1b') + med.out.1b <- ds.neModel(formula = 'preg_dia ~ ethn3_m0 + ethn3_m1 + sex', + family = 'gaussian', se = 'robust', expData = 'expData', + newobj = 'med.out.1b') -med_class <- ds.class("med.out.1b") + med_class <- ds.class("med.out.1b") -if(med_class == "neModel"){ - cli_alert_success("ds.neModel passed") -} else{ - cli_alert_danger("ds.neModel failed") - exit_test("ds.neModel did not return the expected class") + if(med_class == "neModel"){ + cli_alert_success("ds.neModel passed") + } else{ + cli_alert_danger("ds.neModel failed") + exit_test("ds.neModel did not return the expected class") -} + } } verify_ne_imp_class <- function(){ -out.fit.1c <- ds.glmSLMA(formula = 'preg_dia ~ agebirth_m_y + ethn3_m + sex', - family = 'gaussian', dataName = 'core_nonrep', newobj ='out.fit.1c') + out.fit.1c <- ds.glmSLMA(formula = 'preg_dia ~ agebirth_m_y + ethn3_m + sex', + family = 'gaussian', dataName = 'core_nonrep', newobj ='out.fit.1c') -ds.neImpute(object = 'out.fit.1c', nMed = 1, newobj = 'impData') + ds.neImpute(object = 'out.fit.1c', nMed = 1, newobj = 'impData') -med_class <- ds.class("impData") + med_class <- ds.class("impData") -if(identical(med_class$armadillo, c("data.frame", "expData", "impData"))){ - cli_alert_success("ds.neImpute passed") -} else{ - cli_alert_danger("ds.neImpute failed") - exit_test("ds.neImpute did not return the expected class") -} + if(identical(med_class$armadillo, c("data.frame", "expData", "impData"))){ + cli_alert_success("ds.neImpute passed") + } else{ + cli_alert_danger("ds.neImpute failed") + exit_test("ds.neImpute did not return the expected class") + } } verify_ne_lht_class <- function(){ -lht.out.1b <- ds.neLht(model = "med.out.1b", linfct = c('ethn3_m0=0', 'ethn3_m1=0', 'ethn3_m0+ethn3_m1=0')) + lht.out.1b <- ds.neLht(model = "med.out.1b", linfct = c('ethn3_m0=0', 'ethn3_m1=0', 'ethn3_m0+ethn3_m1=0')) -med_class <- class(lht.out.1b$armadillo) + med_class <- class(lht.out.1b$armadillo) -if(med_class == "summary.neLht"){ - cli_alert_success("ds.neLht passed") -} else{ - cli_alert_danger("ds.neLht failed") - exit_test("ds.neLht did not return the expected class") -} + if(med_class == "summary.neLht"){ + cli_alert_success("ds.neLht passed") + } else{ + cli_alert_danger("ds.neLht failed") + exit_test("ds.neLht did not return the expected class") + } } From ff5792dc6fb8890be3f61bbb66541d3cb3350890 Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Tue, 20 Feb 2024 12:30:42 +0100 Subject: [PATCH 6/8] test: added dsMediation to CI whitelist --- docker/ci/application.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/docker/ci/application.yml b/docker/ci/application.yml index f07fc2461..f18541804 100644 --- a/docker/ci/application.yml +++ b/docker/ci/application.yml @@ -31,6 +31,7 @@ armadillo: package-whitelist: - dsBase - resourcer + - dsMediation function-blacklist: [ ] options: datashield: From 1535426beacf1487a2adb2e33668ed28f045e16b Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Tue, 20 Feb 2024 12:48:39 +0100 Subject: [PATCH 7/8] test: show version info for dsMediation --- scripts/release/release-test.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/release/release-test.R b/scripts/release/release-test.R index b476580e1..a4a604361 100755 --- a/scripts/release/release-test.R +++ b/scripts/release/release-test.R @@ -542,7 +542,7 @@ verify_ne_lht_class <- function(){ # here we start the script chronologically cli_alert_success("Loaded Armadillo/DataSHIELD libraries:") -show_version_info(c("MolgenisArmadillo", "DSI", "dsBaseClient", "DSMolgenisArmadillo", "resourcer")) +show_version_info(c("MolgenisArmadillo", "DSI", "dsBaseClient", "DSMolgenisArmadillo", "resourcer", "dsMediation")) cli_alert_success("Loaded other libraries:") show_version_info(c("getPass", "arrow", "httr", "jsonlite", "future")) From b24f008009c575d0086a1c18fae8d705eb5fc76a Mon Sep 17 00:00:00 2001 From: Tim Cadman <41470917+timcadman@users.noreply.github.com> Date: Tue, 20 Feb 2024 14:23:21 +0100 Subject: [PATCH 8/8] test: version info should be for dsMediationClient not dsMediation --- scripts/release/release-test.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/release/release-test.R b/scripts/release/release-test.R index a4a604361..44c8511ab 100755 --- a/scripts/release/release-test.R +++ b/scripts/release/release-test.R @@ -542,7 +542,7 @@ verify_ne_lht_class <- function(){ # here we start the script chronologically cli_alert_success("Loaded Armadillo/DataSHIELD libraries:") -show_version_info(c("MolgenisArmadillo", "DSI", "dsBaseClient", "DSMolgenisArmadillo", "resourcer", "dsMediation")) +show_version_info(c("MolgenisArmadillo", "DSI", "dsBaseClient", "DSMolgenisArmadillo", "resourcer", "dsMediationClient")) cli_alert_success("Loaded other libraries:") show_version_info(c("getPass", "arrow", "httr", "jsonlite", "future"))