Merge pull request #648 from molgenis/xenon-med-tests

test: added tests for dsMediation functions

docker/ci/application.yml

@@ -31,6 +31,7 @@ armadillo:
       package-whitelist:
         - dsBase
         - resourcer
+        - dsMediation
       function-blacklist: [ ]
       options:
         datashield:

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")

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) {