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] |