Mercurial > repos > ethevenot > multivariate

comparison tests/multivariate_tests.R @ 0:fafba524dca6 draft

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 6596dbd39d20ee1962d9ebdd87eec04821239760
author ethevenot
date Wed, 27 Jul 2016 11:22:56 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:fafba524dca6
1 #!/usr/bin/env Rscript
2
3 args <- commandArgs(trailingOnly = F)
4 script.path <- sub("--file=","",args[grep("--file=",args)])
5 library(RUnit)
6 library(ropls)
7
8 #############
9 # CONSTANTS #
10 #############
11
12 exaDirOutC <- file.path(dirname(script.path), 'output')
13
14 ###################
15 # LOAD DATA FRAME #
16 ###################
17
18 load.df <- function(file) {
19 file.exists(file) || stop(paste0("No output file \"", file ,"\"."))
20 return(read.table(file = file, header = TRUE, sep = "\t", stringsAsFactors = FALSE))
21 }
22
23 #############################
24 # CALL MULTIVARIATE WRAPPER #
25 #############################
26
27 call.multivariate.wrapper <- function(params) {
28
29 # Set program path
30 prog <- file.path(dirname(script.path), '..', 'multivariate_wrapper.R')
31
32 # Set arguments
33 args <- NULL
34 for (a in names(params))
35 args <- c(args, a, params[[a]])
36
37 # Call
38 call <- paste(c(prog, args), collapse = ' ')
39 retcode <- system(call)
40 if (retcode != 0)
41 stop("Error when running multivariate_wrapper.R.")
42
43 # Get output
44 out <- list()
45 if ('ropls_out' %in% names(params)) {
46 load(file = params[['ropls_out']])
47 out[['ropLs']] <- ropLs
48 }
49 if ('sampleMetadata_out' %in% names(params))
50 out[['samDF']] <- load.df(params[['sampleMetadata_out']])
51 if ('variableMetadata_out' %in% names(params))
52 out[['varDF']] <- load.df(params[['variableMetadata_out']])
53
54 return(out)
55 }
56
57 ########
58 # MAIN #
59 ########
60
61 ## Create output folder
62 ##---------------------
63 file.exists(exaDirOutC) || dir.create(exaDirOutC)
64
65 # Define data sets
66 tesArgLs <- list(input_pca = c(respC = "none",
67 predI = "NA",
68 orthoI = "0",
69 testL = "FALSE"),
70 input_pcaGender = c(respC = "none",
71 predI = "NA",
72 orthoI = "0",
73 testL = "FALSE",
74 parMahalC = "gender"),
75 input_plsdaGender = c(respC = "gender",
76 predI = "NA",
77 orthoI = "0",
78 testL = "FALSE"),
79 input_oplsAge = c(respC = "age",
80 predI = "1",
81 orthoI = "1",
82 testL = "FALSE"),
83 input_oplsdaGender = c(respC = "gender",
84 predI = "1",
85 orthoI = "1",
86 testL = "FALSE"),
87 sacurine_pca = c(respC = "none",
88 predI = "NA",
89 orthoI = "0",
90 testL = "FALSE"),
91 sacurine_pcaGender = c(respC = "none",
92 predI = "NA",
93 orthoI = "0",
94 testL = "FALSE",
95 parMahalC = "gender"),
96 sacurine_plsAge = c(respC = "age",
97 predI = "NA",
98 orthoI = "0",
99 testL = "FALSE"),
100 sacurine_plsdaGender = c(respC = "gender",
101 predI = "NA",
102 orthoI = "0",
103 testL = "FALSE",
104 .chkC = "checkEqualsNumeric(getSummaryDF(outLs[['ropLs']])[, 'Q2(cum)'], 0.584, tolerance = 1e-3)"),
105 sacurineTest_pls = c(respC = "age",
106 predI = "2",
107 orthoI = "0",
108 testL = "TRUE",
109 .chkC = "checkEqualsNumeric(outLs[['samDF']][181, 'age_PLS_predictions'], 40.82252, tolerance = 1e-5)"),
110 sacurineTest_opls = c(respC = "age",
111 predI = "1",
112 orthoI = "2",
113 testL = "TRUE",
114 .chkC = "checkEqualsNumeric(outLs[['samDF']][181, 'age_OPLS_predictions'], 40.28963, tolerance = 1e-5)"),
115 sacurineTest_plsda = c(respC = "gender",
116 predI = "2",
117 orthoI = "0",
118 testL = "TRUE",
119 .chkC = "checkEquals(outLs[['samDF']][181, 'gender_PLSDA_predictions'], 'F')"),
120 sacurineTest_oplsda = c(respC = "gender",
121 predI = "1",
122 orthoI = "1",
123 testL = "TRUE",
124 .chkC = "checkEquals(outLs[['samDF']][181, 'gender_OPLSDA_predictions'], 'F')"),
125 sacurine_oplsAge = c(respC = "age",
126 predI = "1",
127 orthoI = "1",
128 testL = "FALSE",
129 .chkC = "checkEqualsNumeric(outLs[['varDF']][1, 'age_OPLS_VIP_ortho'], 0.3514378, tolerance = 1e-7)"),
130 sacurine_oplsdaGender = c(respC = "gender",
131 predI = "1",
132 orthoI = "1",
133 testL = "FALSE"),
134 example1_plsda = c(respC = "traitment",
135 predI = "3",
136 orthoI = "0",
137 testL = "FALSE",
138 .chkC = "checkEqualsNumeric(nrow(outLs[['ropLs']]@modelDF), 3, tolerance = 0.5)"),
139 example2_pca = c(respC = "none",
140 predI = "NA",
141 orthoI = "0",
142 testL = "FALSE"))
143
144 # Add file information for each dataset
145 for(tesC in names(tesArgLs))
146 tesArgLs[[tesC]] <- c(tesArgLs[[tesC]],
147 dataMatrix_in = file.path(unlist(strsplit(tesC, "_"))[1], "dataMatrix.tsv"),
148 sampleMetadata_in = file.path(unlist(strsplit(tesC, "_"))[1], "sampleMetadata.tsv"),
149 variableMetadata_in = file.path(unlist(strsplit(tesC, "_"))[1], "variableMetadata.tsv"),
150 sampleMetadata_out = file.path(exaDirOutC, "sampleMetadata.tsv"),
151 variableMetadata_out = file.path(exaDirOutC, "variableMetadata.tsv"),
152 ropls_out = file.path(exaDirOutC, "ropls.bin"),
153 figure = file.path(exaDirOutC, "figure.pdf"),
154 information = file.path(exaDirOutC, "information.txt"))
155
156 # Run tests on each dataset
157 for(tesC in names(tesArgLs)) {
158 print(tesC)
159 args <- as.list(tesArgLs[[tesC]])
160 args[['.chkC']] <- NULL
161 outLs <- call.multivariate.wrapper(args)
162 if(".chkC" %in% names(tesArgLs[[tesC]]))
163 stopifnot(eval(parse(text = tesArgLs[[tesC]][[".chkC"]])))
164 }
165
166 message("Checks successfully completed")