Mercurial > repos > melpetera > batchcorrection
comparison batchcorrection-57edfd3943ab/easyrlibrary-lib/miniTools.R @ 3:73892ef177e3 draft
Uploaded
author | melpetera |
---|---|
date | Tue, 02 May 2017 09:47:22 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
2:016780b192a6 | 3:73892ef177e3 |
---|---|
1 ##################################################### | |
2 # Mini tools for Galaxy scripting | |
3 # Coded by: M.Petera, | |
4 # - - | |
5 # R functions to use in R scripts and wrappers | |
6 # to make things easier (lightening code, reducing verbose...) | |
7 # - - | |
8 # V0: script structure + first functions | |
9 # V1: addition of functions to handle special characters in identifiers | |
10 ##################################################### | |
11 | |
12 | |
13 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
14 # Function to call packages without printing all the verbose | |
15 # (only getting the essentials, like warning messages for example) | |
16 | |
17 shyLib <- function(...){ | |
18 for(i in 1:length(list(...))){ | |
19 suppressPackageStartupMessages(library(list(...)[[i]],character.only=TRUE)) | |
20 } | |
21 } | |
22 | |
23 #example: shyLib("xcms","pcaMethods") | |
24 | |
25 | |
26 | |
27 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
28 # Fonction pour sourcer les scripts R requis | |
29 # /!\ ATTENTION : actuellement la fonction n'est pas chargee au lancement du script, | |
30 # il faut donc la copier-coller dans le wrapper R pour pouvoir l'utiliser. | |
31 | |
32 if(FALSE){ | |
33 source_local <- function(...){ | |
34 argv <- commandArgs(trailingOnly = FALSE) | |
35 base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)) | |
36 for(i in 1:length(list(...))){ | |
37 source(paste(base_dir, list(...)[[i]], sep="/")) | |
38 } | |
39 } | |
40 } | |
41 | |
42 #example: source_local("filter_script.R","RcheckLibrary.R") | |
43 | |
44 | |
45 | |
46 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
47 # Functions to stock identifiers before applying make.names() and | |
48 # to reinject it into final matrices | |
49 # Note: it reproduces the original order of datasets' identifiers | |
50 # - - - | |
51 # stockID: stocks original identifiers and original order | |
52 # -> needs checked data regarding table match | |
53 # reproduceID: reinjects original identifiers and original order into final tables | |
54 # -> function to be used at the very end, when exporting tables | |
55 | |
56 stockID <- function(dataMatrix, Metadata, Mtype){ | |
57 # dataMatrix = data.frame containing dataMatrix | |
58 # Metadata = data.frame containing sampleMetadata or variableMetadata | |
59 # Mtype = "sample" or "variable" depending on Metadata content | |
60 cname <- colnames(dataMatrix)[1] | |
61 # dataMatrix temporary-stock + transfo - - - - | |
62 if(Mtype=="sample"){ | |
63 id.ori <- colnames(dataMatrix)[-1] | |
64 colnames(dataMatrix) <- make.names(colnames(dataMatrix)) | |
65 } | |
66 if(Mtype=="variable"){ | |
67 id.ori <- dataMatrix[,1] | |
68 dataMatrix[,1] <- make.names(dataMatrix[,1]) | |
69 } | |
70 # global stock - - - - - - - - - - - - - - - - | |
71 id.new <- data.frame(order.ori=c(1:length(Metadata[,1])),Metadata[,1], | |
72 id.new=make.names(Metadata[,1]),id.ori, | |
73 id.new.DM=make.names(id.ori),stringsAsFactors=FALSE) | |
74 colnames(id.new)[c(2,4)] <- c(colnames(Metadata)[1],cname) | |
75 # Metadata transfo + returning data - - - - - | |
76 Metadata[,1] <- make.names(Metadata[,1]) | |
77 return(list(id.match=id.new, dataMatrix=dataMatrix, Metadata=Metadata)) | |
78 } | |
79 #example: A<-stockID(myDM,mysM,"sample") ; myDM<-A$dataMatrix ; mysM<-A$Metadata ; A<-A$id.match | |
80 | |
81 reproduceID <- function(dataMatrix, Metadata, Mtype, id.match){ | |
82 # dataMatrix = data.frame containing dataMatrix | |
83 # Metadata = data.frame containing sampleMetadata or variableMetadata | |
84 # Mtype = "sample" or "variable" depending on Metadata content | |
85 # id.match = 'id.match' element produced by stockID | |
86 #Metadada - - - - - - - - - - - - - - | |
87 temp.table <- id.match[,c(1,2,3)] | |
88 ## Removing deleted rows | |
89 for(i in 1:(dim(id.match)[1])){ | |
90 if(!(temp.table[i,3]%in%Metadata[,1])){temp.table[i,1] <- 0} | |
91 } | |
92 if(length(which(temp.table[,1]==0))!=0){ | |
93 temp.table <- temp.table[-c(which(temp.table[,1]==0)),] | |
94 } | |
95 ## Restoring original identifiers and order | |
96 temp.table <- merge(x=temp.table,y=Metadata,by.x=3,by.y=1) | |
97 temp.table <- temp.table[order(temp.table$order.ori),] | |
98 Metadata <- temp.table[,-c(1,2)] | |
99 rownames(Metadata) <- NULL | |
100 #dataMatrix - - - - - - - - - - - - - | |
101 rownames(dataMatrix)<-dataMatrix[,1] | |
102 if(Mtype=="sample"){ | |
103 dataMatrix <- t(dataMatrix[,-1]) | |
104 } | |
105 temp.table <- id.match[,c(1,4,5)] | |
106 ## Removing deleted rows | |
107 for(i in 1:(dim(id.match)[1])){ | |
108 if(!(temp.table[i,3]%in%rownames(dataMatrix))){temp.table[i,1] <- 0} | |
109 } | |
110 if(length(which(temp.table[,1]==0))!=0){ | |
111 temp.table <- temp.table[-c(which(temp.table[,1]==0)),] | |
112 } | |
113 ## Restoring original identifiers and order | |
114 temp.table <- merge(x=temp.table,y=dataMatrix,by.x=3,by.y=0) | |
115 temp.table <- temp.table[order(temp.table$order.ori),] | |
116 if(Mtype=="variable"){ | |
117 dataMatrix <- temp.table[,-c(1,2,4)] | |
118 colnames(dataMatrix)[1] <- colnames(id.match)[4] | |
119 } else { | |
120 rownames(temp.table) <- temp.table[,3] | |
121 temp.table <- t(temp.table[,-c(1,2,3)]) | |
122 dataMatrix <- data.frame(rownames(temp.table),temp.table) | |
123 colnames(dataMatrix)[1] <- colnames(id.match)[4] | |
124 } | |
125 rownames(dataMatrix) <- NULL | |
126 # return datasets - - - - - - - - - - - | |
127 return(list(dataMatrix=dataMatrix, Metadata=Metadata)) | |
128 } | |
129 #example: B<-reproduceID(myDM,mysM,"sample",A) ; myDM<-B$dataMatrix ; mysM<-B$Metadata | |
130 | |
131 | |
132 | |
133 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |