diff src/utils.R @ 0:4764dc6a1019 draft

"planemo upload for repository https://github.com/juliechevalier/GIANT/tree/master commit cb276a594444c8f32e9819fefde3a21f121d35df"

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/utils.R	Fri Jun 26 09:51:15 2020 -0400
@@ -0,0 +1,143 @@
+# Copyright (c) 2011-2013 Trevor L. Davis <[e-mail]>  
+#  
+#  This file is free software: you may copy, redistribute and/or modify it  
+#  under the terms of the GNU General Public License as published by the  
+#  Free Software Foundation, either version 2 of the License, or (at your  
+#  option) any later version.  
+#  
+#  This file is distributed in the hope that it will be useful, but  
+#  WITHOUT ANY WARRANTY; without even the implied warranty of  
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU  
+#  General Public License for more details.  
+#  
+#  You should have received a copy of the GNU General Public License  
+#  along with this program.  If not, see <http://www.gnu.org/licenses/>.  
+
+
+#extendedDist function to correlation measure
+distExtended <- function(x,method) {
+  if(method %in% c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski"))return(dist(x,method = method))
+  if(method %in% c("pearson", "spearman", "kendall"))return(as.dist(1-cor(t(x),method=method))/2)
+  if(method %in% c("absPearson", "absSpearman", "absKendall"))return(as.dist(1-abs(cor(t(x),method=method))))
+  return(NULL)
+}
+
+##comment function to display message and optionnaly add it to log file
+
+addComment <- function(text,addToFile=FALSE,fileName=NULL,append=TRUE,display=TRUE){
+  if(display)cat(paste(c(text,"\n"),collapse = " ")) 
+  if(addToFile)write(paste(text,collapse = " "),fileName,append=append)
+}
+
+printSessionInfo <- function(fileName=NULL,append=TRUE){
+  addComment("[INFO]R session info :",T,fileName,display=FALSE)
+  tempInfo=sessionInfo()
+  write(paste(tempInfo$R.version$version.string),fileName,append=append)
+  write(paste("Platform",tempInfo$platform,sep = " : "),fileName,append=append)
+  write(paste("Running under",tempInfo$running,sep = " : "),fileName,append=append)
+  write(paste("Local variables",tempInfo$locale,sep = " : "),fileName,append=append)
+  write(paste("Attached base packages",paste(tempInfo$basePkgs,collapse = "; "),sep = " : "),fileName,append=append)
+  if(length(tempInfo$otherPkgs)>0){
+    lineToPrint=""
+    for(iPack in tempInfo$otherPkgs){
+      lineToPrint=paste(lineToPrint,iPack$Package," ",iPack$Version,"; ",sep = "")
+    }
+    write(paste("Other attached packages",lineToPrint,sep = " : "),fileName,append=append)
+  }
+  if(length(tempInfo$loadedOnly)>0){
+    lineToPrint=""
+    for(iPack in tempInfo$loadedOnly){
+      lineToPrint=paste(lineToPrint,iPack$Package," ",iPack$Version,"; ",sep = "")
+    }
+    write(paste("Loaded packages",lineToPrint,sep = " : "),fileName,append=append)
+  }
+}
+
+##negative of a mathematical expression
+negativeExpression <- function(expression){
+  expression=gsub("\\+","_toMinus_",expression)
+  expression=gsub("\\-","+",expression)
+  expression=gsub("_toMinus_","-",expression)
+  if(substr(expression,1,1)!="-" && substr(expression,1,1)!="+"){
+    expression=paste(c("-",expression),collapse="")
+  }
+
+  return(expression)
+}
+
+#' Returns file name of calling Rscript
+#'
+#' \code{get_Rscript_filename} returns the file name of calling Rscript 
+#' @return A string with the filename of the calling script.
+#'      If not found (i.e. you are in a interactive session) returns NA.
+#'
+#' @export
+get_Rscript_filename <- function() {
+    prog <- sub("--file=", "", grep("--file=", commandArgs(), value=TRUE)[1])
+    if( .Platform$OS.type == "windows") { 
+        prog <- gsub("\\\\", "\\\\\\\\", prog)
+    }
+    prog
+}
+
+#' Recursively sorts a list
+#'
+#' \code{sort_list} returns a sorted list
+#' @param unsorted_list A list.
+#' @return A sorted list.
+#' @export
+sort_list <- function(unsorted_list) {
+    for(ii in seq(along=unsorted_list)) {
+        if(is.list(unsorted_list[[ii]])) {
+            unsorted_list[[ii]] <- sort_list(unsorted_list[[ii]])
+        }
+    }
+    unsorted_list[sort(names(unsorted_list))] 
+}
+
+
+# Multiple plot function
+#
+# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
+# - cols:   Number of columns in layout
+# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
+#
+# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
+# then plot 1 will go in the upper left, 2 will go in the upper right, and
+# 3 will go all the way across the bottom.
+#
+multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
+  library(grid)
+  
+  # Make a list from the ... arguments and plotlist
+  plots <- c(list(...), plotlist)
+  
+  numPlots = length(plots)
+  
+  # If layout is NULL, then use 'cols' to determine layout
+  if (is.null(layout)) {
+    # Make the panel
+    # ncol: Number of columns of plots
+    # nrow: Number of rows needed, calculated from # of cols
+    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
+                     ncol = cols, nrow = ceiling(numPlots/cols))
+  }
+  
+  if (numPlots==1) {
+    print(plots[[1]])
+    
+  } else {
+    # Set up the page
+    grid.newpage()
+    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
+    
+    # Make each plot, in the correct location
+    for (i in 1:numPlots) {
+      # Get the i,j matrix positions of the regions that contain this subplot
+      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
+      
+      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
+                                      layout.pos.col = matchidx$col))
+    }
+  }
+}