# HG changeset patch
# User eschen42
# Date 1536201081 14400
# Node ID ddcc33ff32051eb27076992f4c84941f5e66030b
# Parent  9a52306991b3d9f6de7c89c03d81c08b8c1324ee
planemo upload for repository https://github.com/HegemanLab/w4mcorcov_galaxy_wrapper/tree/master commit 4428e3252d54c8a8e0e5d85e8eaaeb13e9b21de7

diff -r 9a52306991b3 -r ddcc33ff3205 w4mcorcov.xml
--- a/w4mcorcov.xml	Sat Sep 01 11:33:03 2018 -0400
+++ b/w4mcorcov.xml	Wed Sep 05 22:31:21 2018 -0400
@@ -1,4 +1,4 @@
-<tool id="w4mcorcov" name="OPLS-DA_Contrasts" version="0.98.14">
+<tool id="w4mcorcov" name="OPLS-DA_Contrasts" version="0.98.15">
     <description>OPLS-DA Contrasts of Univariate Results</description>
     <macros>
         <xml name="paramPairSigFeatOnly">
@@ -419,20 +419,20 @@
           <has_text text="vip4o" />
           <!-- first matched line -->
           <has_text text="M349.2383T700" />
-          <has_text text="-0.37867079" />
-          <has_text text="-37.71066" />
-          <has_text text="0.5246766" />
-          <has_text text="0.0103341" />
+          <has_text text="0.43361563" />
+          <has_text text="37.76875778" />
+          <has_text text="0.54672558" />
+          <has_text text="0.3920409" />
           <!-- second matched line -->
           <has_text text="M207.9308T206" />
-          <has_text text="0.31570433" />
-          <has_text text="5.86655640" />
-          <has_text text="0.2111623" />
-          <has_text text="0.0488654" />
+          <has_text text="-0.3365475" />
+          <has_text text="-6.337903" />
+          <has_text text="0.270297" />
+          <has_text text="0.037661" />
         </assert_contents>
       </output>
     </test>
-    <!-- test #6 -->
+    <!-- test #6 - issue 6 -->
     <test>
       <param name="dataMatrix_in" value="input_dataMatrix.tsv"/>
       <param name="sampleMetadata_in" value="issue6_input_sampleMetadata.tsv"/>
@@ -461,6 +461,32 @@
         </assert_contents>
       </output>
     </test>
