Mercurial > repos > melpetera > idchoice
comparison IDchoice/IDchoice_script.R @ 1:bb19b1d15732 draft default tip
Uploaded
author | melpetera |
---|---|
date | Thu, 19 Dec 2019 05:29:57 -0500 |
parents | b7a6a88f518a |
children |
comparison
equal
deleted
inserted
replaced
0:b7a6a88f518a | 1:bb19b1d15732 |
---|---|
2 # ID CHOICE # | 2 # ID CHOICE # |
3 # # | 3 # # |
4 # User: Galaxy # | 4 # User: Galaxy # |
5 # Starting date: 01-06-2017 # | 5 # Starting date: 01-06-2017 # |
6 # V-0.1: First version of code # | 6 # V-0.1: First version of code # |
7 # V-1.0: Code adjusted to user feedback # | |
7 # # | 8 # # |
8 # # | 9 # # |
9 # Input files: dataMatrix ; Metadata file # | 10 # Input files: dataMatrix ; Metadata file # |
10 # Output files: dataMatrix ; Metadata file # | 11 # Output files: dataMatrix ; Metadata file # |
11 # # | 12 # # |
44 | 45 |
45 # Table match check | 46 # Table match check |
46 table.check <- match2(DM,meta,metype) | 47 table.check <- match2(DM,meta,metype) |
47 check.err(table.check) | 48 check.err(table.check) |
48 | 49 |
50 # Keep metadata original order tracked ---------------------------------------- | |
51 | |
52 meta <- data.frame(meta,ori=1:nrow(meta)) | |
53 | |
49 | 54 |
50 # Checking unicity of new IDs ---------------------------------------- | 55 # Checking unicity of new IDs ---------------------------------------- |
51 | 56 |
52 numcol <- which(colnames(meta)==coloname) | 57 numcol <- which(colnames(meta)==coloname) |
53 if(length(numcol)==0) { | 58 if(length(numcol)==0) { |
65 paste(rownames(duptable),duptable,sep=": ",collapse="\n"),paste0("\nSince identifiers are meant to be unique, ", | 70 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")) | 71 "please check your data or use the 'Force unicity' option to force unicity.\n-------\n")) |
67 | 72 |
68 }else{ | 73 }else{ |
69 #Making unique names | 74 #Making unique names |
70 meta <- cbind(meta,newID=make.unique(meta[,numcol],sep="_"),ori=c(1:nrow(meta))) | 75 meta <- cbind(meta,newID=make.unique(meta[,numcol],sep="_")) |
71 } | 76 } |
72 }else{ | 77 }else{ |
73 #No unicity problem | 78 #No unicity problem |
74 meta <- cbind(meta,newID=meta[,numcol],ori=c(1:nrow(meta))) | 79 meta <- cbind(meta,newID=meta[,numcol]) |
75 } | 80 } |
76 | 81 |
77 | 82 |
78 # Merging tables ----------------------------------------------------- | 83 # Merging tables ----------------------------------------------------- |
79 | 84 |
90 comb.data <- comb.data[order(comb.data$ori),] | 95 comb.data <- comb.data[order(comb.data$ori),] |
91 | 96 |
92 | 97 |
93 # Changing IDs ------------------------------------------------------- | 98 # Changing IDs ------------------------------------------------------- |
94 | 99 |
95 DM <- comb.data[,-c(1:(ncol(meta)-2),ncol(meta))] | 100 DM <- comb.data[,-c(1:(ncol(meta)-1))] |
96 if(makeun=="no"){ | 101 if(makeun=="no"){ |
97 comb.data <- comb.data[,c(numcol,which(colnames(meta)!=coloname))] | 102 comb.data <- comb.data[,c(numcol,which(colnames(meta)!=coloname))] |
98 meta <- comb.data[,c(1:(ncol(meta)-2))] | 103 meta <- comb.data[,c(1:(ncol(meta)-2))] |
99 }else{ | 104 }else{ |
100 meta <- comb.data[,c(ncol(meta)-1,1:(ncol(meta)-2))] | 105 meta <- comb.data[,c(ncol(meta),1:(ncol(meta)-2))] |
101 } | 106 } |
102 | 107 |
103 #Transposing back the dataMatrix if necessary | 108 #Transposing back the dataMatrix if necessary |
104 if(metype=="sample"){ | 109 if(metype=="sample"){ |
105 rownames(DM) <- DM[,1] | 110 rownames(DM) <- DM[,1] |