Mercurial > repos > ethevenot > multivariate

view runit/multivariate_tests.R @ 4:5526f8258e8a draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/workflow4metabolomics/multivariate.git commit 0f382a5296aae9bfc77df06b0a5ad493eb3c01f3
author ethevenot
date Wed, 28 Feb 2018 09:59:25 -0500
parents fa173e12e185
children
line wrap: on
line source

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