diff w4mcorcov_wrapper.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 a06344808ffc
children ca9938f2eb6a
line wrap: on
line diff
--- a/w4mcorcov_wrapper.R	Fri Mar 02 08:26:36 2018 -0500
+++ b/w4mcorcov_wrapper.R	Wed Sep 05 19:24:47 2018 -0400
@@ -22,18 +22,45 @@
 ## subroutines
 ##----------
 
-source("w4mcorcov_lib.R")
-source("w4mcorcov_util.R")
-source("w4mcorcov_input.R")
-source("w4mcorcov_salience.R")
-source("w4mcorcov_calc.R")
-source("w4mcorcov_output.R")
+# from: https://github.com/molgenis/molgenis-pipelines/wiki/How-to-source-another_file.R-from-within-your-R-script
+LocationOfThisScript = function() # Function LocationOfThisScript returns the location of this .R script (may be needed to source other files in same dir)
+{
+    this.file = NULL
+    # This file may be 'sourced'
+    for (i in -(1:sys.nframe())) {
+        if (identical(sys.function(i), base::source)) this.file = (normalizePath(sys.frame(i)$ofile))
+    }
+
+    if (!is.null(this.file)) return(dirname(this.file))
+
+    # But it may also be called from the command line
+    cmd.args = commandArgs(trailingOnly = FALSE)
+    cmd.args.trailing = commandArgs(trailingOnly = TRUE)
+    cmd.args = cmd.args[seq.int(from=1, length.out=length(cmd.args) - length(cmd.args.trailing))]
+    res = gsub("^(?:--file=(.*)|.*)$", "\\1", cmd.args)
+
+    # If multiple --file arguments are given, R uses the last one
+    res = tail(res[res != ""], 1)
+    if (0 < length(res)) return(dirname(res))
+
+    # Both are not the case. Maybe we are in an R GUI?
+    return(NULL)
+}
+
+script.dir <-  LocationOfThisScript()
+
+source(paste(script.dir, "w4mcorcov_lib.R", sep="/")) 
+source(paste(script.dir, "w4mcorcov_util.R", sep="/")) 
+source(paste(script.dir, "w4mcorcov_input.R", sep="/")) 
+source(paste(script.dir, "w4mcorcov_salience.R", sep="/")) 
+source(paste(script.dir, "w4mcorcov_calc.R", sep="/")) 
+source(paste(script.dir, "w4mcorcov_output.R", sep="/")) 
 
 ## log file
 ##---------
 
 my_log <- function(x, ...) { cat(paste(iso8601.znow(), " ", x, ..., nl, sep=""))}
-my_fatal <- function(x, ...) { 
+my_fatal <- function(x, ...) {
   my_log("ERROR: ", x, ...)
   quit(save = "no", status = 11, runLast = TRUE)
 }
@@ -45,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()
 
 ##------------------------------
@@ -63,7 +95,6 @@
 my_env$contrast_detail      <- as.character(argVc["contrast_detail"])
 my_env$contrast_corcov      <- as.character(argVc["contrast_corcov"])
 my_env$contrast_salience    <- as.character(argVc["contrast_salience"])
-# print(sprintf("contrast_salience: %s", my_env$contrast_salience))
 
 # other parameters
 
@@ -73,7 +104,9 @@
 my_env$levCSV             <- as.character(argVc["levCSV"])
 my_env$matchingC          <- as.character(argVc["matchingC"])
 my_env$labelFeatures      <- as.character(argVc["labelFeatures"]) # number of features to label at each extreme of the loadings or 'ALL'
-my_env$labelOrthoFeatures <- as.logical(argVc["labelOrthoFeatures"])
+my_env$cplot_o            <- as.logical(argVc["cplot_o"]) # TRUE if orthogonal C-plot is requested
+my_env$cplot_p            <- as.logical(argVc["cplot_p"]) # TRUE if parallel C-plot is requested
+my_env$cplot_y            <- as.character(argVc["cplot_y"]) # Choice of covariance/correlation for Y-axis on C-plot
 
 label_features <- my_env$labelFeatures
 labelfeatures_check <- TRUE
@@ -93,22 +126,6 @@
   quit(save = "no", status = 10, runLast = TRUE)
 }
 
