--- a/w4m_general_purpose_routines.R	Wed Aug 09 18:06:55 2017 -0400
+++ b/w4m_general_purpose_routines.R	Mon Mar 05 12:40:17 2018 -0500
@@ -1,3 +1,48 @@
+##-----------------------------------------------
+## helper functions for error detection/reporting
+##-----------------------------------------------
+
+# ISO 8601 date ref: https://en.wikipedia.org/wiki/ISO_8601
+iso_date <- function() {
+  format(Sys.time(), "%Y-%m-%dT%H:%M:%S%z")
+}
+
+# log-printing to stderr
+log_print <- function(x, ...) {
+  cat(
+    sep=""
+  , file=stderr()
+  , iso_date()
+  , " "
+  , c(x, ...)
+  , "\n"
+  )
+}
+
+# format error for logging
+format_error <- function(e) {
+  paste(c("Error { message:", e$message, ", call:", e$call, "}"), collapse = " ")
+}
+
+# tryCatchFunc produces a list
+#   func - a function that takes no arguments
+#   On success of func(), tryCatchFunc produces
+#     list(success = TRUE, value = func(), msg = "")
+#   On failure of func(), tryCatchFunc produces
+#     list(success = FALSE, value = NA, msg = "the error message")
+tryCatchFunc <- function(func) {
+  retval <- NULL
+  tryCatch(
+    expr = {
+      retval <- ( list( success = TRUE, value = func(), msg = "" ) )
+    }
+  , error = function(e) {
+      retval <<- list( success = FALSE, value = NA, msg = format_error(e) )
+    }
+  )
+  return (retval)
+}
+
 # prepare.data.matrix - Prepare x.datamatrix for multivariate statistical analaysis (MVA)
 #   - Motivation:
 #     - Selection:
@@ -7,7 +52,7 @@
 #         - If so, set the argument 'exclude.features' to a vector of feature names
 #     - Renaming samples:
 #       - You may want to rename several samples from your analysis:
-#         - If so, set the argument 'sample.rename.function' to a function accepting a vector 
+#         - If so, set the argument 'sample.rename.function' to a function accepting a vector
 #           of sample names and producing a vector of strings of equivalent length
 #     - MVA is confounded by missing values.
 #       - By default, this function imputes missing values as zero.
@@ -19,7 +64,7 @@
 #       - By default, this function performs an eigth-root transformation:
 #         - Any root-tranformation has the advantage of never being negative.
 #         - Calculation of the eight-root is four times faster in my hands than log10.
-#         - However, it has the disadvantage that calculation of fold-differences 
+#         - However, it has the disadvantage that calculation of fold-differences
 #           is not additive as with log-transformation.
 #           - Rather, you must divide the values and raise to the eighth power.
 #       - For a different transformation, set the 'data.transformation' argument
