#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.