R/plot_ism.R

In ISMtools: Interpretive Structural Modelling Analysis Tools

#' Plot ISM Structure
#'
#' Visualizes the Interpretive Structural Model (ISM) as a hierarchical diagram.
#' By default, only essential edges are shown (transitive edges removed) for
#' cleaner visualization suitable for publications.
#'
#' @param reach_matrix A square reachability matrix (n x n) with 0/1 entries,
#'   typically computed using \code{\link{compute_reachability}}.
#' @param levels Optional. An object of class \code{ism_levels} from
#'   \code{\link{level_partitioning}}. If NULL, it will be computed automatically.
#' @param show_transitive Logical. If \code{FALSE} (default), transitive edges
#'   are removed for cleaner visualization. If \code{TRUE}, all edges are shown.
#' @param use_igraph Logical. If \code{TRUE} and igraph is available, use igraph
#'   for plotting. If \code{FALSE} (default), use base R graphics.
#' @param node_labels Optional character vector of node labels. If NULL, uses
#'   matrix row names or numeric indices.
#' @param main Title for the plot. Default is "ISM Hierarchical Structure".
#' @param ... Additional arguments passed to plotting functions.
#'
#' @return Invisibly returns a list containing:
#'   \itemize{
#'     \item \code{levels}: the level partitioning result
#'     \item \code{edges}: data frame of edges used in the plot
#'     \item \code{reduced_matrix}: the adjacency matrix after transitive reduction
#'   }
#'
#' @details
#' The function performs transitive reduction by default, removing edges that
#' can be inferred from other paths. This produces cleaner diagrams that are
#' more suitable for academic publications and presentations.
#'
#' Two plotting backends are available:
#' \itemize{
#'   \item \strong{Base R} (default): No additional packages required. Nodes are
#'     arranged in horizontal levels with arrows showing relationships.
#'   \item \strong{igraph}: Requires the igraph package. Provides more sophisticated
#'     graph layouts and styling options.
#' }
#'
#' @seealso
#' \code{\link{plot_interactive_ism}} for interactive visualization,
#' \code{\link{compute_reachability}} for computing reachability matrices,
#' \code{\link{level_partitioning}} for hierarchical decomposition,
#' \code{\link{extract_direct_edges}} for transitive reduction.
#'
#' @export
#' @examples
#' # Create adjacency matrix
#' adj <- matrix(c(0, 1, 0, 0,
#'                 0, 0, 1, 1,
#'                 0, 0, 0, 0,
#'                 0, 0, 0, 0), nrow = 4, byrow = TRUE)
#' rownames(adj) <- colnames(adj) <- c("A", "B", "C", "D")
#'
#' # Compute reachability
#' reach <- compute_reachability(adj)
#'
#' # Plot ISM structure (base R, transitive edges removed)
#' plot_ism(reach)
#'
#' # Show all edges including transitive ones
#' plot_ism(reach, show_transitive = TRUE)
#'
#' \donttest{
#' # Use igraph if available
#' plot_ism(reach, use_igraph = TRUE)
#' }
plot_ism <- function(reach_matrix,
                     levels = NULL,
                     show_transitive = FALSE,
                     use_igraph = FALSE,
                     node_labels = NULL,
                     main = "ISM Hierarchical Structure",
                     ...) {
  # Parameter validation
  if (!is.matrix(reach_matrix)) {
    stop("Input must be a matrix", call. = FALSE)
  }
  if (nrow(reach_matrix) != ncol(reach_matrix)) {
    stop("Matrix must be square", call. = FALSE)
  }

  n <- nrow(reach_matrix)

  # Get node labels
  if (is.null(node_labels)) {
    node_labels <- rownames(reach_matrix)
    if (is.null(node_labels)) {
      node_labels <- as.character(seq_len(n))
    }
  }

  # Compute levels if not provided
  if (is.null(levels)) {
    levels <- level_partitioning(reach_matrix)
  }

  # Get the matrix to plot (with or without transitive reduction)
  if (show_transitive) {
    plot_matrix <- reach_matrix
    # Remove self-loops for plotting
    diag(plot_matrix) <- 0
  } else {
    plot_matrix <- extract_direct_edges(reach_matrix)
  }

  # Create edge list
  edges_idx <- which(plot_matrix == 1, arr.ind = TRUE)
  if (nrow(edges_idx) > 0) {
    edges <- data.frame(
      from = edges_idx[, 1],
      to = edges_idx[, 2],
      from_label = node_labels[edges_idx[, 1]],
      to_label = node_labels[edges_idx[, 2]],
      stringsAsFactors = FALSE
    )
  } else {
    edges <- data.frame(
      from = integer(0),
      to = integer(0),
      from_label = character(0),
      to_label = character(0),
      stringsAsFactors = FALSE
    )
  }

  # Choose plotting backend
  if (use_igraph && requireNamespace("igraph", quietly = TRUE)) {
    .plot_ism_igraph(plot_matrix, levels, node_labels, main, ...)
  } else {
    if (use_igraph) {
      message("igraph package not available, using base R graphics")
    }
    .plot_ism_base(plot_matrix, levels, node_labels, main, ...)
  }

  invisible(list(
    levels = levels,
    edges = edges,
    reduced_matrix = plot_matrix
  ))
}

