R/editTree.R

In ethanmoyer/MethylConstruct:

#' Relabel node in probe-node matrix
#'
#' Relabel node label n_old with node label n_new in probe-node matrix.
#'
#' @param probe_node_matrix matrix storing the methylation status across all
#' probes and nodes on a tree
#' @param n_old node number
#' @param n_new node number
#' @return relabeled probe_node_matrix with node label n_old with node label
#' n_new
#' @examples
#' probe_node_matrix <- relabel_node_matrix(probe_node_matrix, 7, 10)
#' ... some visualization 
#' @export
relabel_node_matrix <- function(probe_node_matrix, n_old, n_new) {
	names(probe_node_matrix)[!is.na(match(names(probe_node_matrix), toString(n_old)))] = toString(n_new)

	return(probe_node_matrix)
}

# WORK ON THE BELOW FUNCTION

#' Relabel node on tree
#'
#' Relabel node label n_old with node label n_new on tree.
#'
#' @param tree ape::phylo tree
#' @param n_old node number
#' @param n_new node number
#'
#' @return relabeled tree with node label n_old with node label
#' n_new
#' @examples
#' tree <- relabel_tree(tree, 7, 10)
#' ... some visualization 
#' @export
relabel_tree <- function(tree, n_old, n_new) {
	tree$edge[tree$edge == n_old] = n_new

	return(tree)
}

#' Leaves of a tree 
#'
#' Given a tree, this function returns the leaves
#'
#' @param tree ape::phylo tree
#'
#' @return leafs on a given tree
#' @examples
#' leaves <- get_leaves(tree)
#' ... some visualization 
#' @export
get_leaves <- function(tree) {
	ancestors = tree$edge[, 1]
	descendants = tree$edge[, 2]

	leaves = descendants[!(descendants %in% ancestors)]
	return(leaves)
}

#' Number of leaves of a tree 
#'
#' Given a tree, this function returns the number of leaves on a tree.
#'
#' @param tree ape::phylo tree
#'
#' @return number of leafs of a given tree
#' @examples
#' number_of_leaves = nleaves(tree)
#' ... some visualization 
#' @export
nleaves <- function(tree) {
	return(length(get_leaves(tree)))
}

#' Total number of nodes on a tree {VALIDATED}
#'
#' Given a tree, this function returns the number of nodes on a tree.
#'
#' @param tree ape::phylo tree
#'
#' @return number of nodes on a tree
#' @examples
#' number_of_nodes = nnodes(tree)
#' ... some visualization 
#' @export
nnodes <- function(tree) {
	return(nrow(tree$edge))
}

#' Number of internal nodes on a tree {VALIDATED}
#'
#' Given a tree, this function returns the number of internal nodes on tree.
#'
#' @param tree ape::phylo tree
#'
#' @return number of internal nodes on a given tree
#' @examples
#' number_of_internal_nodes = ninternal_nodes(tree)
#' ... some visualization 
#' @export
ninternal_nodes <- function(tree) {
	return(nrow(tree$edge) - nleaves(tree))
}

#' Grow a tree at a given leaf node 
#'
#' Add a pair of leaves branching off of the given leaf node for the tree. 
#' Asigns the two newly added leaves labels from node_names the old leaf where 
#' the two branches were add as an internal node.
#' 
#' @param tree ape::phylo tree
#' @param leaf node number
#' @param node_names list of two node names
#'
#' @return new tree topology--two branches added to given leaf and labeled 
#' accordingly
#' @examples
#' tree <- grow_off_leaf(tree, 1, c('Fibroblasts', 'Fibrocytes'))
#' ... some visualization 
#' @export
grow_off_leaf <- function(tree, leaf, node_names) {
	if (!(node %in% get_leaves(tree))) {
		print('Please provide a leaf as the node to which the branches will be added')
		return(tree)
	}

	max_leaf = max(tree$edge)

	tree$edge = rbind(tree$edge, c(node, max_leaf + 1), c(node, max_leaf + 2))

	tree$Nnode = tree$Nnode + 1

	tree$tip.label[number_of_get_leaves(tree)] = node_names[1]
	tree$tip.label[number_of_get_leaves(tree) + 1] = node_names[2]

	tree$tip.label = tree$tip.label[-node]

	return(tree)
}

