R/trim_tree_adaptive_top_down.R

In YuanlongLiu/CALDER: What the package does (short line)

	trim_tree_adaptive_top_down <- function( tree, L_diff_thresh=-Inf, max_imp_p=Inf, max_nimp_p=Inf, width_thresh=-Inf )
	{
		E(tree)$name = paste0('edge_name_', 1:ecount(tree))
		nsig_nodes = which(V(tree)$imp_p > max_imp_p)
		edges2rm = unlist(lapply(nsig_nodes, function(node) E(tree)[.from(V(tree)[node])]$name))
		trimmed_tree = delete_edges(tree, edges2rm)
		comps = decompose(trimmed_tree)
		root_index = which(sapply( comps, function(comp) V(tree)[1]$name %in% V(comp)$name )==1)
		trimmed_tree = comps[[root_index]]
		if(!is_binary_tree( trimmed_tree )) stop("trim_tree_adaptive_top_down, the resulted tree is not a binary tree")
		return( trimmed_tree )
	}
	
	## remove twins of a node if a node is not significant (no sub-TADs within)
	trim_tree_adaptive_top_down_v2 <- function( tree, wilcox_p_thresh )
	{
		# leaves = get_leaves(tree)
		if(vcount(tree)==1) return(tree)
		nsig_nodes = V(tree)[which(V(tree)$wilcox_p > wilcox_p_thresh)]$name
		children_of_nsig = names(unlist(ego(tree, order=1, node=nsig_nodes, mode='out', mindist=1)))
		if(length(children_of_nsig)!=0) trimmed_tree = tree - children_of_nsig
		if(length(children_of_nsig)==0) trimmed_tree = tree

		comps = decompose(trimmed_tree)
		root_index = which(sapply( comps, function(comp) V(tree)[1]$name %in% V(comp)$name )==1)
		trimmed_tree = comps[[root_index]]
		if(!is_binary_tree( trimmed_tree )) stop("trim_tree_adaptive_top_down, the resulted tree is not a binary tree")
		return( trimmed_tree )
	}