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