R/combineresult.R

In allenaigit/pathwayko: PathwayKO: An R package for knock-out pathway enrichment analysis

#' @title combining and formatting the individual PA results
#' @usage combineresult()
#' @description It yields _STATS.RData, summarizing and formatting the intermediate outputs such as true positive rates (TPR), true negative rates (TNR), false positive rates (FPR) and false negative rates (FNR), plus the Youden's best p-value threshold, sensitivity (TPR), specificity (TNR), accuracy, precision and recall.
#' @details This function takes "*_SUM.RData" generated by pathwayko, combines them
#'		into a single object which can be further analyzed or plotted. All "_SUM"
#' 		data should be analyzed by the same sets of PA methods, if not by identical
#' 		PA methods under identical parameters. (i.e. with same KEGG xmls, same criteria
#'		for choosing DE genes, etc)
#' @return TRUE when successful, FALSE otherwise
#' @export

combineresult<- function(){
	DataFiles <- NULL
	# Preprocessed .RData
	while(TRUE){
		cat("\nINFO: files in current working directory:\n")
		rdatalist <- list.files(path=getwd(),pattern="*SUM.RData",full.names=TRUE,recursive=TRUE,include.dirs=FALSE)
		show(rdatalist)
		input <- readline(prompt = "\nProcess all?: (Y/N) ")
		if(input=="Y"||input=="y"){
			if(length(rdatalist)>0){
				DataFiles <- lapply(rdatalist,function(X){
						dataEnv <- loadToEnvironment(X)
						if(length(ls(dataEnv))>1){
							stop("\nERROR: loaded more than one R object. Exit.\n")
						}
						DataObject <- get(ls(dataEnv),dataEnv)
						return(DataObject)
					})
				cat(paste0("\nINFO: successfully loaded ",length(DataFiles)," RData files.\n"))
				break
			}else{
				cat("\nWARNING: zero files found, try again.\n")
			}
		}else{
			readline(prompt = "\nINFO: Please make adjustments and hit any key to try again...\n")
		}
	}

	if(!checkMethods(DataFiles)){
		cat("\nERROR: at least one data file was run with different number of pathway analysis methods. Exit.\n")
		return(FALSE)
	}

	cat("\nINFO: combining results...\n")
	dataTables <- combineTables(DataFiles)
	saveResults(dataTables)
	cat("\nINFO: all process completed.\n")
	return(TRUE)
}

checkMethods <- function(DataFiles){
	any_methods <- DataFiles[[1]]$methods
	headers <- names(any_methods)

	checkRes <- 
		lapply(DataFiles,function(X,headers,any_methods){
			ret <- 
				lapply(headers,function(Y,a,b){
					return(a[[Y]]==b[[Y]])
				},a=any_methods,b=X$methods)
			ret <- all(unlist(ret))
			return(ret)
		},headers=headers,any_methods=any_methods)
	checkRes <- all(unlist(checkRes))
	return(checkRes)
}

combineTables <- function(DataFiles){
	AUC <- NULL
	parameters <- NULL
	pauc_se_ori <- NULL
	pauc_sp_ori <- NULL
	pauc_se_cor <- NULL
	pauc_sp_cor <- NULL
	titles <- list()
	methods <- gsub("^run_","",names(DataFiles[[1]]$methods))
	methods <- gsub("$","_RES",methods)
	for(i in 1:length(DataFiles)){
		AUC <- rbind(AUC,DataFiles[[i]]$ROC$AUC)
		parameters <- rbind(parameters, DataFiles[[i]]$ROC$stats1)
		pauc_sp_ori  <- rbind(pauc_sp_ori,DataFiles[[i]]$ROC$pauc_sp_ori)
		pauc_se_ori <- rbind(pauc_se_ori,DataFiles[[i]]$ROC$pauc_se_ori)
		pauc_sp_cor  <- rbind(pauc_sp_cor,DataFiles[[i]]$ROC$pauc_sp_cor)
		pauc_se_cor <- rbind(pauc_se_cor,DataFiles[[i]]$ROC$pauc_se_cor)
		titles <- c(titles,gsub("_$","",DataFiles[[i]]$filename_prefix))
	}
	titles <- unlist(titles)
	AUC <- asNumericTable(data.frame(AUC))
	parameters <- asNumericTable(data.frame(parameters))
	pauc_se_ori <- asNumericTable(data.frame(pauc_se_ori))
	pauc_se_cor <- asNumericTable(data.frame(pauc_se_cor))
	pauc_sp_ori <- asNumericTable(data.frame(pauc_sp_ori))
	pauc_sp_cor <- asNumericTable(data.frame(pauc_sp_cor))
	return(list(AUC=AUC,parameters=parameters,pauc_se_ori=pauc_se_ori,pauc_se_cor=pauc_se_cor,pauc_sp_ori=pauc_sp_ori,pauc_sp_cor=pauc_sp_cor,titles=titles,methods=methods))
}

asNumericTable <- function(table){
	ret <- data.frame(suppressWarnings(sapply(table,as.numeric)))
	rownames(ret) <- rownames(table)
	return(ret)
}

saveResults <- function(dataTables){
	output.dir <- "./combinedresults/"
	if(!dir.exists(output.dir)){
		dir.create(output.dir, showWarnings = TRUE, recursive = FALSE, mode = "0755")
	}
	write.csv(dataTables$AUC,file=paste0(output.dir,"Summary.AUC.csv"))
	write.csv(dataTables$parameters,file=paste0(output.dir,"Summary.parameters.csv"))
	write.csv(dataTables$pauc_se,file=paste0(output.dir,"Summary.pAUC_SE.csv"))
	write.csv(dataTables$pauc_sp,file=paste0(output.dir,"Summary.pAUC_SP.csv"))
	save(dataTables,file=paste0(output.dir,Sys.Date(),".STATS.RData"),compress="xz")
}