Mercurial > repos > ethevenot > multivariate
diff runit/multivariate_tests.R @ 2:fa173e12e185 draft
planemo upload for repository https://github.com/workflow4metabolomics/multivariate.git commit 9f4dfcdc64aa9ac2a2f6d613cc33961c02fec254-dirty
author | ethevenot |
---|---|
date | Sat, 06 Aug 2016 12:07:13 -0400 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/runit/multivariate_tests.R Sat Aug 06 12:07:13 2016 -0400 @@ -0,0 +1,218 @@ +test_input_pca <- function() { + + testDirC <- "input" + argLs <- list(respC = "none", + predI = "NA", + orthoI = "0", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_input_pcaGender <- function() { + + testDirC <- "input" + argLs <- list(respC = "none", + predI = "NA", + orthoI = "0", + testL = "FALSE", + parMahalC = "gender") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_input_plsdaGender <- function() { + + testDirC <- "input" + argLs <- list(respC = "gender", + predI = "NA", + orthoI = "0", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_input_oplsAge <- function() { + + testDirC <- "input" + argLs <- list(respC = "age", + predI = "1", + orthoI = "1", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_input_oplsdaGender <- function() { + + testDirC <- "input" + argLs <- list(respC = "gender", + predI = "1", + orthoI = "1", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_sacurine_pca <- function() { + + testDirC <- "sacurine" + argLs <- list(respC = "none", + predI = "NA", + orthoI = "0", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_sacurine_pcaGender <- function() { + + testDirC <- "sacurine" + argLs <- list(respC = "none", + predI = "NA", + orthoI = "0", + testL = "FALSE", + parMahalC = "gender") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_sacurine_plsAge <- function() { + + testDirC <- "sacurine" + argLs <- list(respC = "age", + predI = "NA", + orthoI = "0", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_sacurine_plsdaGender <- function() { + + testDirC <- "sacurine" + argLs <- list(respC = "gender", + predI = "NA", + orthoI = "0", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_sacurineTest_pls <- function() { + + testDirC <- "sacurineTest" + argLs <- list(respC = "age", + predI = "2", + orthoI = "0", + testL = "TRUE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + + checkEqualsNumeric(outLs[["samDF"]][181, "age_PLS_predictions"], 40.82252, tolerance = 1e-5) + +} + +test_sacurineTest_opls <- function() { + + testDirC <- "sacurineTest" + argLs <- list(respC = "age", + predI = "1", + orthoI = "2", + testL = "TRUE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + + checkEqualsNumeric(outLs[["samDF"]][181, "age_OPLS_predictions"], 40.28963, tolerance = 1e-5) + +} + +test_sacurineTest_plsda <- function() { + + testDirC <- "sacurineTest" + argLs <- list(respC = "gender", + predI = "2", + orthoI = "0", + testL = "TRUE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + + checkEquals(outLs[["samDF"]][181, "gender_PLSDA_predictions"], "F") + +} + +test_sacurineTest_oplsda <- function() { + + testDirC <- "sacurineTest" + argLs <- list(respC = "gender", + predI = "1", + orthoI = "1", + testL = "TRUE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + + checkEquals(outLs[["samDF"]][181, "gender_OPLSDA_predictions"], "F") + +} + +test_sacurine_oplsAge <- function() { + + testDirC <- "sacurine" + argLs <- list(respC = "age", + predI = "1", + orthoI = "1", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + + checkEqualsNumeric(outLs[["varDF"]][1, "age_OPLS_VIP_ortho"], 0.3514378, tolerance = 1e-7) +} + +test_example1_plsda <- function() { + + testDirC <- "example1" + argLs <- list(respC = "traitment", + predI = "3", + orthoI = "0", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +} + +test_example2_pca <- function() { + + testDirC <- "example2" + argLs <- list(respC = "none", + predI = "NA", + orthoI = "0", + testL = "FALSE") + + argLs <- c(defaultArgF(testDirC), argLs) + outLs <- wrapperCallF(argLs) + +}