R/changeEnum.R

In treeDbalance: Computation of 3D Tree Imbalance

#' Change the node enumeration of trees in phylo(3D) format
#'
#' \code{enum2depthwise} - Changes the enumeration of the nodes of a tree to
#' a depthwise (top-down) enumeration that complies with the phylo format's
#' requirements. \cr
#' The input tree must have its nodes enumerated with 1,...,|V|
#' (with |V| being the total number of nodes).
#' \code{enum2depthwise} changes the node enumeration s.t. it fulfills the
#' other enumeration requirements of the phylo format like:\cr
#' - leaves are enumerated with 1,...,n, (with n being the number of leaves)\cr
#' - the root has number n+1, \cr
#' - and the rule for inner nodes: descendants have higher numbers than
#' their ancestors. \cr
#' The edge enumeration and order remains untouched.
#' The function works for phylo as well as phylo3D objects and possible
#' extensions like 'node.ancs', 'node.descs', etc. remain intact.
#'
#' @param tree A rooted tree in (extended) phylo(3D) format
#' (no special node enumeration required, except that nodes are numbered
#' from 1 to |V| = the total number of nodes). There must be at least 2 nodes,
#' i.e. one edge.
#'
#' @author Sophie Kersting
#'
#' @return \code{enum2depthwise(tree)} Tree in (extended) phylo(3D) format as
#' before but with node enumeration conforming to the phylo format standard.
#' @export
#' @rdname changeEnum
#'
#' @examples
#' tree <- treeDbalance::example3Dtrees$bean21
#' # Visualize enumeration: plotPhylo3D(tree, show_node_enum = TRUE)
#' tree_depthwise <- enum2depthwise(tree)
#' # Visualize: addPhylo3D(tree_depthwise, offset=c(2,0,0), show_node_enum = TRUE)
enum2depthwise <- function(tree) {
  n <- length(tree$tip.label)
  m <- tree$Nnode
  if ((m + n - 1) != nrow(tree$edge)) {
    stop("The input must fulfill |V|-1=|E|=nrow(tree$edge) to be a tree.\n")
  }
  if (!identical(seq(1, (m + n)), as.integer(unique(sort(tree$edge))))) {
    stop(paste0(
      "Nodes are labeled with other values than 1,...,|V|.",
      "Please use enum2_1toV().\n"
    ))
  }
  if (sum(c("node.descs", "node.ancs", "node.depth") %in%
    attributes(tree)$names) < 3) {
    comment(paste(
      "This may take longer as at least one of the attributes,",
      "'node.descs', 'node.ancs' and 'node.depth' does not exist ",
      "and has to be calculated first."
    ))
  }
  if (!"node.descs" %in% attributes(tree)$names) {
    tree$node.descs <- getDescs(tree)
  }
  if (!"node.ancs" %in% attributes(tree)$names) {
    tree$node.ancs <- getAncs(tree)
  }
  if (!"node.depth" %in% attributes(tree)$names) {
    tree$node.depth <- getNodeDepths(tree)
  }
  # Create the new enumeration: the i-th position holds the new number of
  # the i-th node.
  new_enum <- rep(NA, n + m)
  internal_counter <- n + 1
  leaf_counter <- 1
  is_leaf <- getLeaves(tree)
  edge_depthw_order <- NULL
  # Go depthwise through the tree (top-down).
  for (i in tree$node.depth["orderByIncrDepth", ]) {
    edge_depthw_order <- c(
      edge_depthw_order,
      unname(tree$node.ancs["inc_edge", i])
    )
    if (is_leaf[i]) {
      new_enum[i] <- leaf_counter
      leaf_counter <- leaf_counter + 1
    } else { # is internal node
      new_enum[i] <- internal_counter
      internal_counter <- internal_counter + 1
    }
  }
  # Change the order of the edges.
  edge_depthw_order <- edge_depthw_order[-1] # Remove the NA (from the root).
  tree$edge <- tree$edge[edge_depthw_order, ]
  if (!is.null(attr(tree, "edges_of_zeroRadius"))) {
    attr(tree, "edges_of_zeroRadius") <- which(
      edge_depthw_order %in% attr(tree, "edges_of_zeroRadius")
    )
  }
  # If available, change the order of the edges in all other attributes.
  if ("edge.weight" %in% attributes(tree)$names) {
    tree$edge.weight <- tree$edge.weight[edge_depthw_order]
  }
  if ("edge.diam" %in% attributes(tree)$names) {
    tree$edge.diam <- tree$edge.diam[edge_depthw_order]
  }
  if ("edge.radius" %in% attributes(tree)$names) {
    tree$edge.radius <- tree$edge.radius[edge_depthw_order]
  }
  if ("edge.length" %in% attributes(tree)$names) {
    tree$edge.length <- tree$edge.length[edge_depthw_order]
  }
  if ("edge.type" %in% attributes(tree)$names) {
    tree$edge.type <- tree$edge.type[edge_depthw_order]
  }
  if ("edge.color" %in% attributes(tree)$names) {
    tree$edge.color <- tree$edge.color[edge_depthw_order]
  }
  if ("edge.is_original_cyl" %in% attributes(tree)$names) {
    tree$edge.is_original_cyl <- tree$edge.is_original_cyl[edge_depthw_order]
  }
  if ("edge.branch_order" %in% attributes(tree)$names) {
    tree$edge.branch_order <- tree$edge.branch_order[edge_depthw_order]
  }
  # Use the new enumeration to change the edge matrix.
  tree$edge <- matrix(new_enum[tree$edge], byrow = FALSE, ncol = 2)
  attr(tree, "order") <- "depthwise"
  # If available, change the order of the coordinates.
  if ("node.coord" %in% attributes(tree)$names) {
    tree$node.coord <- tree$node.coord[order(new_enum), ]
  }
  # Update format extensions.
  tree$node.descs <- getDescs(tree)
  tree$node.ancs <- getAncs(tree)
  tree$node.depth <- getNodeDepths(tree)
  return(tree)
}
#' Change the node enumeration of trees in phylo(3D) format
#'
#' \code{enum2cladewise} - Changes the enumeration of the nodes of a tree to
#' a cladewise enumeration (i.e. starting from the root we follow the rule:
#' Go to left child; if that doesn't exist or was already visited go to the
#' right child) that complies with the phylo format's
#' requirements.\cr
#' The input tree must have its nodes enumerated with 1,...,|V|
#' (with |V| being the total number of nodes).
#' \code{enum2depthwise} changes the node enumeration s.t. it fulfills the
#' other enumeration requirements of the phylo format like:\cr
#' - leaves are enumerated with 1,...,n, (with n being the number of leaves)\cr
#' - the root has number n+1, \cr
#' - and the rule for inner nodes: descendants have higher numbers than
#' their ancestors. \cr
#' The edge enumeration and order remains untouched.
#' The function works for phylo as well as phylo3D objects and possible
#' extensions like 'node.ancs', 'node.descs', etc. remain intact.
#'
#' @return \code{enum2cladewise(tree)} Tree in (extended) phylo(3D) format as
#' before but with node enumeration conforming to the phylo format standard.
#' @export
#' @rdname changeEnum
#'
#' @examples
#' tree_cladewise <- enum2cladewise(tree)
#' # Visualize: addPhylo3D(tree_cladewise, offset=c(4,0,0), show_node_enum = TRUE)
enum2cladewise <- function(tree) {
  n <- length(tree$tip.label)
  m <- tree$Nnode
  if ((m + n - 1) != nrow(tree$edge)) {
    stop("The input must fulfill |V|-1=|E|=nrow(tree$edge) to be a tree.\n")
  }
  if (!identical(seq(1, (m + n)), as.integer(unique(sort(tree$edge))))) {
    stop(paste0(
      "Nodes are labeled with other values than 1,...,|V|.",
      "Please use enum2_1toV().\n"
    ))
  }
  if (sum(c("node.descs", "node.ancs", "node.depth") %in%
    attributes(tree)$names) < 3) {
    comment(paste(
      "This may take longer as at least one of the attributes,",
      "'node.descs', 'node.ancs' and 'node.depth' does not exist ",
      "and has to be calculated first."
    ))
  }
  if (!"node.descs" %in% attributes(tree)$names) {
    tree$node.descs <- getDescs(tree)
  }
  if (!"node.ancs" %in% attributes(tree)$names) {
    tree$node.ancs <- getAncs(tree)
  }
  if (!"node.depth" %in% attributes(tree)$names) {
    tree$node.depth <- getNodeDepths(tree)
  }
  # Generate the cladewise order (with current enumeration).
  root <- tree$node.depth["orderByIncrDepth", ][1]
  cladew_nodes <- NULL
  node_stack <- root
  while (length(node_stack) > 0) {
    curr_node <- node_stack[1]
    cladew_nodes <- c(cladew_nodes, curr_node)
    curr_children <- getChildren(tree, curr_node, method = "onlyNodes")
    node_stack <- c(curr_children, node_stack[-1])
  }
  # Create the new enumeration: the i-th position holds the new number of
  # the i-th node.
  new_enum <- rep(NA, n + m)
  internal_counter <- n + 1
  leaf_counter <- 1
  is_leaf <- getLeaves(tree)
  edge_cladew_order <- NULL
  # Go depthwise through the tree (top-down).
  for (i in cladew_nodes) {
    edge_cladew_order <- c(
      edge_cladew_order,
      unname(tree$node.ancs["inc_edge", i])
    )
    if (is_leaf[i]) {
      new_enum[i] <- leaf_counter
      leaf_counter <- leaf_counter + 1
    } else { # is internal node
      new_enum[i] <- internal_counter
      internal_counter <- internal_counter + 1
    }
  }
  # Change the order of the edges.
  edge_cladew_order <- edge_cladew_order[-1] # Remove the NA (from the root).
  tree$edge <- tree$edge[edge_cladew_order, ]
  if (!is.null(attr(tree, "edges_of_zeroRadius"))) {
    attr(tree, "edges_of_zeroRadius") <- which(
      edge_cladew_order %in% attr(tree, "edges_of_zeroRadius")
    )
  }
  # If available, change the order of the edges in all other attributes.
  if ("edge.weight" %in% attributes(tree)$names) {
    tree$edge.weight <- tree$edge.weight[edge_cladew_order]
  }
  if ("edge.diam" %in% attributes(tree)$names) {
    tree$edge.diam <- tree$edge.diam[edge_cladew_order]
  }
  if ("edge.radius" %in% attributes(tree)$names) {
    tree$edge.radius <- tree$edge.radius[edge_cladew_order]
  }
  if ("edge.length" %in% attributes(tree)$names) {
    tree$edge.length <- tree$edge.length[edge_cladew_order]
  }
  if ("edge.type" %in% attributes(tree)$names) {
    tree$edge.type <- tree$edge.type[edge_cladew_order]
  }
  if ("edge.color" %in% attributes(tree)$names) {
    tree$edge.color <- tree$edge.color[edge_cladew_order]
  }
  if ("edge.is_original_cyl" %in% attributes(tree)$names) {
    tree$edge.is_original_cyl <- tree$edge.is_original_cyl[edge_cladew_order]
  }
  if ("edge.branch_order" %in% attributes(tree)$names) {
    tree$edge.branch_order <- tree$edge.branch_order[edge_cladew_order]
  }
  # Use the new enumeration to change the edge matrix.
  tree$edge <- matrix(new_enum[tree$edge], byrow = FALSE, ncol = 2)
  attr(tree, "order") <- "cladewise"
  # If available, change the order of the coordinates.
  if ("node.coord" %in% attributes(tree)$names) {
    tree$node.coord <- tree$node.coord[order(new_enum), ]
  }
  # Update format extensions.
  tree$node.descs <- getDescs(tree)
  tree$node.ancs <- getAncs(tree)
  tree$node.depth <- getNodeDepths(tree)
  return(tree)
}
#' Change the node enumeration of trees in phylo(3D) format
#'
#' \code{enum2_1toV} - Changes the enumeration of the nodes of a tree such that
#' they are enumerated with 1,...,|V| (with |V| being the total number of
#' nodes). Then \code{enum2cladewise} or \code{enum2depthwise} can be used to
#' switch to a specific enumeration. The edge enumeration and order remains
#' untouched.\cr
#' The input tree must have its nodes enumerated, i.e. the 'edge' attribute
#' must be a numeric matrix (with no missing values). Note that the attribute
#' 'node.coords' is allowed, but then the old node enumeration must point to
#' the correct coordinates. All other rows of the coordinate matrix will be
#' ignored and deleted.
#'
#' @param tree_bad_enum A rooted tree in a a rough phylo(3D) format
#' (no special node enumeration required). There must be at least 2 nodes,
#' i.e. one edge.
#'
#' @return \code{enum2_1toV(tree)} Tree in format as before but with nodes
#' enumerated from 1 to |V|.
#' @export
#' @rdname changeEnum
#'
#' @examples
#' bad_tree <- list(
#'   edge = matrix(c(1, 13, 1, -7, 13, 4), byrow = TRUE, ncol = 2),
#'   tip.label = c("", ""), Nnode = 2
#' )
#' better_tree <- enum2_1toV(bad_tree)
#' better_tree$edge
#' bad_3Dtree <- list(
#'   edge = matrix(c(1, 2, 1, 5, 2, 4), byrow = TRUE, ncol = 2),
#'   tip.label = c("", ""), Nnode = 2,
#'   node.coord = matrix(c(
#'     1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4,
#'     5, 5, 5, 6, 6, 6
#'   ), byrow = TRUE, ncol = 3),
#'   edge.weight = c(1, 1, 1)
#' )
#' better_3Dtree <- enum2_1toV(bad_3Dtree)
#' better_3Dtree$edge
#' better_3Dtree$node.coord
enum2_1toV <- function(tree_bad_enum) {
  n <- length(tree_bad_enum$tip.label)
  m <- tree_bad_enum$Nnode
  if (!is.numeric(tree_bad_enum$edge) || sum(is.na(tree_bad_enum$edge)) > 0) {
    stop("The edge matrix must be numeric without missing values.\n")
  }
  current_enums <- as.integer(unique(sort(tree_bad_enum$edge)))
  if (identical(seq(1, (m + n)), current_enums)) {
    comment("Nodes are already labeled with 1,...,|V|.\n")
    return(tree_bad_enum)
  }
  # As a simple new enumeration from 1 to |V|, assign each node the index at
  # which it appears in the current_enums vector.
  for (e in 1:nrow(tree_bad_enum$edge)) {
    tree_bad_enum$edge[e, 1] <- which(current_enums == tree_bad_enum$edge[e, 1])
    tree_bad_enum$edge[e, 2] <- which(current_enums == tree_bad_enum$edge[e, 2])
  }
  # If available, change the order of the coordinates and delete unused rows.
  if ("node.coord" %in% attributes(tree_bad_enum)$names) {
    tree_bad_enum$node.coord <- tree_bad_enum$node.coord[current_enums, ]
  }
  return(tree_bad_enum)
}