r 找到Rowname重叠

Posted 2021-05-23

#' Title
#'
#' @param named.exprmat.list 
#' Rows = genes
#' @return
#' @export
#'
#' @examples
#' 
#' a <- gene.overlap(list("steidl"=expr.steidl, "steidl2"=expr.steidl, "steidl3"=expr.steidl[8:15, ], "steidl4"=expr.steidl[1:10, ]))
rn.overlap <- function(named.exprmat.list){
	if(is.null(names(named.exprmat.list)))
		warning("You should give names!")
	named.genelist <- lapply(named.exprmat.list, rownames)
	inmat <- matrix(0, nrow=length(named.genelist), ncol=length(named.genelist))
	colnames(inmat) <- names(named.genelist)
	rownames(inmat) <- names(named.genelist)
	
	genesetmat <- inmat
	
	name.listlist  <- rep(list(rep(list(NULL), length(named.genelist))), length(named.genelist))
	names(name.listlist) <- names(named.genelist)
	name.listlist <- lapply(name.listlist, function(x) {
		names(x) <- names(named.genelist)
		return(x)
		})
	
	
	genesets <- list()
	genesetcounter <- 1
	for(rowX in names(named.genelist)){
		for(colX in names(named.genelist)){
			name.listlist[[rowX]][[colX]] <- named.genelist[[rowX]][named.genelist[[rowX]] %in% named.genelist[[colX]]]
			# check if the name.listlist[[]][[]] is already in our genesets
			# if not, add it
			genelist.present <- unlist(lapply(genesets, function(x){
				all(name.listlist[[rowX]][[colX]] %in% x) && 
				all(x %in% name.listlist[[rowX]][[colX]] && 
				length(x)==length(name.listlist[[rowX]][[colX]]))
			} ))
			if(!any(genelist.present)){
				genesets[[genesetcounter]] <- name.listlist[[rowX]][[colX]]
				found.genelist <- genesetcounter
				genesetcounter <- genesetcounter + 1
			}else{
				found.genelist <- which(genelist.present)
			}
			genesetmat[rowX, colX] <- found.genelist
			inmat[rowX, colX] <- sum(named.genelist[[rowX]] %in% named.genelist[[colX]])
		}
	}
	
	total.overlap <- Reduce(intersect, genesets)
	return(list("N_rowINcol"=inmat, "overlapNameList_Row_Col"=name.listlist
				, "genesets"=genesets, "genesetmat"=genesetmat
				,"totalOverlap"=total.overlap))
}