+    <!-- test #6 - issue 8 -->
+    <test>
+      <param name="dataMatrix_in" value="input_dataMatrix.tsv"/>
+      <param name="sampleMetadata_in" value="issue8_input_sampleMetadata.tsv"/>
+      <param name="variableMetadata_in" value="input_variableMetadata.tsv"/>
+      <param name="tesC" value="none"/>
+      <param name="facC" value="k._10"/>
+      <param name="labelFeatures" value="3"/>
+      <param name="levCSV" value="k_3,k-4"/>
+      <param name="matchingC" value="none"/>
+      <output name="contrast_corcov">
+        <assert_contents>
+          <!-- column-labels line -->
+          <has_text text="featureID" />
+          <has_text text="factorLevel1" />
+          <has_text text="factorLevel2" />
+          <has_text text="correlation" />
+          <has_text text="covariance" />
+          <has_text text="vip4p" />
+          <has_text text="vip4o" />
+          <!-- k1 rejected by levCSV, leaving only k_3 and k-4 -->
+          <not_has_text text="k1" />
+          <not_has_text text="other" />
+        </assert_contents>
+      </output>
+    </test>
   </tests>
   <help><![CDATA[
 
diff -r 9a52306991b3 -r ddcc33ff3205 w4mcorcov_calc.R
--- a/w4mcorcov_calc.R	Sat Sep 01 11:33:03 2018 -0400
+++ b/w4mcorcov_calc.R	Wed Sep 05 22:31:21 2018 -0400
@@ -71,7 +71,9 @@
       # print("str(my_cor_vs_cov)")
       # str(my_cor_vs_cov)
       if (is.null(my_cor_vs_cov) || sum(!is.na(my_cor_vs_cov$tsv1$covariance)) < 2) {
-        x_progress("No cor_vs_cov data produced")
+        if (is.null(cor_vs_cov_x)) {
+          x_progress("No cor_vs_cov data produced")
+        }
         plot(x=1, y=1, xaxt="n", yaxt="n", xlab="", ylab="", type="n")
         text(x=1, y=1, labels="too few covariance data")
         return(my_cor_vs_cov)
@@ -561,7 +563,8 @@
       plot_action <- function(fctr_lvl_1, fctr_lvl_2) {
         progress_action(
           sprintf("calculating/plotting contrast of %s vs. %s"
-                 , fctr_lvl_1, fctr_lvl_2))
+                 , fctr_lvl_1, fctr_lvl_2)
+        )
         predictor <- sapply(
           X = chosen_facC
         , FUN = function(fac) if ( fac == fctr_lvl_1 ) fctr_lvl_1 else fctr_lvl_2
@@ -569,7 +572,7 @@
         my_cor_cov <- do_detail_plot(
           x_dataMatrix  = my_matrix
         , x_predictor   = predictor
-        , x_is_match    = is_match
+        , x_is_match    = TRUE
         , x_algorithm   = algoC
         , x_prefix      = if (pairSigFeatOnly) {
                             "Significantly contrasting features"
@@ -582,7 +585,7 @@
         , x_env         = calc_env
         )
         if ( is.null(my_cor_cov) ) {
-          progress_action("NOTHING TO PLOT.")
+          progress_action("NOTHING TO PLOT")
         } else {
           my_tsv <- my_cor_cov$tsv1
           my_tsv$mz <- mz_lookup(my_tsv$featureID)
@@ -619,57 +622,72 @@
           fctr_lvl_2        <- col_match[3]               #                ^^      # Factor-level 2
           # only process this column if both factors are members of lvlCSV
           is_match <- isLevelSelected(fctr_lvl_1) && isLevelSelected(fctr_lvl_2)
-          progress_action(
-            sprintf("calculating/plotting contrast of %s vs. %s"
-                   , fctr_lvl_1, fctr_lvl_2))
-          # choose only samples with one of the two factors for this column
-          chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2)
-          predictor <- smpl_metadata_facC[chosen_samples]
-          # extract only the significantly-varying features and the chosen samples
-          fully_significant   <- 1 == vrbl_metadata[,vrbl_metadata_col] *
-            ( if (intersample_sig_col %in% colnames(vrbl_metadata)) {
-                vrbl_metadata[,intersample_sig_col]
-              } else {
-                1
-              }
+          if (is_match) {
+            progress_action(
+              sprintf("calculating/plotting contrast of %s vs. %s."
+                     , fctr_lvl_1, fctr_lvl_2
+              )
             )
-          col_selector <- vrbl_metadata_names[
-            if ( pairSigFeatOnly ) fully_significant else overall_significant
-          ]
-          my_matrix <- tdm[ chosen_samples, col_selector, drop = FALSE ]
-          my_cor_cov <- do_detail_plot(
-            x_dataMatrix  = my_matrix
-          , x_predictor   = predictor
-          , x_is_match    = is_match
-          , x_algorithm   = algoC
-          , x_prefix      = if (pairSigFeatOnly) {
-                              "Significantly contrasting features"
-                            } else {
-                              "Significant features"
-                            }
-          , x_show_labels = labelFeatures
-          , x_progress    = progress_action
-          , x_crossval_i  = min(7, length(chosen_samples))
-          , x_env         = calc_env
-          )
-          if ( is.null(my_cor_cov) ) {
-            progress_action("NOTHING TO PLOT.")
+            # choose only samples with one of the two factors for this column
+            chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2)
+            predictor <- smpl_metadata_facC[chosen_samples]
+            # extract only the significantly-varying features and the chosen samples
+            fully_significant   <- 1 == vrbl_metadata[,vrbl_metadata_col] *
+              ( if (intersample_sig_col %in% colnames(vrbl_metadata)) {
+                  vrbl_metadata[,intersample_sig_col]
+                } else {
+                  1
+                }
+              )
+            col_selector <- vrbl_metadata_names[
+              if ( pairSigFeatOnly ) fully_significant else overall_significant
+            ]
+            my_matrix <- tdm[ chosen_samples, col_selector, drop = FALSE ]
+            my_cor_cov <- do_detail_plot(
+              x_dataMatrix  = my_matrix
+            , x_predictor   = predictor
+            , x_is_match    = is_match
+            , x_algorithm   = algoC
+            , x_prefix      = if (pairSigFeatOnly) {
+                                "Significantly contrasting features"
+                              } else {
+                                "Significant features"
+                              }
+            , x_show_labels = labelFeatures
+            , x_progress    = progress_action
+            , x_crossval_i  = min(7, length(chosen_samples))
+            , x_env         = calc_env
+            )
+            if ( is.null(my_cor_cov) ) {
+              progress_action("NOTHING TO PLOT.")
+            } else {
+              tsv <- my_cor_cov$tsv1
+              tsv$mz <- mz_lookup(tsv$featureID)
+              tsv$rt <- rt_lookup(tsv$featureID)
+              tsv["level1Level2Sig"] <- vrbl_metadata[
+                match(tsv$featureID, vrbl_metadata_names)
+              , vrbl_metadata_col
+              ]
+              corcov_tsv_action(tsv)
+              did_plot <- TRUE
+            }
           } else {
-            tsv <- my_cor_cov$tsv1
-            tsv$mz <- mz_lookup(tsv$featureID)
-            tsv$rt <- rt_lookup(tsv$featureID)
-            tsv["level1Level2Sig"] <- vrbl_metadata[
-              match(tsv$featureID, vrbl_metadata_names)
-            , vrbl_metadata_col
-            ]
-            corcov_tsv_action(tsv)
-            did_plot <- TRUE
+            progress_action(
+              sprintf("skipping contrast of %s vs. %s."
+                     , fctr_lvl_1, fctr_lvl_2
+              )
+            )
           }
         }
       }
     }
   } else { # tesC == "none"
+    # find all the levels for factor facC in sampleMetadata
     level_union <- unique(sort(smpl_metadata_facC))
+    # identify the selected levels for factor facC from sampleMetadata
+    level_include <- sapply(X = level_union, FUN = isLevelSelected)
+    # discard the non-selected levels for factor facC
+    level_union <- level_union[level_include]
     if ( length(level_union) > 1 ) {
       if ( length(level_union) > 2 ) {
         ## pass 1 - contrast each selected level with all other levels combined into one "super-level" ##
@@ -687,12 +705,11 @@
             }
             chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2)
             fctr_lvl_2 <- "other"
-            progress_action(
-              sprintf("calculating/plotting contrast of %s vs. %s"
-              , fctr_lvl_1, fctr_lvl_2)
-            )
             if (length(unique(chosen_samples)) < 1) {
-              progress_action("NOTHING TO PLOT...")
+              progress_action(
+                sprintf("Skipping contrast of %s vs. %s; there are no chosen samples."
+                , fctr_lvl_1, fctr_lvl_2)
+              )
             } else {
               chosen_facC <- as.character(smpl_metadata_facC[chosen_samples])
               predictor <- sapply(
@@ -704,25 +721,32 @@
               my_matrix <- tdm[ chosen_samples, , drop = FALSE ]
               # only process this column if both factors are members of lvlCSV
               is_match <- isLevelSelected(fctr_lvl_1)
-              my_cor_cov <- do_detail_plot(
-                x_dataMatrix  = my_matrix
-              , x_predictor   = predictor
-              , x_is_match    = is_match
-              , x_algorithm   = algoC
-              , x_prefix      = "Features"
-              , x_show_labels = labelFeatures
-              , x_progress    = progress_action
-              , x_crossval_i  = min(7, length(chosen_samples))
-              , x_env         = calc_env
-              )
-              if ( is.null(my_cor_cov) ) {
-                progress_action("NOTHING TO PLOT")
+              if (is_match) {
+                progress_action(
+                  sprintf("Calculating/plotting contrast of %s vs. %s"
+                  , fctr_lvl_1, fctr_lvl_2)
+                )
+                my_cor_cov <- do_detail_plot(
+                  x_dataMatrix  = my_matrix
+                , x_predictor   = predictor
+                , x_is_match    = is_match
+                , x_algorithm   = algoC
+                , x_prefix      = "Features"
+                , x_show_labels = labelFeatures
+                , x_progress    = progress_action
+                , x_crossval_i  = min(7, length(chosen_samples))
+                , x_env         = calc_env
+                )
+                if ( is.null(my_cor_cov) ) {
+                  progress_action("NOTHING TO PLOT...")
+                } else {
+                  tsv <- my_cor_cov$tsv1
+                  tsv$mz <- mz_lookup(tsv$featureID)
+                  tsv$rt <- rt_lookup(tsv$featureID)
+                  corcov_tsv_action(tsv)
+                  did_plot <<- TRUE
+                }
               } else {
-                tsv <- my_cor_cov$tsv1
-                tsv$mz <- mz_lookup(tsv$featureID)
-                tsv$rt <- rt_lookup(tsv$featureID)
-                corcov_tsv_action(tsv)
-                did_plot <<- TRUE
               }
             }
             "dummy" # need to return a value; otherwise combn fails with an error
@@ -738,43 +762,56 @@
           fctr_lvl_1 <- x[1]
           fctr_lvl_2 <- x[2]
           chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2)
-          progress_action(
-            sprintf("calculating/plotting contrast of %s vs. %s"
-                   , fctr_lvl_1, fctr_lvl_2))
           if (length(unique(chosen_samples)) < 1) {
-            progress_action("NOTHING TO PLOT...")
+            progress_action(
+              sprintf("Skipping contrast of %s vs. %s. - There are no chosen samples."
+                     , fctr_lvl_1, fctr_lvl_2
+              )
+            )
           } else {
             chosen_facC <- as.character(smpl_metadata_facC[chosen_samples])
             predictor <- chosen_facC
             my_matrix <- tdm[ chosen_samples, , drop = FALSE ]
             # only process this column if both factors are members of lvlCSV
             is_match <- isLevelSelected(fctr_lvl_1) && isLevelSelected(fctr_lvl_2)
-            my_cor_cov <- do_detail_plot(
-              x_dataMatrix  = my_matrix
-            , x_predictor   = predictor
-            , x_is_match    = is_match
-            , x_algorithm   = algoC
-            , x_prefix      = "Features"
-            , x_show_labels = labelFeatures
-            , x_progress    = progress_action
-            , x_crossval_i  = min(7, length(chosen_samples))
-            , x_env         = calc_env
-            )
-            if ( is.null(my_cor_cov) ) {
-              progress_action("NOTHING TO PLOT")
+            if (is_match) {
+              progress_action(
+                sprintf("Calculating/plotting contrast of %s vs. %s."
+                       , fctr_lvl_1, fctr_lvl_2)
+                )
+              my_cor_cov <- do_detail_plot(
+                x_dataMatrix  = my_matrix
+              , x_predictor   = predictor
+              , x_is_match    = is_match
+              , x_algorithm   = algoC
+              , x_prefix      = "Features"
+              , x_show_labels = labelFeatures
+              , x_progress    = progress_action
+              , x_crossval_i  = min(7, length(chosen_samples))
+              , x_env         = calc_env
+              )
+              if ( is.null(my_cor_cov) ) {
+                progress_action("NOTHING TO PLOT.....")
+              } else {
+                tsv <- my_cor_cov$tsv1
+                tsv$mz <- mz_lookup(tsv$featureID)
+                tsv$rt <- rt_lookup(tsv$featureID)
+                corcov_tsv_action(tsv)
+                did_plot <<- TRUE
+              }
             } else {
-              tsv <- my_cor_cov$tsv1
-              tsv$mz <- mz_lookup(tsv$featureID)
-              tsv$rt <- rt_lookup(tsv$featureID)
-              corcov_tsv_action(tsv)
-              did_plot <<- TRUE
+              progress_action(
+                sprintf("Skipping contrast of %s vs. %s."
+                       , fctr_lvl_1, fctr_lvl_2
+                )
+              )
             }
           }
           "dummy" # need to return a value; otherwise combn fails with an error
         }
       )
     } else {
-      progress_action("NOTHING TO PLOT....")
+      progress_action("NOTHING TO PLOT......")
     }
   }
   if (!did_plot) {
diff -r 9a52306991b3 -r ddcc33ff3205 w4mcorcov_lib.R
--- a/w4mcorcov_lib.R	Sat Sep 01 11:33:03 2018 -0400
+++ b/w4mcorcov_lib.R	Wed Sep 05 22:31:21 2018 -0400
@@ -1,12 +1,3 @@
 suppressMessages(library(batch))
-# suppressMessages(library(foreach))
 suppressMessages(library(ropls))
 suppressMessages(library(methods))
-
-# cat("Installed packages:",stderr())
-# write.table((installed.packages(.Library, priority = "high"))[, c(1,3:5)], stderr())
-# cat("Loaded packages:",stderr())
-# write(.packages(), stderr())
-
-print(sessionInfo())
-
diff -r 9a52306991b3 -r ddcc33ff3205 w4mcorcov_util.R
--- a/w4mcorcov_util.R	Sat Sep 01 11:33:03 2018 -0400
+++ b/w4mcorcov_util.R	Wed Sep 05 22:31:21 2018 -0400
@@ -21,10 +21,54 @@
   return (retval)
 }
 