@@ -107,6 +152,13 @@
   }
 , en = new.env()
 ) {
+  # log to environment
+  if ( !exists("log", envir = en) ) {
+    en$log <- c()
+  }
+  enlog <- function(s) { en$log <- c(en$log, s); s }
+  #enlog("foo")
+
   # MatVar - Compute variance of rows or columns of a matrix
   # ref: http://stackoverflow.com/a/25100036
   # For row variance, dim == 1, for col variance, dim == 2
@@ -137,11 +189,9 @@
 
   nonzero.var <- function(x) {
     if (nrow(x) == 0) {
-      print(str(x))
       stop("matrix has no rows")
     }
     if (ncol(x) == 0) {
-      print(str(x))
       stop("matrix has no columns")
     }
     if ( is.numeric(x) ) {
@@ -153,7 +203,7 @@
         row.names <- attr(nonzero.rows,"names")
         x <- x[ row.names, , drop = FALSE ]
       }
-      
+
       # exclude any columns with zero variance
       column.vars <- MatVar(x, dim = 2)
       nonzero.column.vars <- column.vars > 0
@@ -170,10 +220,13 @@
     stop("FATAL ERROR - prepare.data.matrix was called with null x.matrix")
   }
 
+  enlog("prepare.data.matrix - get matrix")
+
   en$xpre <- x <- x.matrix
 
   # exclude any samples as indicated
   if ( !is.null(exclude.features) ) {
+    enlog("prepare.data.matrix - exclude any samples as indicated")
     my.colnames <- colnames(x)
     my.col.diff <- setdiff(my.colnames, exclude.features)
     x <- x[ , my.col.diff , drop = FALSE ]
@@ -181,6 +234,7 @@
 
   # exclude any features as indicated
   if ( !is.null(exclude.samples) ) {
+    enlog("prepare.data.matrix - exclude any features as indicated")
     my.rownames <- rownames(x)
     my.row.diff <- setdiff(my.rownames, exclude.samples)
     x <- x[ my.row.diff, , drop = FALSE ]
@@ -188,20 +242,25 @@
 
   # rename rows if desired
   if ( !is.null(sample.rename.function) ) {
+    enlog("prepare.data.matrix - rename rows if desired")
     renamed <- sample.rename.function(x)
     rownames(x) <- renamed
   }
 
+  enlog("prepare.data.matrix - save redacted x.datamatrix to environment")
+
   # save redacted x.datamatrix to environment
   en$redacted.data.matrix <- x
 
   # impute values missing from the x.datamatrix
   if ( !is.null(data.imputation) ) {
+    enlog("prepare.data.matrix - impute values missing from the x.datamatrix")
     x <- data.imputation(x)
   }
 
   # perform transformation if desired
   if ( !is.null(data.transformation) ) {
+    enlog("prepare.data.matrix - perform transformation")
     x <- data.transformation(x)
   } else {
     x <- x
@@ -209,6 +268,7 @@
 
   # purge rows and columns that have zero variance
   if ( is.numeric(x) ) {
+    enlog("prepare.data.matrix - purge rows and columns that have zero variance")
     x <- nonzero.var(x)
   }
 
@@ -218,66 +278,4 @@
   return(x)
 }
 
-
-##-----------------------------------------------
-## helper functions for error detection/reporting
-##-----------------------------------------------
-
-# log-printing to stderr
-log_print <- function(x, ...) { 
-  cat(
-    format(Sys.time(), "%Y-%m-%dT%H:%M:%S%z")
-  , " "
-  , c(x, ...)
-  , "\n"
-  , sep=""
-  , file=stderr()
-  )
-}
-
-# tryCatchFunc produces a list
-#   On success of expr(), tryCatchFunc produces
-#     list(success TRUE, value = expr(), msg = "")
-#   On failure of expr(), tryCatchFunc produces
-#     list(success = FALSE, value = NA, msg = "the error message")
-tryCatchFunc <- function(expr) {
-  # format error for logging
-  format_error <- function(e) {
-    paste(c("Error { message:", e$message, ", call:", e$call, "}"), collapse = " ")
-  }
-  my_expr <- expr
-  retval <- NULL
-  tryCatch(
-    expr = {
-      retval <- ( list( success = TRUE, value = my_expr(), msg = "" ) )
-    }
-  , error = function(e) {
-      retval <<- list( success = FALSE, value = NA, msg = format_error(e) )
-    }
-  )
-  return (retval)
-}
-
-# tryCatchProc produces a list
-#   On success of expr(), tryCatchProc produces
-#     list(success TRUE, msg = "")
-#   On failure of expr(), tryCatchProc produces
-#     list(success = FALSE, msg = "the error message")
-tryCatchProc <- function(expr) {
-  # format error for logging
-  format_error <- function(e) {
-    paste(c("Error { message:", e$message, ", call:", e$call, "}"), collapse = " ")
-  }
-  retval <- NULL
-  tryCatch(
-    expr = {
-      expr()
-      retval <- ( list( success = TRUE, msg = "" ) )
-    }
-  , error = function(e) {
-      retval <<- list( success = FALSE, msg = format_error(e) )
-    }
-  )
-  return (retval)
-}
-
+# vim: sw=2 ts=2 et :