R/phylo3D-methods.R

In treeDbalance: Computation of 3D Tree Imbalance

#' Print, summary and plot methods for phylo3D objects
#'
#' \code{print.phylo3D} prints the contents of an object of class \code{phylo3D}.
#' It provides a brief summary of the object structure and its contents.
#'
#' @param x An object of class \code{phylo3D}, which is a list containing
#' several mandatory and optional elements.
#' @param ... Additional arguments passed to the \code{print}, \code{summary},
#' or \code{plot} function.
#'
#' @return \code{print.phylo3D} The input \code{phylo3D} object, returned
#' invisibly. Called primarily for its side effect of printing a
#' human-readable summary to the console.
#'
#' @rdname phylo3D-printsummaryplot
#' @export
#'
#' @examples
#' # Printing a 'phylo3D' object:
#' tree <- treeDbalance::extendPhylo(treeDbalance::example3Dtrees$bean09)
#' tree # same as print(tree)
print.phylo3D <- function(x, ...) {
  if (!inherits(x, "phylo3D")) {
    stop("Not an object of class 'phylo3D'")
  }

  cat("An object of class 'phylo3D'.\n")
  cat(sprintf(
    "Contains %d leaves/tips, %d internal nodes, and %d edges/branches.\n",
    length(x$tip.label), x$Nnode, length(x$edge.diam)
  ))
  cat("Coordinate ranges:\n")
  coords_range <- apply(x$node.coord, 2, range)
  colnames(coords_range) <- c("X", "Y", "Z")
  print(coords_range)

  if (!is.null(attr(x, "edges_of_zero_weight"))) {
    cat(sprintf(
      "\nThe following edges have zero radius: %s\n",
      paste(attr(x, "edges_of_zero_weight"), collapse = ", ")
    ))
  }
  if (!is.null(attr(x, "order"))) {
    cat(sprintf("Node and edge order: %s\n", attr(x, "order")))
  }
  if (!is.null(attr(x, "DBH"))) {
    cat(sprintf("DBH: %s\n", round(attr(x, "DBH"),4)))
  }

  # Show a snippet of edges.
  ed <- cbind(utils::head(x$edge, 5), utils::head(x$edge.weight, 5))
  colnames(ed) <- c("Parent", "Child", "Weight")
  cat("\nFirst 5 edges:\n")
  print(ed)
  # Show a snippet of coordinates.
  nc <- utils::head(x$node.coord, 5)
  colnames(nc) <- c("X", "Y", "Z")
  cat("\nFirst 5 node coordinates:\n")
  print(nc)

  invisible(x)
}
#' Print, summary and plot methods for phylo3D objects
#'
#' \code{plot.phylo3D} creates a 2D projection plot of a \code{phylo3D} object,
#' using the X and Z coordinates of each node. Each edge is drawn as a line
#' segment between parent and child nodes.\cr
#' For more elaborate 3D visualizations use \code{plotPhylo3D()} or
#' \code{addPhylo3D()}, \code{plotImbalPhylo3D()} or
#' \code{addImbalPhylo3D()}, or \code{sketchPhylo3D()}.
#'
#' @param x An object of class \code{phylo3D}.
#' @param edge_col Color for the edges (default "black").
#' @param edge_lwd_scale Scaling factor (default 1) for line width for the
#' edges.
#' @param show_leaf_label Logical (default FALSE), specifying if tip labels
#' should be depicted.
#' @param ... Additional arguments passed to \code{plot()}.
#'
#' @return The input \code{phylo3D} object, returned invisibly. This function is
#' called for its side effect of displaying a plot.
#'
#' @rdname phylo3D-printsummaryplot
#' @export
#'
#' @examples
#' # Simple plot of a 'phylo3D' object:
#' plot(tree, edge_col = "blue", show_leaf_label = TRUE)
plot.phylo3D <- function(x, edge_col = "black", edge_lwd_scale = 1,
                         show_leaf_label = FALSE, ...) {
  if (!inherits(x, "phylo3D")) {
    stop("Not an object of class 'phylo3D'")
  }

  coords <- x$node.coord[, c(1, 3), drop = FALSE] # Use X and Z
  # Set up plot limits.
  xlim <- range(coords[, 1], na.rm = TRUE)
  zlim <- range(coords[, 2], na.rm = TRUE)
  plot(
    NA,
    xlim = xlim, ylim = zlim,
    xlab = "X", ylab = "Z", type = "n", asp = 1, ...
  )

  if ("edge.diam" %in% attributes(x)$names) {
    edge_lwds <- x$edge.diam / 2
  } else if ("edge.weight" %in% attributes(x)$names &&
    "edge.length" %in% attributes(x)$names) {
    edge_lwds <- sqrt(x$edge.weight / x$edge.length / pi)
  } else {
    edge_lwds <- rep(1, nrow(x$edge))
  }
  # Draw edges.
  for (i in 1:nrow(x$edge)) {
    parent <- x$edge[i, 1]
    child <- x$edge[i, 2]
    graphics::segments(
      x0 = coords[parent, 1], y0 = coords[parent, 2],
      x1 = coords[child, 1], y1 = coords[child, 2],
      col = edge_col, lwd = edge_lwd_scale * edge_lwds[i]
    )
  }

  # Optionally draw tip numbers.
  if (show_leaf_label) {
    leaf_numbers <- which(getLeaves(x))
    if (!setequal(leaf_numbers, seq_along(x$tip.label))) {
      warning("The leaf numbers do not match the expected 1:n.")
    }
    graphics::text(
      coords[leaf_numbers, 1], coords[leaf_numbers, 2],
      labels = x$tip.label, pos = 4, cex = 0.7
    )
  }

  invisible(x)
}
#' Print, summary and plot methods for phylo3D objects
#'
#' \code{summary.phylo3D} provides a summary of an object of class
#' \code{phylo3D}. It offers a high-level overview of the contents and their
#' structure.
#'
#' @param object An object of class \code{phylo3D}.
#'
#' @return \code{summary.phylo3D} An object of class \code{summary.phylo3D},
#' which contains summary information about the \code{phylo3D} object.
#'
#' @rdname phylo3D-printsummaryplot
#' @export
#'
#' @examples
#' # Summary of a 'phylo3D' object:
#' summary(tree)
#' str(summary(tree))
summary.phylo3D <- function(object, ...) {
  if (!inherits(object, "phylo3D")) {
    stop("Not an object of class 'phylo3D'")
  }

  n_leaves <- length(object$tip.label)
  n_internal <- object$Nnode
  n_edges <- length(object$edge.diam)

  # Coordinate ranges and bounding box volume
  coord_rng <- apply(object$node.coord, 2, range)
  coord_rng <- rbind(coord_rng, coord_rng[2, ] - coord_rng[1, ])
  colnames(coord_rng) <- c("X", "Y", "Z")
  rownames(coord_rng) <- c("min", "max", "width")
  bbox_dims <- coord_rng["width", ]
  bbox_vol <- prod(bbox_dims)

  # Edge statistics
  weight_rng <- range(object$edge.weight, na.rm = TRUE)
  weight_mean <- mean(object$edge.weight, na.rm = TRUE)

  if (!is.null(object$edge.length)) {
    length_rng <- range(object$edge.length, na.rm = TRUE)
    length_mean <- mean(object$edge.length, na.rm = TRUE)
  } else {
    length_rng <- NULL
    length_mean <- NULL
  }

  summary_res <- list(
    class = "phylo3D",
    n_leaves = n_leaves,
    n_internal = n_internal,
    n_edges = n_edges,
    coord_ranges = coord_rng,
    bounding_box_volume = bbox_vol,
    edge_weight_range = weight_rng,
    edge_weight_mean = weight_mean,
    edge_length_range = length_rng,
    edge_length_mean = length_mean,
    edges_of_zero_weight = attr(object, "edges_of_zero_weight"),
    order = attr(object, "order")
  )

  class(summary_res) <- "summary.phylo3D"
  summary_res
}
#' @export
print.summary.phylo3D <- function(x, ...) {
  cat("Summary of 'phylo3D' object:\n")
  cat(sprintf(" - Number of tips/leaves: %d\n", x$n_leaves))
  cat(sprintf(" - Number of internal nodes: %d\n", x$n_internal))
  cat(sprintf(" - Number of edges/branches: %d\n", x$n_edges))
  cat(" - Coordinate ranges:\n")
  print(x$coord_ranges)
  cat(sprintf(" - 3D bounding box volume: %.3f\n", x$bounding_box_volume))

  cat(sprintf(
    " - Edge weight range: [%.3f, %.3f], mean: %.3f\n",
    x$edge_weight_range[1], x$edge_weight_range[2], x$edge_weight_mean
  ))

  if (!is.null(x$edge_length_range)) {
    cat(sprintf(
      " - Edge length range: [%.3f, %.3f], mean: %.3f\n",
      x$edge_length_range[1], x$edge_length_range[2], x$edge_length_mean
    ))
  }

  if (length(x$edges_of_zero_weight) > 0) {
    cat(sprintf(
      " - Edges with radius zero: %s\n",
      paste(x$edges_of_zero_weight, collapse = ", ")
    ))
  }

  if (!is.null(x$order)) {
    cat(sprintf(" - Node and edge order: %s\n", x$order))
  }

  invisible(x)
}