+errorSink <- function(which_function, ...) {
+  var_args <- "..."
+  tryCatch(
+    var_args <<- (deparse(..., width.cutoff = 60))
+  , error = function(e) {print(e$message)}
+  )
+  if (var_args == "...")
+    return
+  # format error for logging
+  format_error <- function(e) {
+    sprintf(
+      "Error\n{  message: %s\n, arguments: %s\n}\n"
+    , e$message
+    , Reduce(f = paste, x = var_args)
+    )
+  }
+  format_warning <- function(e) {
+    sprintf(
+      "Warning\n{  message: %s\n, arguments: %s\n}\n"
+    , e$message
+    , Reduce(f = paste, x = var_args)
+    )
+  }
+  sink_number <- sink.number()
+  sink(stderr())
+  tryCatch(
+    var_args <- (deparse(..., width.cutoff = 60))
+  , expr = {
+      retval <- which_function(...)
+    }
+    , error = function(e) cat(format_error(e), file = stderr())
+    , warning = function(w) cat(format_warning(w), file = stderr())
+  )
+  while (sink.number() > sink_number) {
+    sink()
+  }
+}
+errorPrint <- function(...) {
+  errorSink(which_function = print, ...)
+}
+errorCat <- function(...) {
+  errorSink(which_function = cat, ..., "\n")
+}
+
 
 # # pseudo-inverse - computational inverse of non-square matrix a
 # p.i <- function(a) {
 #   solve(t(a) %*% a) %*% t(a)
 # } 
 
-
+# vim: sw=2 ts=2 et ai :
diff -r 9a52306991b3 -r ddcc33ff3205 w4mcorcov_wrapper.R
--- a/w4mcorcov_wrapper.R	Sat Sep 01 11:33:03 2018 -0400
+++ b/w4mcorcov_wrapper.R	Wed Sep 05 22:31:21 2018 -0400
@@ -72,7 +72,12 @@
 # MAIN #
 ########
 
+errorPrint(sessionInfo())
+
 argVc <- unlist(parseCommandArgs(evaluate=FALSE))
+errorCat("\n\n---\n\nArguments that were passed to R are as follows:\n")
+errorPrint(argVc)
+
 my_env <- new.env()
 
 ##------------------------------