Mercurial > repos > eschen42 > w4mcorcov
diff w4mcorcov_input.R @ 6:0b49916c5c52 draft
planemo upload for repository https://github.com/HegemanLab/w4mcorcov_galaxy_wrapper/tree/master commit 4428e3252d54c8a8e0e5d85e8eaaeb13e9b21de7
author | eschen42 |
---|---|
date | Wed, 05 Sep 2018 19:24:47 -0400 |
parents | 50a07adddfbd |
children |
line wrap: on
line diff
--- a/w4mcorcov_input.R Fri Mar 02 08:26:36 2018 -0500 +++ b/w4mcorcov_input.R Wed Sep 05 19:24:47 2018 -0400 @@ -1,6 +1,6 @@ # read_data_frame - read a w4m data frame, with error handling # e.g., data_matrix_input_env <- read_data_frame(dataMatrix_in, "data matrix input") -read_data_frame <- function(file_path, kind_string, failure_action = failure_action) { +read_data_frame <- function(file_path, kind_string, rdf_failure_action = failure_action) { my.env <- new.env() my.env$success <- FALSE my.env$msg <- sprintf("no message reading %s", kind_string) @@ -14,7 +14,7 @@ } ) if (!my.env$success) { - failure_action(my.env$msg) + rdf_failure_action(my.env$msg) return ( FALSE ) } return (my.env) @@ -36,7 +36,7 @@ my_failure_action( sprintf("bad parameter xcms_data_type '%s'", xcms_data_type) ) return ( FALSE ) } - if ( is.character(xcms_data_in) ){ + if ( is.character(xcms_data_in) ) { # case: xcms_data_in is a path to a file xcms_data_input_env <- read_data_frame( xcms_data_in, sprintf("%s input", xcms_data_type) ) if (!xcms_data_input_env$success) { @@ -44,30 +44,6 @@ return ( FALSE ) } return ( xcms_data_input_env$data ) - # commenting out pasted code that is not tested here - # } else if ( is.data.frame(xcms_data_in) || is.matrix(xcms_data_in) ) { - # # case: xcms_data_in is a data.frame or matrix - # return(xcms_data_in) - # } else if ( is.list(xcms_data_in) || is.environment(xcms_data_in) ) { - # # NOTE WELL: is.list succeeds for data.frame, so the is.data.frame test must appear before the is.list test - # # case: xcms_data_in is a list - # if ( ! exists(xcms_data_type, where = xcms_data_in) ) { - # my_failure_action(sprintf("%s xcms_data_in is missing member '%s'"), ifelse(is.environment(xcms_data_in),"environment","list"), xcms_data_type) - # return ( FALSE ) - # } - # prospect <- getElement(name = xcms_data_type, object = xcms_data_in) - # if ( ! is.data.frame(prospect) && ! is.matrix(prospect) ) { - # utils::str("list - str(prospect)") - # utils::str(prospect) - # if ( is.list(xcms_data_in) ) { - # 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))) - # } else { - # 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))) - # } - # return ( prospect ) - # } - # # stop("stopping here for a snapshot") - # return ( prospect ) } else { # case: xcms_data_in is invalid my_failure_action( sprintf("xcms_data_in has unexpected type %s", typeof(xcms_data_in)) ) @@ -189,6 +165,10 @@ data_matrix <- as.matrix(data_matrix) } + # Omit any feature not found in variableMetadata and any sample not found in sampleMetadata + # For something more elaborate, see https://github.com/HegemanLab/w4mclassfilter + data_matrix <- data_matrix[rownames(data_matrix) %in% rownames(vrbl_metadata),colnames(data_matrix) %in% rownames(smpl_metadata)] + input_env$data_matrix <- data_matrix # ... } else {