Mercurial > repos > ethevenot > univariate
comparison tests/univariate_tests.R @ 0:ef64d3752050 draft
planemo upload for repository https://github.com/workflow4metabolomics/univariate.git commit ca0e312e1c986c45310f37effe031f60009fbcab
author | ethevenot |
---|---|
date | Wed, 27 Jul 2016 11:44:34 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:ef64d3752050 |
---|---|
1 library(RUnit) | |
2 | |
3 wrapperF <- function(argVc) { | |
4 | |
5 | |
6 source("../univariate_script.R") | |
7 | |
8 | |
9 #### Start_of_testing_code <- function() {} | |
10 | |
11 | |
12 ##------------------------------ | |
13 ## Initializing | |
14 ##------------------------------ | |
15 | |
16 ## options | |
17 ##-------- | |
18 | |
19 strAsFacL <- options()$stringsAsFactors | |
20 options(stringsAsFactors = FALSE) | |
21 | |
22 ## packages | |
23 ##--------- | |
24 | |
25 library(PMCMR) | |
26 | |
27 ## constants | |
28 ##---------- | |
29 | |
30 modNamC <- "Univariate" ## module name | |
31 | |
32 topEnvC <- environment() | |
33 flagC <- "\n" | |
34 | |
35 ## functions | |
36 ##---------- | |
37 | |
38 flgF <- function(tesC, | |
39 envC = topEnvC, | |
40 txtC = NA) { ## management of warning and error messages | |
41 | |
42 tesL <- eval(parse(text = tesC), envir = envC) | |
43 | |
44 if(!tesL) { | |
45 | |
46 sink(NULL) | |
47 stpTxtC <- ifelse(is.na(txtC), | |
48 paste0(tesC, " is FALSE"), | |
49 txtC) | |
50 | |
51 stop(stpTxtC, | |
52 call. = FALSE) | |
53 | |
54 } | |
55 | |
56 } ## flgF | |
57 | |
58 ## log file | |
59 ##--------- | |
60 | |
61 sink(argVc["information"]) | |
62 | |
63 cat("\nStart of the '", modNamC, "' Galaxy module call: ", | |
64 format(Sys.time(), "%a %d %b %Y %X"), "\n", sep="") | |
65 | |
66 ## loading | |
67 ##-------- | |
68 | |
69 datMN <- t(as.matrix(read.table(argVc["dataMatrix_in"], | |
70 check.names = FALSE, | |
71 header = TRUE, | |
72 row.names = 1, | |
73 sep = "\t"))) | |
74 | |
75 samDF <- read.table(argVc["sampleMetadata_in"], | |
76 check.names = FALSE, | |
77 header = TRUE, | |
78 row.names = 1, | |
79 sep = "\t") | |
80 | |
81 varDF <- read.table(argVc["variableMetadata_in"], | |
82 check.names = FALSE, | |
83 header = TRUE, | |
84 row.names = 1, | |
85 sep = "\t") | |
86 | |
87 tesC <- argVc["tesC"] | |
88 | |
89 ## checking | |
90 ##--------- | |
91 | |
92 flgF("identical(rownames(datMN), rownames(samDF))", txtC = "Column names of the dataMatrix are not identical to the row names of the sampleMetadata; check your data with the 'Check Format' module in the 'Quality Control' section") | |
93 flgF("identical(colnames(datMN), rownames(varDF))", txtC = "Row names of the dataMatrix are not identical to the row names of the variableMetadata; check your data with the 'Check Format' module in the 'Quality Control' section") | |
94 | |
95 flgF("argVc['facC'] %in% colnames(samDF)", txtC = paste0("Required factor of interest '", argVc['facC'], "' could not be found in the column names of the sampleMetadata")) | |
96 flgF("mode(samDF[, argVc['facC']]) %in% c('character', 'numeric')", txtC = paste0("The '", argVc['facC'], "' column of the sampleMetadata should contain either number only, or character only")) | |
97 | |
98 flgF("!(tesC %in% c('ttest', 'wilcoxon')) || (mode(samDF[, argVc['facC']]) == 'character' && length(unique(samDF[, argVc['facC']])) == 2)", txtC = paste0("For 'ttest' and 'wilcoxon', the chosen factor column ('", argVc['facC'], "') of the sampleMetadata should contain characters with only two different classes")) | |
99 flgF("!(tesC %in% c('anova', 'kruskal')) || (mode(samDF[, argVc['facC']]) == 'character' && length(unique(samDF[, argVc['facC']])) > 2)", txtC = paste0("For 'anova' and 'kruskal', the chosen factor column ('", argVc['facC'], "') of the sampleMetadata should contain characters with at least three different classes")) | |
100 flgF("!(tesC %in% c('pearson', 'spearman')) || mode(samDF[, argVc['facC']]) == 'numeric'", txtC = paste0("For 'pearson' and 'spearman', the chosen factor column ('", argVc['facC'], "') of the sampleMetadata should contain numbers only")) | |
101 | |
102 flgF("argVc['adjC'] %in% c('holm', 'hochberg', 'hommel', 'bonferroni', 'BH', 'BY', 'fdr', 'none')") | |
103 | |
104 flgF("0 <= as.numeric(argVc['thrN']) && as.numeric(argVc['thrN']) <= 1", | |
105 txtC = "(corrected) p-value threshold must be between 0 and 1") | |
106 | |
107 | |
108 ##------------------------------ | |
109 ## Computation | |
110 ##------------------------------ | |
111 | |
112 | |
113 varDF <- univariateF(datMN = datMN, | |
114 samDF = samDF, | |
115 varDF = varDF, | |
116 facC = argVc["facC"], | |
117 tesC = tesC, | |
118 adjC = argVc["adjC"], | |
119 thrN = as.numeric(argVc["thrN"])) | |
120 | |
121 | |
122 ##------------------------------ | |
123 ## Ending | |
124 ##------------------------------ | |
125 | |
126 | |
127 ## saving | |
128 ##-------- | |
129 | |
130 varDF <- cbind.data.frame(variableMetadata = rownames(varDF), | |
131 varDF) | |
132 write.table(varDF, | |
133 file = argVc["variableMetadata_out"], | |
134 quote = FALSE, | |
135 row.names = FALSE, | |
136 sep = "\t") | |
137 | |
138 ## closing | |
139 ##-------- | |
140 | |
141 cat("\nEnd of '", modNamC, "' Galaxy module call: ", | |
142 as.character(Sys.time()), "\n", sep = "") | |
143 | |
144 sink() | |
145 | |
146 options(stringsAsFactors = strAsFacL) | |
147 | |
148 | |
149 | |
150 #### End_of_testing_code <- function() {} | |
151 | |
152 | |
153 return(list(varDF = varDF)) | |
154 | |
155 rm(list = ls()) | |
156 | |
157 } | |
158 | |
159 exaDirOutC <- "output" | |
160 if(!file.exists(exaDirOutC)) | |
161 stop("Please create an 'output' subfolder into the (current) 'tests' folder") | |
162 | |
163 tesArgLs <- list(input_kruskal = c(facC = "ageGroup", | |
164 tesC = "kruskal", | |
165 adjC = "fdr", | |
166 thrN = "0.05", | |
167 .chkC = "checkEqualsNumeric(outLs[['varDF']]['HMDB01032', 'ageGroup_kruskal_senior-experienced_pva'], 0.1231246, tolerance = 1e-6)"), | |
168 example1_wilcoxDif = c(facC = "jour", | |
169 tesC = "wilcoxon", | |
170 adjC = "fdr", | |
171 thrN = "0.05", | |
172 .chkC = "checkEqualsNumeric(outLs[['varDF']]['MT3', 'jour_wilcoxon_J3-J10_dif'], 0.216480042, tolerance = 1e-8)"), | |
173 example1_ttestFdr = c(facC = "jour", | |
174 tesC = "ttest", | |
175 adjC = "fdr", | |
176 thrN = "0.05", | |
177 .chkC = "checkEqualsNumeric(outLs[['varDF']]['MT3', 'jour_ttest_J3-J10_fdr'], 0.7605966, tolerance = 1e-6)")) | |
178 | |
179 for(tesC in names(tesArgLs)) | |
180 tesArgLs[[tesC]] <- c(tesArgLs[[tesC]], | |
181 dataMatrix_in = file.path(unlist(strsplit(tesC, "_"))[1], "dataMatrix.tsv"), | |
182 sampleMetadata_in = file.path(unlist(strsplit(tesC, "_"))[1], "sampleMetadata.tsv"), | |
183 variableMetadata_in = file.path(unlist(strsplit(tesC, "_"))[1], "variableMetadata.tsv"), | |
184 variableMetadata_out = file.path(exaDirOutC, "variableMetadata.tsv"), | |
185 information = file.path(exaDirOutC, "information.txt")) | |
186 | |
187 for(tesC in names(tesArgLs)) { | |
188 print(tesC) | |
189 outLs <- wrapperF(tesArgLs[[tesC]]) | |
190 if(".chkC" %in% names(tesArgLs[[tesC]])) | |
191 stopifnot(eval(parse(text = tesArgLs[[tesC]][[".chkC"]]))) | |
192 } | |
193 | |
194 message("Checks successfully completed") |