Mercurial > repos > eschen42 > w4mcorcov

comparison w4mcorcov_input.R @ 0:23f9fad4edfc draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/HegemanLab/w4mcorcov_galaxy_wrapper/tree/master commit bd26542b811de06c1a877337a2840a9f899c2b94
author eschen42
date Mon, 16 Oct 2017 14:56:52 -0400
parents
children 50f60f94c034
comparison
equal deleted inserted replaced
-1:000000000000 0:23f9fad4edfc
1 # read_data_frame - read a w4m data frame, with error handling
2 # e.g., data_matrix_input_env <- read_data_frame(dataMatrix_in, "data matrix input")
3 read_data_frame <- function(file_path, kind_string, failure_action = failure_action) {
4 my.env <- new.env()
5 my.env$success <- FALSE
6 my.env$msg <- sprintf("no message reading %s", kind_string)
7 tryCatch(
8 expr = {
9 my.env$data <- utils::read.delim( fill = FALSE, file = file_path )
10 my.env$success <- TRUE
11 }
12 , error = function(e) {
13 my.env$ msg <- sprintf("%s read failed", kind_string)
14 }
15 )
16 if (!my.env$success) {
17 failure_action(my.env$msg)
18 return ( FALSE )
19 }
20 return (my.env)
21 }
22
23 # read one of three XCMS data elements: dataMatrix, sampleMetadata, variableMetadata
24 # returns respectively: matrix, data.frame, data.frame, or FALSE if there is a failure
25 read_xcms_data_element <- function(xcms_data_in, xcms_data_type, failure_action = stop) {
26 # note that 'stop' effectively means 'throw'; if 'warning' and 'message' are caught, they mean 'throw' as well
27 my_failure_action <- function(...) { failure_action("read_xcms_data_element: ", ...) }
28 # xcms_data_type must be in c("sampleMetadata", "variableMetadata", "dataMatrix")
29 if ( ! is.character(xcms_data_type) ) {
30 my_failure_action(sprintf("bad parameter xcms_data_type '%s'", deparse(xcms_data_type)))
31 return ( FALSE )
32 }
33 if ( 1 != length(xcms_data_type)
34 || ! ( xcms_data_type %in% c("sampleMetadata", "variableMetadata", "dataMatrix") )
35 ) {
36 my_failure_action( sprintf("bad parameter xcms_data_type '%s'", xcms_data_type) )
37 return ( FALSE )
38 }
39 if ( is.character(xcms_data_in) ){
40 # case: xcms_data_in is a path to a file
41 xcms_data_input_env <- read_data_frame( xcms_data_in, sprintf("%s input", xcms_data_type) )
42 if (!xcms_data_input_env$success) {
43 my_failure_action(xcms_data_input_env$msg)
44 return ( FALSE )
45 }
46 return ( xcms_data_input_env$data )
47 # commenting out pasted code that is not tested here
48 # } else if ( is.data.frame(xcms_data_in) || is.matrix(xcms_data_in) ) {
49 # # case: xcms_data_in is a data.frame or matrix
50 # return(xcms_data_in)
51 # } else if ( is.list(xcms_data_in) || is.environment(xcms_data_in) ) {
52 # # NOTE WELL: is.list succeeds for data.frame, so the is.data.frame test must appear before the is.list test
53 # # case: xcms_data_in is a list
54 # if ( ! exists(xcms_data_type, where = xcms_data_in) ) {
55 # my_failure_action(sprintf("%s xcms_data_in is missing member '%s'"), ifelse(is.environment(xcms_data_in),"environment","list"), xcms_data_type)
56 # return ( FALSE )
57 # }
58 # prospect <- getElement(name = xcms_data_type, object = xcms_data_in)
59 # if ( ! is.data.frame(prospect) && ! is.matrix(prospect) ) {
60 # utils::str("list - str(prospect)")
61 # utils::str(prospect)
62 # if ( is.list(xcms_data_in) ) {
63 # my_failure_action(sprintf("the first member of xcms_data_in['%s'] is neither a data.frame nor a matrix but is a %s", xcms_data_type, typeof(prospect)))
64 # } else {
65 # my_failure_action(sprintf("the first member of xcms_data_in$%s is neither a data.frame nor a matrix but is a %s", xcms_data_type, typeof(prospect)))
66 # }
67 # return ( prospect )
68 # }
69 # # stop("stopping here for a snapshot")
70 # return ( prospect )
71 } else {
72 # case: xcms_data_in is invalid
73 my_failure_action( sprintf("xcms_data_in has unexpected type %s", typeof(xcms_data_in)) )
74 return ( FALSE )
75 }
76 }
77
78 read_inputs <- function(input_env, failure_action = print) {
79 if ( ! is.environment(input_env) ) {
80 failure_action("read_inputs: fatal error - 'input_env' is not an environment")
81 return ( FALSE )
82 }
83
84 if (!is.null(sampleMetadata_in <- input_env$sampleMetadata_in)) {
85 # ---
86 # read in the sample metadata
87 read_data_result <- tryCatchFunc(
88 expr = {
89 read_xcms_data_element(xcms_data_in = sampleMetadata_in, xcms_data_type = "sampleMetadata")
90 }
91 )
92 if ( read_data_result$success ) {
93 smpl_metadata <- read_data_result$value
94 } else {
95 failure_action(read_data_result$msg)
96 return ( FALSE )
97 }
98
99 # extract rownames
100 rownames(smpl_metadata) <- smpl_metadata[,1]
101
102 input_env$smpl_metadata <- smpl_metadata
103 # ...
104 } else {
105 failure_action("read_inputs: fatal error - 'sampleMetadata_in' is missing from 'input_env'")
106 return ( FALSE )
107 }
108
109 if (!is.null(variableMetadata_in <- input_env$variableMetadata_in)) {
110 # ---
111 # read in the variable metadata
112 read_data_result <- tryCatchFunc(
113 expr = {
114 read_xcms_data_element(xcms_data_in = variableMetadata_in, xcms_data_type = "variableMetadata")
115 }
116 )
117 if ( read_data_result$success ) {
118 vrbl_metadata <- read_data_result$value
119 } else {
120 failure_action(read_data_result$msg)
121 return (FALSE)
122 }
123
124
125 # extract rownames (using make.names to handle degenerate feature names)
126 err.env <- new.env()
127 err.env$success <- FALSE
128 err.env$msg <- "no message setting vrbl_metadata rownames"
129 tryCatch(
130 expr = {
131 rownames(vrbl_metadata) <- make.names( vrbl_metadata[,1], unique = TRUE )
132 vrbl_metadata[,1] <- rownames(vrbl_metadata)
133 err.env$success <- TRUE
134 }
135 , error = function(e) {
136 err.env$ msg <- sprintf("failed to set rownames for vrbl_metadata read because '%s'", e$message)
137 }
138 )
139 if (!err.env$success) {
140 failure_action(err.env$msg)
141 return ( FALSE )
142 }
143
144 input_env$vrbl_metadata <- vrbl_metadata
145 # ...
146 } else {
147 failure_action("read_inputs: fatal error - 'variableMetadata_in' is missing from 'input_env'")
148 return ( FALSE )
149 }
150
151 if (!is.null(dataMatrix_in <- input_env$dataMatrix_in)) {
152 # ---
153 # read in the data matrix
154 read_data_result <- tryCatchFunc(
155 expr = {
156 read_xcms_data_element(xcms_data_in = dataMatrix_in, xcms_data_type = "dataMatrix")
157 }
158 )
159 if ( read_data_result$success ) {
160 data_matrix <- read_data_result$value
161 } else {
162 failure_action(read_data_result$msg)
163 return (FALSE)
164 }
165
166 if ( ! is.matrix(data_matrix) ) {
167 # extract rownames (using make.names to handle degenerate feature names)
168 err.env <- new.env()
169 err.env$success <- FALSE
170 err.env$msg <- "no message setting data_matrix rownames"
171 tryCatch(
172 expr = {
173 rownames(data_matrix) <- make.names( data_matrix[,1], unique = TRUE )
174 err.env$success <- TRUE
175 }
176 , error = function(e) {
177 err.env$msg <- sprintf("failed to set rownames for data_matrix read because '%s'", e$message)
178 }
179 )
180 if (!err.env$success) {
181 failure_action(err.env$msg)
182 return ( FALSE )
183 }
184
185 # remove rownames column
186 data_matrix <- data_matrix[,2:ncol(data_matrix)]
187
188 # convert data_matrix to matrix from data.frame
189 data_matrix <- as.matrix(data_matrix)
190 }
191
192 input_env$data_matrix <- data_matrix
193 # ...
194 } else {
195 failure_action("read_inputs: fatal error - 'dataMatrix_in' is missing from 'input_env'")
196 return ( FALSE )
197 }
198
199 return ( TRUE )
200 }
201