#' Add to probe-node matrix at a new node
#'
#' At a given node, this function adds data to the probe-node matrix at node 
#' n_new. Make sure that the sizes of data and the probe-node matrix are 
#' compatible before calling this function.
#' 
#' @param probe_node_matrix matrix storing the methylation status across all
#' probes and nodes on a tree
#' @param n_new node number
#' @param data column matrix of methylation status for a node across many 
#' probes
#'
#' @return probe-node matrix with data stored at node n_new
#' @examples
#' tree <- add_data(probe_node_matrix, 12, probe_node_matrix['6'])
#' ... some visualization 
#' @export
add_data <- function(probe_node_matrix, n_new., data) {
	probe_node_matrix[toString(node0)] = data
	return(probe_node_matrix)
}

#' Root of a tree {VALIDATED}
#'
#' Returns the root of a tree structure.
#' 
#' @param tree ape::phylo tree
#'
#' @return node corresponding the the root of the tree
#' @examples
#' root <- get_root(tree)
#' ... some visualization 
#' @export
get_root <- function(tree) {
	ancestor = tree$edge[, 1]
	descendant = tree$edge[, 2]

	root = ancestor[!(ancestor %in% descendant)]

	return(unique(root))
}

#' Node matrix used for tree walking {VALIDATED}
#'
#' Returns a matrix which tracks where recursive functions are in a tree 
#' structure. This is past to most recursive functions in the pipeline.
#' 
#' @param tree ape::phylo tree
#'
#' @return node matrix with one column for ancestors and another for 
#' descendants
#' @examples
#' node_matrix <- create_node_matrix(tree)
#' ... some visualization 
#' @export
create_node_matrix <- function(tree) {
	node_matrix = data.frame(ancestor=integer(), descendents=integer())

	node_matrix[1, ] = c(0, get_root(tree))

	return(node_matrix)
}


#' Recursively walk through tree and remove descendants.
#'
#' This function will recursively walk through a given tree and remove all of 
#' node n's descendants, making node n a new leaf.
#' 
#' @param node node number
#' @param root root of non-proper subtree
#' @param node_matrix matrix obtained from create_node_matrix function
#' @param i row in node matrix, start at 1
#'
#' @return None
#' @examples
#' cut_tree(node, get_root(tree), node_matrix, 1)
#' ... some visualization 
#' @export
cut_tree <- function(node, root, node_matrix, i) {
	tree_edge = tree$edge

	ancestor = tree_edge[, 1]
	descendant = tree_edge[, 2]

  	paths = descendant[ancestor == root]

  	daughter_node = paths[1]
 	son_node = paths[2]

 	if (root %in% get_leaves(tree)) {
 		if (node %in% node_matrix[, 1]) {

  			remove_nodes = node_matrix[which(node == node_matrix[,1]):nrow(node_matrix), ]

  			for (i in 1:nrow(remove_nodes)) {
  				tree$edge <<- tree$edge[-match(remove_nodes[i, ], tree$edge)[1], ]
  				tree$tip.label <<- tree$tip.label(-root)
  				probe_list <<-probe_list[-match(toString(root), names(probe_list))]
  			}
  		}
 	} else {
	    if (length(daughter_node) != 0) {

		    node_matrix[i + 1, ] = tree_edge[ancestor == root, ][1, ]

	      	cut_tree(node, daughter_node, node_matrix, i + 1)
	    }

		if (length(son_node) != 0) {

		    node_matrix[i + 1, ] = tree_edge[ancestor == root, ][2, ]

		    cut_tree(node, son_node, node_matrix, i + 1)	 
	  	}
 	}
}

#' Cut tree at specified node
#'
#' Given a tree and a selected node, this function removes the branches 
#' stemming off of that node, thus making that node a leaf. It returns this 
#' altered tree. 
#' 
#' @param tree ape::phylo tree
#' @param node node number
#'
#' @return new tree topology--node is now a leaf and all of node's descendants 
#' are removed.
#' @examples
#' tree <- remove_branches_from_node(tree, node)
#' ... some visualization 
#' @export
remove_branches_from_node <- function(tree, node) {
	# Creates node matrix
	node_matrix = create_node_matrix(tree)

	# Runs recursive function to cut tree off at node, thus making node a new leaf
	cut_tree(node, get_root(tree), node_matrix, 1)

	return(tree)
}