R/NPT_discrete_plot.R

In MultiTraits: Analyzing and Visualizing Multidimensional Plant Traits

#' Visualize Discrete Niche Classification Tree
#'
#' This function creates a hierarchical tree visualization of the discrete niche
#' classification results generated by \code{\link{NPT_discrete}}. The visualization
#' displays the niche classification structure as a directed tree graph, where each
#' level represents a niche dimension and nodes represent different clusters within
#' each dimension.
#'
#' @param data A data frame containing niche classification results, typically the
#'   \code{niche_classification} output from \code{\link{NPT_discrete}}. Must contain:
#'   \itemize{
#'     \item \code{species} - Character column with species names
#'     \item \code{niche_code} - Character column with comma-separated niche codes
#'       (e.g., "1,2,1")
#'     \item Additional columns representing cluster assignments for each dimension
#'       (used as layer names in the visualization)
#'   }
#' @param point_size Numeric value specifying the size of nodes in the tree plot.
#'   Default is \code{2.5}.
#'
#' @return A \code{ggplot} object representing the niche classification tree. The plot
#'   can be further customized using standard \code{ggplot2} functions.
#'
#' @details
#' The function constructs a hierarchical tree visualization where:
#' \itemize{
#'   \item \strong{Root node}: Represents the starting point of the classification
#'   \item \strong{Level 1 nodes}: Show clusters in the first niche dimension
#'   \item \strong{Level 2 nodes}: Show clusters in the second niche dimension,
#'     connected to their parent clusters from level 1
#'   \item \strong{Subsequent levels}: Continue the hierarchical pattern for
#'     additional dimensions
#' }
#'
#' \strong{Visualization Features:}
#' \itemize{
#'   \item Different colors for each niche dimension level using NPG color palette
#'   \item Directed edges showing the hierarchical relationships
#'   \item Node labels indicating cluster numbers
#'   \item Legend showing niche levels
#'   \item Automatic detection of the number of dimensions from niche codes
#' }
#'
#' \strong{Tree Construction Algorithm:}
#'
#' The function automatically determines the number of niche dimensions by parsing
#' the first niche code, then recursively builds the tree structure:
#' \enumerate{
#'   \item Parse niche codes to extract individual dimension values
#'   \item Create nodes for each unique cluster combination
#'   \item Establish parent-child relationships between levels
#'   \item Generate the final graph structure for visualization
#' }
#'
#' @note
#' \itemize{
#'   \item The function assumes that niche codes are comma-separated strings
#'   \item Layer names are automatically extracted from column names (excluding
#'     "species" and "niche_code")
#'   \item If the number of layer names doesn't match dimensions, generic names
#'     (Layer1, Layer2, etc.) are used
#' }
#'
#' @importFrom igraph graph_from_data_frame
#' @importFrom ggraph create_layout ggraph geom_edge_link geom_node_point geom_node_text circle theme_graph
#' @importFrom ggplot2 aes scale_fill_manual scale_size_identity theme element_text labs guides guide_legend
#' @importFrom ggsci pal_npg
#' @importFrom grid arrow unit
#' @importFrom stats setNames
#' @importFrom rlang .data
#'
#' @references
#' 1. Winemiller, K. O., Fitzgerald, D. B., Bower, L. M., & Pianka, E. R. (2015).
#'    Functional traits, convergent evolution, and periodic tables of niches.
#'    Ecology letters, 18(8), 737-751.
#' 2. Pianka, E. R., Vitt, L. J., Pelegrin, N., Fitzgerald, D. B., & Winemiller, K. O. (2017).
#'    Toward a periodic table of niches, or exploring the lizard niche hypervolume.
#'    The American Naturalist, 190(5), 601-616.
#'
#' @examples
#' \dontrun{
#' # Load and prepare data
#' data(PFF)
#' rownames(PFF) <- PFF$species
#' PFF_traits <- PFF[, c("SLA", "SRL", "Leaf_Nmass", "Root_Nmass","Height",
#'                       "Leaf_CN", "Root_CN","SeedMass", "FltDate", "FltDur")]
#' # Perform log transformation of data and remove missing values
#' PFF_traits <- log(na.omit(PFF_traits))
#' head(PFF_traits)
#' # Define trait dimensions
#' dimension <- list(Grow = c("SLA", "SRL", "Leaf_Nmass", "Root_Nmass"),
#'                   Survive = c("Height", "Leaf_CN", "Root_CN"),
#'                   Reproductive = c("SeedMass", "FltDate", "FltDur"))
#'
#' set.seed(123)
#' discrete_result <- NPT_discrete(data = PFF_traits, dimension = dimension)
#' NPT_discrete_plot(discrete_result$niche_classification)
#'
#' }
#'
#' @export
NPT_discrete_plot <- function(data, point_size = 2.5) {
  # Split niche_code and automatically determine the number of dimensions
  niche_split <- strsplit(data$niche_code, ",")
  n_dims <- length(niche_split[[1]])
  # Get layer names from input data (excluding species and niche_code columns)
  layer_names <- names(data)[!names(data) %in% c("species", "niche_code")]
  if(length(layer_names) != n_dims) {
    layer_names <- paste0("Layer", 1:n_dims)
  }
  niche_df <- data.frame(species = data$species, niche_code = data$niche_code)
  for(i in 1:n_dims) {
    niche_df[paste0("dim", i)] <- sapply(niche_split, function(x) as.numeric(x[i]))
  }
  nodes <- data.frame()
  edges <- data.frame()
  nodes <- rbind(nodes, data.frame(id = "Root", level = 0, label = "",
                                   type = "Root", occupied = TRUE))
  build_tree_level <- function(current_level, parent_combinations = data.frame()) {
    if(current_level > n_dims) return()
    current_dim <- paste0("dim", current_level)
    if(current_level == 1) {
      dim_values <- sort(unique(niche_df[[current_dim]]))
      for(val in dim_values) {
        node_id <- paste0("D", current_level, "_", val)
        node_type <- layer_names[current_level]
        nodes <<- rbind(nodes, data.frame(
          id = node_id,
          level = current_level,
          label = as.character(val),
          type = node_type,
          occupied = TRUE
        ))
        edges <<- rbind(edges, data.frame(from = "Root", to = node_id))
        if(current_level < n_dims) {
          next_combo <- data.frame(
            parent_id = node_id,
            combo = val,
            stringsAsFactors = FALSE
          )
          next_combo[current_dim] <- val
          build_tree_level(current_level + 1, next_combo)
        }
      }
    } else {
      for(i in 1:nrow(parent_combinations)) {
        parent_info <- parent_combinations[i, ]
        filter_condition <- rep(TRUE, nrow(niche_df))
        for(j in 1:(current_level-1)) {
          dim_col <- paste0("dim", j)
          if(dim_col %in% names(parent_info)) {
            filter_condition <- filter_condition & (niche_df[[dim_col]] == parent_info[[dim_col]])
          }
        }
        current_values <- sort(unique(niche_df[filter_condition, current_dim]))
        for(val in current_values) {
          id_parts <- c()
          for(k in 1:current_level) {
            if(k < current_level) {
              id_parts <- c(id_parts, paste0("D", k, "_", parent_info[[paste0("dim", k)]]))
            } else {
              id_parts <- c(id_parts, paste0("D", k, "_", val))
            }
          }
          node_id <- paste(id_parts, collapse = "_")
          node_type <- layer_names[current_level]
          if(!node_id %in% nodes$id) {
            nodes <<- rbind(nodes, data.frame(
              id = node_id,
              level = current_level,
              label = as.character(val),
              type = node_type,
              occupied = TRUE
            ))
            edges <<- rbind(edges, data.frame(from = parent_info$parent_id, to = node_id))
          }
          if(current_level < n_dims) {
            next_combo <- parent_info
            next_combo$parent_id <- node_id
            next_combo[paste0("dim", current_level)] <- val
            build_tree_level(current_level + 1, next_combo)
          }
        }
      }
    }
  }
  build_tree_level(1)
  level_order <- c("Root", layer_names)
  nodes$type <- factor(nodes$type, levels = level_order)
  g <- igraph::graph_from_data_frame(edges, vertices = nodes, directed = TRUE)
  layout <- ggraph::create_layout(g, layout = 'tree')
  n_levels <- length(level_order)
  npg_colors <- ggsci::pal_npg("nrc")(n_levels)
  color_mapping <- stats::setNames(npg_colors, level_order)
  p <- ggraph::ggraph(layout) +
    ggraph::geom_edge_link(color = "gray50", alpha = 0.7,
                           arrow = grid::arrow(length = grid::unit(2, 'mm')),
                           end_cap = ggraph::circle(3, 'mm')) +
    ggraph::geom_node_point(ggplot2::aes(fill = .data$type, size = point_size),
                            shape = 21, stroke = 1, color = "black") +
    ggraph::geom_node_text(ggplot2::aes(label = .data$label), size = 3, hjust = 0.5, vjust = 2) +
    ggplot2::scale_fill_manual(values = color_mapping, breaks = level_order) +
    ggplot2::scale_size_identity() +
    ggraph::theme_graph(base_family = "") +
    ggplot2::theme(legend.position = "bottom") +
    ggplot2::labs(fill = "Niche Level") +
    ggplot2::guides(fill = ggplot2::guide_legend(override.aes = list(size = point_size)))
  return(p)
}