Mercurial > repos > vandelj > giant_hierarchical_clustering

comparison src/utils.R @ 0:14045c80a222 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"planemo upload for repository https://github.com/juliechevalier/GIANT/tree/master commit cb276a594444c8f32e9819fefde3a21f121d35df"
author vandelj
date Fri, 26 Jun 2020 09:38:23 -0400
parents
children d75a74a93587
comparison
equal deleted inserted replaced
-1:000000000000 0:14045c80a222
1 # Copyright (c) 2011-2013 Trevor L. Davis <trevor.l.davis@stanford.edu>
2 #
3 # This file is free software: you may copy, redistribute and/or modify it
4 # under the terms of the GNU General Public License as published by the
5 # Free Software Foundation, either version 2 of the License, or (at your
6 # option) any later version.
7 #
8 # This file is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 # General Public License for more details.
12 #
13 # You should have received a copy of the GNU General Public License
14 # along with this program. If not, see <http://www.gnu.org/licenses/>.
15
16
17 #extendedDist function to correlation measure
18 distExtended <- function(x,method) {
19 if(method %in% c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski"))return(dist(x,method = method))
20 if(method %in% c("pearson", "spearman", "kendall"))return(as.dist(1-cor(t(x),method=method))/2)
21 if(method %in% c("absPearson", "absSpearman", "absKendall"))return(as.dist(1-abs(cor(t(x),method=method))))
22 return(NULL)
23 }
24
25 ##comment function to display message and optionnaly add it to log file
26
27 addComment <- function(text,addToFile=FALSE,fileName=NULL,append=TRUE,display=TRUE){
28 if(display)cat(paste(c(text,"\n"),collapse = " "))
29 if(addToFile)write(paste(text,collapse = " "),fileName,append=append)
30 }
31
32 printSessionInfo <- function(fileName=NULL,append=TRUE){
33 addComment("[INFO]R session info :",T,fileName,display=FALSE)
34 tempInfo=sessionInfo()
35 write(paste(tempInfo$R.version$version.string),fileName,append=append)
36 write(paste("Platform",tempInfo$platform,sep = " : "),fileName,append=append)
37 write(paste("Running under",tempInfo$running,sep = " : "),fileName,append=append)
38 write(paste("Local variables",tempInfo$locale,sep = " : "),fileName,append=append)
39 write(paste("Attached base packages",paste(tempInfo$basePkgs,collapse = "; "),sep = " : "),fileName,append=append)
40 if(length(tempInfo$otherPkgs)>0){
41 lineToPrint=""
42 for(iPack in tempInfo$otherPkgs){
43 lineToPrint=paste(lineToPrint,iPack$Package," ",iPack$Version,"; ",sep = "")
44 }
45 write(paste("Other attached packages",lineToPrint,sep = " : "),fileName,append=append)
46 }
47 if(length(tempInfo$loadedOnly)>0){
48 lineToPrint=""
49 for(iPack in tempInfo$loadedOnly){
50 lineToPrint=paste(lineToPrint,iPack$Package," ",iPack$Version,"; ",sep = "")
51 }
52 write(paste("Loaded packages",lineToPrint,sep = " : "),fileName,append=append)
53 }
54 }
55
56 ##negative of a mathematical expression
57 negativeExpression <- function(expression){
58 expression=gsub("\\+","_toMinus_",expression)
59 expression=gsub("\\-","+",expression)
60 expression=gsub("_toMinus_","-",expression)
61 if(substr(expression,1,1)!="-" && substr(expression,1,1)!="+"){
62 expression=paste(c("-",expression),collapse="")
63 }
64
65 return(expression)
66 }
67
68 #' Returns file name of calling Rscript
69 #'
70 #' \code{get_Rscript_filename} returns the file name of calling Rscript
71 #' @return A string with the filename of the calling script.
72 #' If not found (i.e. you are in a interactive session) returns NA.
73 #'
74 #' @export
75 get_Rscript_filename <- function() {
76 prog <- sub("--file=", "", grep("--file=", commandArgs(), value=TRUE)[1])
77 if( .Platform$OS.type == "windows") {
78 prog <- gsub("\\\\", "\\\\\\\\", prog)
79 }
80 prog
81 }
82
83 #' Recursively sorts a list
84 #'
85 #' \code{sort_list} returns a sorted list
86 #' @param unsorted_list A list.
87 #' @return A sorted list.
88 #' @export
89 sort_list <- function(unsorted_list) {
90 for(ii in seq(along=unsorted_list)) {
91 if(is.list(unsorted_list[[ii]])) {
92 unsorted_list[[ii]] <- sort_list(unsorted_list[[ii]])
93 }
94 }
95 unsorted_list[sort(names(unsorted_list))]
96 }
97
98
99 # Multiple plot function
100 #
101 # ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
102 # - cols: Number of columns in layout
103 # - layout: A matrix specifying the layout. If present, 'cols' is ignored.
104 #
105 # If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
106 # then plot 1 will go in the upper left, 2 will go in the upper right, and
107 # 3 will go all the way across the bottom.
108 #
109 multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
110 library(grid)
111
112 # Make a list from the ... arguments and plotlist
113 plots <- c(list(...), plotlist)
114
115 numPlots = length(plots)
116
117 # If layout is NULL, then use 'cols' to determine layout
118 if (is.null(layout)) {
119 # Make the panel
120 # ncol: Number of columns of plots
121 # nrow: Number of rows needed, calculated from # of cols
122 layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
123 ncol = cols, nrow = ceiling(numPlots/cols))
124 }
125
126 if (numPlots==1) {
127 print(plots[[1]])
128
129 } else {
130 # Set up the page
131 grid.newpage()
132 pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
133
134 # Make each plot, in the correct location
135 for (i in 1:numPlots) {
136 # Get the i,j matrix positions of the regions that contain this subplot
137 matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
138
139 print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
140 layout.pos.col = matchidx$col))
141 }
142 }
143 }