|
0
|
1 ################################################################################################
|
|
|
2 # ID CHOICE #
|
|
|
3 # #
|
|
|
4 # User: Galaxy #
|
|
|
5 # Starting date: 01-06-2017 #
|
|
|
6 # V-0.1: First version of code #
|
|
1
|
7 # V-1.0: Code adjusted to user feedback #
|
|
0
|
8 # #
|
|
|
9 # #
|
|
|
10 # Input files: dataMatrix ; Metadata file #
|
|
|
11 # Output files: dataMatrix ; Metadata file #
|
|
|
12 # #
|
|
|
13 # Dependencies: RcheckLibrary.R ; miniTools.R (easyRlibrary) #
|
|
|
14 # #
|
|
|
15 ################################################################################################
|
|
|
16
|
|
|
17 # Parameters (for dev)
|
|
|
18 if(FALSE){
|
|
|
19 DM.name <- "CaracSpe_dataMatrix.txt"
|
|
|
20 meta.name <- "CaracSpe_variableMetadata.txt"
|
|
|
21 metype <- "variable"
|
|
|
22 #coloname <- "namecustom"
|
|
|
23 coloname <- "B"
|
|
|
24 makeun <- "yes"
|
|
|
25 DMout <- "ID_DM.txt"
|
|
|
26 metaout <- paste0("ID_",metype,"meta.txt")
|
|
|
27 }
|
|
|
28
|
|
|
29
|
|
|
30 id.choice <- function(DM.name,meta.name,metype,coloname,makeun,DMout,metaout){
|
|
|
31 # This function allows to replace original IDs with other ones from one metadata table.
|
|
|
32 #
|
|
|
33 # Parameters:
|
|
|
34 # - DM.name, meta.name: dataMatrix and metadata files' access respectively
|
|
|
35 # - metype: "sample" or "variable" depending on metadata content
|
|
|
36 # - coloname: name of the metadata column to be used as new ID
|
|
|
37 # - makeun: "yes" or "no" depending on user choice if new IDs are not unique ("yes"=conversion to unique ID)
|
|
|
38 # - DMout, metaout: output files' access
|
|
|
39
|
|
|
40
|
|
|
41 # Input --------------------------------------------------------------
|
|
|
42
|
|
|
43 DM <- read.table(DM.name,header=TRUE,sep="\t",check.names=FALSE)
|
|
|
44 meta <- read.table(meta.name,header=TRUE,sep="\t",check.names=FALSE,colClasses="character")
|
|
|
45
|
|
|
46 # Table match check
|
|
|
47 table.check <- match2(DM,meta,metype)
|
|
|
48 check.err(table.check)
|
|
|
49
|
|
1
|
50 # Keep metadata original order tracked ----------------------------------------
|
|
|
51
|
|
|
52 meta <- data.frame(meta,ori=1:nrow(meta))
|
|
|
53
|
|
0
|
54
|
|
|
55 # Checking unicity of new IDs ----------------------------------------
|
|
|
56
|
|
|
57 numcol <- which(colnames(meta)==coloname)
|
|
|
58 if(length(numcol)==0) {
|
|
|
59 stop(paste0("\n-------\nWarning: no '",coloname,"' column detected in ",metype," metadata!",
|
|
|
60 "\nPlease check your metadata file (column names are case-sensitive).\n-------\n"))
|
|
|
61 }
|
|
|
62
|
|
|
63 unicity <- duplicated(meta[,numcol])
|
|
|
64
|
|
|
65 if(sum(unicity)>0){
|
|
|
66 if(makeun=="no"){
|
|
|
67 #Sending back an explicit error
|
|
|
68 duptable <- t(t(table(meta[,numcol][unicity])+1))
|
|
|
69 stop(paste0("\n-------\nYour '",coloname,"' column contains duplicates:\n"),
|
|
|
70 paste(rownames(duptable),duptable,sep=": ",collapse="\n"),paste0("\nSince identifiers are meant to be unique, ",
|
|
|
71 "please check your data or use the 'Force unicity' option to force unicity.\n-------\n"))
|
|
|
72
|
|
|
73 }else{
|
|
|
74 #Making unique names
|
|
1
|
75 meta <- cbind(meta,newID=make.unique(meta[,numcol],sep="_"))
|
|
0
|
76 }
|
|
|
77 }else{
|
|
|
78 #No unicity problem
|
|
1
|
79 meta <- cbind(meta,newID=meta[,numcol])
|
|
0
|
80 }
|
|
|
81
|
|
|
82
|
|
|
83 # Merging tables -----------------------------------------------------
|
|
|
84
|
|
|
85 #Transposing the dataMatrix if necessary
|
|
|
86 if(metype=="sample"){
|
|
|
87 rownames(DM) <- DM[,1]
|
|
|
88 DM <- DM[,-1]
|
|
|
89 DM <- t(DM)
|
|
|
90 DM <- data.frame(sample=row.names(DM),DM,check.names=FALSE)
|
|
|
91 rownames(DM) <- NULL
|
|
|
92 }
|
|
|
93
|
|
|
94 comb.data <- merge(x=meta,y=DM,by.x=1,by.y=1)
|
|
|
95 comb.data <- comb.data[order(comb.data$ori),]
|
|
|
96
|
|
|
97
|
|
|
98 # Changing IDs -------------------------------------------------------
|
|
|
99
|
|
1
|
100 DM <- comb.data[,-c(1:(ncol(meta)-1))]
|
|
0
|
101 if(makeun=="no"){
|
|
|
102 comb.data <- comb.data[,c(numcol,which(colnames(meta)!=coloname))]
|
|
|
103 meta <- comb.data[,c(1:(ncol(meta)-2))]
|
|
|
104 }else{
|
|
1
|
105 meta <- comb.data[,c(ncol(meta),1:(ncol(meta)-2))]
|
|
0
|
106 }
|
|
|
107
|
|
|
108 #Transposing back the dataMatrix if necessary
|
|
|
109 if(metype=="sample"){
|
|
|
110 rownames(DM) <- DM[,1]
|
|
|
111 DM <- DM[,-1]
|
|
|
112 DM <- t(DM)
|
|
|
113 DM <- data.frame(sample=row.names(DM),DM,check.names=FALSE)
|
|
|
114 rownames(DM) <- NULL
|
|
|
115 }
|
|
|
116
|
|
|
117
|
|
|
118 # Output -------------------------------------------------------------
|
|
|
119
|
|
|
120 # Writing the table
|
|
|
121 write.table(DM,DMout,sep="\t",quote=FALSE,row.names=FALSE)
|
|
|
122 write.table(meta,metaout,sep="\t",quote=FALSE,row.names=FALSE)
|
|
|
123
|
|
|
124
|
|
|
125 } # End of id.choice
|
|
|
126
|
|
|
127
|
|
|
128 # Typical function call
|
|
|
129 # id.choice(DM.name,meta.name,metype,coloname,makeun,DMout,metaout)
|
