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 {