comparison w4mclassfilter_wrapper.R @ 12:38f509903a0b draft

"planemo upload for repository https://github.com/HegemanLab/w4mclassfilter_galaxy_wrapper/tree/master commit b9712e554d16ed26f6c6d0c2e8cd74552b49f694"
author eschen42
date Tue, 01 Oct 2019 16:57:58 -0400
parents d5cf23369d12
children c18040b6e8b9
comparison
equal deleted inserted replaced
11:9f5c0e23c205 12:38f509903a0b
21 ## libraries 21 ## libraries
22 ##---------- 22 ##----------
23 23
24 suppressMessages(library(w4mclassfilter)) 24 suppressMessages(library(w4mclassfilter))
25 25
26 if(packageVersion("w4mclassfilter") < "0.98.0") 26 if(packageVersion("w4mclassfilter") < "0.98.12")
27 stop("Please use 'w4mclassfilter' versions of 0.98.0 and above") 27 stop("Please use 'w4mclassfilter' versions of 0.98.12 and above")
28 28
29 ## constants 29 ## constants
30 ##---------- 30 ##----------
31 31
32 modNamC <- "w4mclassfilter" ## module name 32 modNamC <- "w4mclassfilter" ## module name
81 variableMetadata_out <- as.character(argVc["variableMetadata_out"]) 81 variableMetadata_out <- as.character(argVc["variableMetadata_out"])
82 82
83 # other parameters 83 # other parameters
84 84
85 transformation <- as.character(argVc["transformation"]) 85 transformation <- as.character(argVc["transformation"])
86 my_imputation_label <- as.character(argVc["imputation"])
87 my_imputation_function <- if (my_imputation_label == "zero") {
88 w4m_filter_zero_imputation
89 } else if (my_imputation_label == "center") {
90 w4m_filter_median_imputation
91 } else if (my_imputation_label == "none") {
92 w4m_filter_no_imputation
93 } else {
94 stop(sprintf("Unknown value %s supplied for 'imputation' parameter. Expected one of {zero,center,none}."))
95 }
86 wildcards <- as.logical(argVc["wildcards"]) 96 wildcards <- as.logical(argVc["wildcards"])
87 sampleclassNames <- as.character(argVc["sampleclassNames"]) 97 sampleclassNames <- as.character(argVc["sampleclassNames"])
88 sampleclassNames <- strsplit(x = sampleclassNames, split = ",", fixed = TRUE)[[1]] 98 sampleclassNames <- strsplit(x = sampleclassNames, split = ",", fixed = TRUE)[[1]]
89 if (wildcards) { 99 if (wildcards) {
90 sampleclassNames <- gsub("[.]", "[.]", sampleclassNames) 100 sampleclassNames <- gsub("[.]", "[.]", sampleclassNames)
98 variable_range_filter <- strsplit(x = variable_range_filter, split = ",", fixed = TRUE)[[1]] 108 variable_range_filter <- strsplit(x = variable_range_filter, split = ",", fixed = TRUE)[[1]]
99 109
100 ## ----------------------------- 110 ## -----------------------------
101 ## Transformation and imputation 111 ## Transformation and imputation
102 ## ----------------------------- 112 ## -----------------------------
103 my_w4m_filter_imputation <- if (transformation == "log10") { 113 my_transformation_and_imputation <- if (transformation == "log10") {
104 function(m) { 114 function(m) {
105 if (!is.matrix(m)) 115 if (!is.matrix(m))
106 stop("Cannot impute and transform data - the supplied data is not in matrix form") 116 stop("Cannot transform and impute data - the supplied data is not in matrix form")
107 if (nrow(m) == 0) 117 if (nrow(m) == 0)
108 stop("Cannot impute and transform data - data matrix has no rows") 118 stop("Cannot transform and impute data - data matrix has no rows")
109 if (ncol(m) == 0) 119 if (ncol(m) == 0)
110 stop("Cannot impute and transform data - data matrix has no columns") 120 stop("Cannot transform and impute data - data matrix has no columns")
111 suppressWarnings( 121 suppressWarnings({
112 # suppress warnings here since non-positive values will produce NaN's that will be fixed in the next step 122 # suppress warnings here since non-positive values will produce NaN's that will be fixed in the next step
113 m <- log10(m) 123 m <- log10(m)
114 ) 124 m[is.na(m)] <- NA
115 return ( w4m_filter_imputation(m) ) 125 })
126 return ( my_imputation_function(m) )
116 } 127 }
117 } else if (transformation == "log2") { 128 } else if (transformation == "log2") {
118 function(m) { 129 function(m) {
119 if (!is.matrix(m)) 130 if (!is.matrix(m))
120 stop("Cannot impute and transform data - the supplied data is not in matrix form") 131 stop("Cannot transform and impute data - the supplied data is not in matrix form")
121 if (nrow(m) == 0) 132 if (nrow(m) == 0)
122 stop("Cannot impute and transform data - data matrix has no rows") 133 stop("Cannot transform and impute data - data matrix has no rows")
123 if (ncol(m) == 0) 134 if (ncol(m) == 0)
124 stop("Cannot impute and transform data - data matrix has no columns") 135 stop("Cannot transform and impute data - data matrix has no columns")
125 suppressWarnings( 136 suppressWarnings({
126 # suppress warnings here since non-positive values will produce NaN's that will be fixed in the next step 137 # suppress warnings here since non-positive values will produce NaN's that will be fixed in the next step
127 m <- log2(m) 138 m <- log2(m)
128 ) 139 m[is.na(m)] <- NA
129 return ( w4m_filter_imputation(m) ) 140 })
141 return ( my_imputation_function(m) )
130 } 142 }
131 } else { 143 } else {
132 # use the method from the w4mclassfilter class 144 # use the method from the w4mclassfilter class
133 w4m_filter_imputation 145 my_imputation_function
134 } 146 }
135 147
136 ##------------------------------ 148 ##------------------------------
137 ## Computation 149 ## Computation
138 ##------------------------------ 150 ##------------------------------
148 , include = inclusive 160 , include = inclusive
149 , class_column = classnameColumn 161 , class_column = classnameColumn
150 , samplename_column = samplenameColumn 162 , samplename_column = samplenameColumn
151 , variable_range_filter = variable_range_filter 163 , variable_range_filter = variable_range_filter
152 , failure_action = my_print 164 , failure_action = my_print
153 , data_imputation = my_w4m_filter_imputation 165 , data_imputation = my_transformation_and_imputation
154 ) 166 )
155 167
156 my_print("\nResult of '", modNamC, "' Galaxy module call to 'w4mclassfilter::w4m_filter_by_sample_class' R function: ", 168 my_print("\nResult of '", modNamC, "' Galaxy module call to 'w4mclassfilter::w4m_filter_by_sample_class' R function: ",
157 as.character(result), "\n", sep = "") 169 as.character(result), "\n", sep = "")
158 170