-tsv_action_factory <- function(file, colnames, append) {
-  return (
-    function(tsv) {
-      write.table(
-        x = tsv
-      , file = file
-      , sep = "\t"
-      , quote = FALSE
-      , row.names = FALSE
-      , col.names = colnames
-      , append = append
-      )
-    }
-  )
-}
-
 corcov_tsv_colnames <- TRUE
 corcov_tsv_append   <- FALSE
 corcov_tsv_action <- function(tsv) {
@@ -146,24 +163,70 @@
 
   # compute and plot the correlation_vs_covariance details plot
   #   The parameter settings here are generally taken from bioconductor ropls::plot.opls source.
-  marVn <- c(4.6, 4.1, 2.6, 1.6)
-  old_par <- par(
-    font      = 2         # bold font face
-  , font.axis = 2         # bold font face for axis
-  , font.lab  = 2         # bold font face for x and y labels
-  , lwd       = 2         # line-width - interpretation is device spcific
-  , mar       = marVn     # margins
-  , pch       = 18        # black diamond plot-character, see help for graphics::points
-  # , mfrow     = c(2,2)    # two rows by two columns
-  , pty       = "s"       # force plots to be square
-  )
+  if ( my_env$cplot_p || my_env$cplot_o ) {
+    old_par <- par(
+      font        = 2         # bold font face
+    , font.axis   = 2         # bold font face for axis
+    , font.lab    = 2         # bold font face for x and y labels
+    , lwd         = 2         # line-width - interpretation is device spcific
+    , pch         = 18        # black diamond plot-character, see help for graphics::points
+    , pty         = "m"       # do not force plots to be square
+    , no.readonly = TRUE      # only save writable parameters
+    )
+    pdf_height <- 12
+    pdf_width  <- 8
+    my_layout <- function() {
+      # lay out 2 columns by 3 rows with extra width at the margin of individual plots
+      layout(
+        matrix(
+          # blank row  plot 1 & 2  blank row  plot 3 & 4  blank row  plot 5 & 6 blank row
+          c(0,0,0,0,0, 0,1,0,2,0,  0,0,0,0,0, 0,3,0,4,0,  0,0,0,0,0, 0,5,0,6,0, 0,0,0,0,0)
+        , nrow = 7
+        , ncol = 5
+        , byrow = TRUE
+        )
+        # slim columns 1, 3, and 5
+      , widths  = c(0.1, 0.9, 0.1, 0.9, 0.1)
+        # slim rows 1, 3, 5, and 7
+      , heights = c(0.1, 0.9, 0.1, 0.9, 0.1, 0.9, 0.1)
+      )
+    }
+  } else {
+    old_par <- par(
+      font        = 2         # bold font face
+    , font.axis   = 2         # bold font face for axis
+    , font.lab    = 2         # bold font face for x and y labels
+    , lwd         = 2         # line-width - interpretation is device spcific
+    , pch         = 18        # black diamond plot-character, see help for graphics::points
+    , pty         = "m"       # do not force plots to be square
+    , no.readonly = TRUE      # only save writable parameters
+    )
+    pdf_height <- 8
+    pdf_width  <- 8
+    my_layout <- function() {
+      # lay out 2 columns by 2 rows with extra width at the margin of individual plots
+      layout(
+        matrix(
+          # blank row  plot 1 & 2  blank row  plot 3 & 4  blank row
+          c(0,0,0,0,0, 0,1,0,2,0,  0,0,0,0,0, 0,3,0,4,0,  0,0,0,0,0)
+        , nrow = 5
+        , ncol = 5
+        , byrow = TRUE
+        )
+        # slim columns 1, 3, and 5
+      , widths  = c(0.1, 0.9, 0.1, 0.9, 0.1)
+        # slim rows 1, 3, and 5
+      , heights = c(0.1, 0.9, 0.1, 0.9, 0.1)
+      )
+    }
+  }
   plot2pdf(
     file.name = my_env$contrast_detail
-  , width  = 8
-  , height = 8
+  , width  = pdf_width
+  , height = pdf_height
   , plot.function = function() {
-      # plot layout four plots per page
-      layout(matrix(1:4, byrow = TRUE, nrow = 2))
+      # plot layout four or six plots per page
+      my_layout()
       my_result <<- corcov_calc(
           calc_env            = my_env
         , failure_action      = my_fatal
@@ -174,7 +237,7 @@
     }
   )
   par(old_par)
-  
+
   my_log( "--------------------------  Finished data processing  --------------------------")
 }