annotate IDchoice/IDchoice_script.R @ 1:bb19b1d15732 draft default tip

Uploaded

################################################################################################
# ID CHOICE                                                                                    #
#                                                                                              #
# User: Galaxy                                                                                 #
# Starting date: 01-06-2017                                                                    #
# V-0.1: First version of code                                                                 #
# V-1.0: Code adjusted to user feedback                                                        #
#                                                                                              #
#                                                                                              #
# Input files: dataMatrix ; Metadata file                                                      #
# Output files: dataMatrix ; Metadata file                                                     #
#                                                                                              #
# Dependencies: RcheckLibrary.R ; miniTools.R  (easyRlibrary)                                  #
#                                                                                              #
################################################################################################

# Parameters (for dev)
if(FALSE){
  DM.name <- "CaracSpe_dataMatrix.txt"
  meta.name <- "CaracSpe_variableMetadata.txt"
  metype <- "variable"
  #coloname <- "namecustom"
  coloname <- "B"
  makeun <- "yes"
  DMout <- "ID_DM.txt"
  metaout <- paste0("ID_",metype,"meta.txt")
}


id.choice <- function(DM.name,meta.name,metype,coloname,makeun,DMout,metaout){
  # This function allows to replace original IDs with other ones from one metadata table.
  #
  # Parameters:
  # - DM.name, meta.name: dataMatrix and metadata files' access respectively
  # - metype: "sample" or "variable" depending on metadata content
  # - coloname: name of the metadata column to be used as new ID
  # - makeun: "yes" or "no" depending on user choice if new IDs are not unique ("yes"=conversion to unique ID)
  # - DMout, metaout: output files' access
  
  
# Input --------------------------------------------------------------

DM <- read.table(DM.name,header=TRUE,sep="\t",check.names=FALSE)
meta <- read.table(meta.name,header=TRUE,sep="\t",check.names=FALSE,colClasses="character")

# Table match check 
table.check <- match2(DM,meta,metype)
check.err(table.check)

# Keep metadata original order tracked ----------------------------------------

meta <- data.frame(meta,ori=1:nrow(meta))


# Checking unicity of new IDs ----------------------------------------

numcol <- which(colnames(meta)==coloname)
if(length(numcol)==0) {
      stop(paste0("\n-------\nWarning: no '",coloname,"' column detected in ",metype," metadata!",
                  "\nPlease check your metadata file (column names are case-sensitive).\n-------\n")) 
}

unicity <- duplicated(meta[,numcol])

if(sum(unicity)>0){
  if(makeun=="no"){
    #Sending back an explicit error
	duptable <- t(t(table(meta[,numcol][unicity])+1))
	stop(paste0("\n-------\nYour '",coloname,"' column contains duplicates:\n"),
		paste(rownames(duptable),duptable,sep=": ",collapse="\n"),paste0("\nSince identifiers are meant to be unique, ",
		"please check your data or use the 'Force unicity' option to force unicity.\n-------\n"))
	
  }else{
    #Making unique names
	meta <- cbind(meta,newID=make.unique(meta[,numcol],sep="_"))
  }
}else{
  #No unicity problem
  meta <- cbind(meta,newID=meta[,numcol])
}


# Merging tables -----------------------------------------------------

#Transposing the dataMatrix if necessary
if(metype=="sample"){
  rownames(DM) <- DM[,1]
  DM <- DM[,-1]
  DM <- t(DM)
  DM <- data.frame(sample=row.names(DM),DM,check.names=FALSE)
  rownames(DM) <- NULL
}

comb.data <- merge(x=meta,y=DM,by.x=1,by.y=1)
comb.data <- comb.data[order(comb.data$ori),]


# Changing IDs -------------------------------------------------------

DM <- comb.data[,-c(1:(ncol(meta)-1))]
if(makeun=="no"){
  comb.data <- comb.data[,c(numcol,which(colnames(meta)!=coloname))]
  meta <- comb.data[,c(1:(ncol(meta)-2))]
}else{
  meta <- comb.data[,c(ncol(meta),1:(ncol(meta)-2))]
}

#Transposing back the dataMatrix if necessary
if(metype=="sample"){
  rownames(DM) <- DM[,1]
  DM <- DM[,-1]
  DM <- t(DM)
  DM <- data.frame(sample=row.names(DM),DM,check.names=FALSE)
  rownames(DM) <- NULL
}


# Output -------------------------------------------------------------

# Writing the table
write.table(DM,DMout,sep="\t",quote=FALSE,row.names=FALSE)
write.table(meta,metaout,sep="\t",quote=FALSE,row.names=FALSE)


} # End of id.choice


# Typical function call
# id.choice(DM.name,meta.name,metype,coloname,makeun,DMout,metaout)