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: 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 diff --git a/scripts/release/release-test.R b/scripts/release/release-test.R index 29871c76e..44c8511ab 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 @@ -53,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("", "") ) @@ -449,9 +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")) +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")) @@ -825,6 +916,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) {