#' Plot ISM using base R graphics
#' @noRd
.plot_ism_base <- function(adj_matrix, levels, labels, main, ...) {
  n <- nrow(adj_matrix)
  n_levels <- length(levels)

  # Calculate node positions
  # X: spread nodes horizontally within each level
  # Y: levels from top to bottom
  node_x <- numeric(n)
  node_y <- numeric(n)

  for (lv in seq_along(levels)) {
    nodes_in_level <- levels[[lv]]
    n_nodes <- length(nodes_in_level)

    # Y position (top = level 1)
    node_y[nodes_in_level] <- n_levels - lv + 1

    # X position (centered)
    if (n_nodes == 1) {
      node_x[nodes_in_level] <- 0.5
    } else {
      node_x[nodes_in_level] <- seq(0, 1, length.out = n_nodes)
    }
  }

  # Set up plot
  old_par <- graphics::par(mar = c(1, 1, 3, 1))
  on.exit(graphics::par(old_par))

  graphics::plot(NULL,
                 xlim = c(-0.2, 1.2),
                 ylim = c(0.5, n_levels + 0.5),
                 xlab = "", ylab = "",
                 xaxt = "n", yaxt = "n",
                 main = main,
                 asp = NA)

  # Draw edges (arrows)
  edges_idx <- which(adj_matrix == 1, arr.ind = TRUE)
  if (nrow(edges_idx) > 0) {
    for (i in seq_len(nrow(edges_idx))) {
      from_node <- edges_idx[i, 1]
      to_node <- edges_idx[i, 2]

      # Draw arrow
      graphics::arrows(
        x0 = node_x[from_node],
        y0 = node_y[from_node],
        x1 = node_x[to_node],
        y1 = node_y[to_node],
        length = 0.1,
        col = "gray40",
        lwd = 1.5
      )
    }
  }

  # Draw nodes
  node_radius <- 0.08
  for (i in seq_len(n)) {
    # Draw circle
    theta <- seq(0, 2 * pi, length.out = 50)
    circle_x <- node_x[i] + node_radius * cos(theta) * (1.2 / n_levels)
    circle_y <- node_y[i] + node_radius * sin(theta)

    graphics::polygon(circle_x, circle_y,
                      col = "lightblue",
                      border = "darkblue",
                      lwd = 2)

    # Draw label
    graphics::text(node_x[i], node_y[i],
                   labels[i],
                   cex = 0.9,
                   font = 2)
  }

  # Add level labels on the left
  for (lv in seq_along(levels)) {
    graphics::text(-0.15, n_levels - lv + 1,
                   paste("L", lv),
                   cex = 0.8,
                   col = "gray50")
  }
}

#' Plot ISM using igraph
#' @noRd
.plot_ism_igraph <- function(adj_matrix, levels, labels, main, ...) {
  if (!requireNamespace("igraph", quietly = TRUE)) {
    stop("igraph package is required for this function", call. = FALSE)
  }

  n <- nrow(adj_matrix)

  # Create graph
  g <- igraph::graph_from_adjacency_matrix(
    adj_matrix,
    mode = "directed",
    weighted = NULL
  )

  # Set vertex names
  igraph::V(g)$name <- labels

  # Calculate layout based on levels
  n_levels <- length(levels)
  layout_mat <- matrix(0, nrow = n, ncol = 2)

  for (lv in seq_along(levels)) {
    nodes_in_level <- levels[[lv]]
    n_nodes <- length(nodes_in_level)

    # Y position (top = level 1, so invert)
    layout_mat[nodes_in_level, 2] <- -(lv - 1)

    # X position (centered)
    if (n_nodes == 1) {
      layout_mat[nodes_in_level, 1] <- 0
    } else {
      layout_mat[nodes_in_level, 1] <- seq(-1, 1, length.out = n_nodes)
    }
  }

  # Plot
  igraph::plot.igraph(
    g,
    layout = layout_mat,
    vertex.label = labels,
    vertex.label.cex = 1.0,
    vertex.size = 25,
    vertex.color = "lightblue",
    vertex.frame.color = "darkblue",
    edge.arrow.size = 0.5,
    edge.color = "gray40",
    main = main,
    ...
  )
}