Mercurial > repos > melpetera > idchoice

comparison IDchoice/IDchoice_script.R @ 0:b7a6a88f518a draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author melpetera
date Thu, 11 Oct 2018 05:47:29 -0400
parents
children bb19b1d15732
comparison
equal deleted inserted replaced
-1:000000000000 0:b7a6a88f518a
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)