varPro Phase 3: gg_udependent — dependency graph for uvarpro fits

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ggRandomForests
 Type: Package
 Title: Visually Exploring Random Forests
-Version: 2.7.3.9003
+Version: 2.7.3.9004
 Date: 2026-05-20
 Authors@R: person("John", "Ehrlinger",
   role = c("aut", "cre"),
@@ -23,6 +23,7 @@ Imports:
     randomForestSRC (>= 3.4.0),
     randomForest,
     varPro,
+    igraph,
     survival,
     parallel,
     tidyr,
@@ -45,7 +46,7 @@ Suggests:
     pkgload,
     knitr,
     plotly,
-    igraph,
+    ggraph,
     callr
 VignetteBuilder: quarto
 Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -9,6 +9,7 @@ S3method(autoplot,gg_partialpro)
 S3method(autoplot,gg_rfsrc)
 S3method(autoplot,gg_roc)
 S3method(autoplot,gg_survival)
+S3method(autoplot,gg_udependent)
 S3method(autoplot,gg_variable)
 S3method(autoplot,gg_varpro)
 S3method(autoplot,gg_vimp)
@@ -38,6 +39,7 @@ S3method(plot,gg_partialpro)
 S3method(plot,gg_rfsrc)
 S3method(plot,gg_roc)
 S3method(plot,gg_survival)
+S3method(plot,gg_udependent)
 S3method(plot,gg_variable)
 S3method(plot,gg_varpro)
 S3method(plot,gg_vimp)
@@ -50,10 +52,12 @@ S3method(print,gg_partialpro)
 S3method(print,gg_rfsrc)
 S3method(print,gg_roc)
 S3method(print,gg_survival)
+S3method(print,gg_udependent)
 S3method(print,gg_variable)
 S3method(print,gg_varpro)
 S3method(print,gg_vimp)
 S3method(print,summary.gg)
+S3method(print,summary.gg_udependent)
 S3method(summary,gg_brier)
 S3method(summary,gg_error)
 S3method(summary,gg_partial)
@@ -63,6 +67,7 @@ S3method(summary,gg_partialpro)
 S3method(summary,gg_rfsrc)
 S3method(summary,gg_roc)
 S3method(summary,gg_survival)
+S3method(summary,gg_udependent)
 S3method(summary,gg_variable)
 S3method(summary,gg_varpro)
 S3method(summary,gg_vimp)
@@ -77,6 +82,7 @@ export(gg_partialpro)
 export(gg_rfsrc)
 export(gg_roc)
 export(gg_survival)
+export(gg_udependent)
 export(gg_variable)
 export(gg_varpro)
 export(gg_vimp)
@@ -104,9 +110,19 @@ importFrom(ggplot2,geom_ribbon)
 importFrom(ggplot2,geom_vline)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,labs)
+importFrom(ggplot2,scale_color_manual)
 importFrom(ggplot2,scale_fill_manual)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_minimal)
+importFrom(ggplot2,theme_void)
+importFrom(igraph,E)
+importFrom(igraph,V)
+importFrom(igraph,as_data_frame)
+importFrom(igraph,degree)
+importFrom(igraph,delete_vertices)
+importFrom(igraph,edge_attr)
+importFrom(igraph,graph_from_adjacency_matrix)
+importFrom(igraph,vertex_attr)
 importFrom(parallel,mclapply)
 importFrom(patchwork,wrap_plots)
 importFrom(randomForest,randomForest)
@@ -129,5 +145,7 @@ importFrom(tidyr,all_of)
 importFrom(tidyr,pivot_longer)
 importFrom(utils,head)
 importFrom(utils,tail)
+importFrom(varPro,get.beta.entropy)
 importFrom(varPro,importance)
 importFrom(varPro,partialpro)
+importFrom(varPro,sdependent)

NEWS.md

@@ -1,8 +1,19 @@
 Package: ggRandomForests
-Version: 2.7.3.9003
+Version: 2.7.3.9004
 
 ggRandomForests v2.8.0 (development) — continued
 =================================================
+* **varPro variable dependency: `gg_udependent()` (Phase 3).**
+  - `gg_udependent()` extracts cross-variable dependency scores from a
+    `uvarpro` fit using `varPro::get.beta.entropy()` +
+    `varPro::sdependent()`, and returns a tidy list with `$edges`
+    (variable_from, variable_to, weight), `$nodes` (variable, degree,
+    selected), and `$graph` (igraph object).
+  - `plot.gg_udependent()` renders the dependency network using ggraph
+    with edge width/opacity scaled by dependency strength and node colour
+    by signal-variable status.  Layout is configurable (`"fr"`, `"kk"`,
+    `"stress"`, etc.).
+  - `ggraph` added to `Suggests:`.
 * **varPro variable importance: `gg_varpro()` (#85).**
   - `gg_varpro()` extracts per-tree importance scores from a fitted
     `varpro` object and renders an honest boxplot — hinges at the

R/autoplot_methods.R

@@ -129,3 +129,9 @@ autoplot.gg_brier <- function(object, ...) {
 autoplot.gg_varpro <- function(object, ...) {
   plot(object, ...)
 }
+
+#' @rdname autoplot.gg
+#' @export
+autoplot.gg_udependent <- function(object, ...) {
+  plot(object, ...)
+}

R/gg_udependent.R

@@ -0,0 +1,227 @@
+##=============================================================================
+#' Variable dependency graph from a uvarpro model
+#'
+#' Extracts cross-variable dependency scores from a fitted \code{uvarpro}
+#' object using \code{\link[varPro]{get.beta.entropy}} and
+#' \code{\link[varPro]{sdependent}}, and returns a tidy list suitable for
+#' \code{plot.gg_udependent}.
+#'
+#' @param object A fitted \code{uvarpro} object (required).
+#' @param threshold Numeric; positive dependency threshold passed to
+#'   \code{sdependent()}. An edge \eqn{i \to j} is drawn when
+#'   \code{I[i, j] >= threshold}. Default \code{0.25}.
+#' @param q.signal Quantile threshold (0--1) for signal variable selection;
+#'   passed to \code{sdependent()}. Default \code{0.75}.
+#' @param directed Logical; \code{TRUE} (default) builds a directed igraph.
+#' @param min.degree Integer or \code{NULL}. When non-\code{NULL}, only nodes
+#'   with degree \eqn{\ge} \code{min.degree} are retained in \code{$nodes},
+#'   \code{$edges}, and \code{$graph}.
+#' @param ... Additional arguments forwarded to \code{varPro::sdependent()}.
+#'
+#' @return A named list of class \code{"gg_udependent"} with elements:
+#' \describe{
+#'   \item{\code{$edges}}{Data frame: \code{variable_from}, \code{variable_to},
+#'     \code{weight} (raw cross-importance value).}
+#'   \item{\code{$nodes}}{Data frame: \code{variable} (factor, levels by
+#'     descending degree), \code{degree} (integer; out-degree when
+#'     \code{directed = TRUE}, total degree when \code{directed = FALSE}),
+#'     \code{selected} (logical, \code{TRUE} if in \code{sdependent}'s
+#'     signal set).}
+#'   \item{\code{$graph}}{igraph object. \code{NULL} if no dependencies
+#'     detected.}
+#' }
+#' A \code{"provenance"} attribute carries \code{threshold}, \code{q.signal},
+#' \code{directed}, \code{min.degree}, \code{xvar.names}, and \code{n}.
+#'
+#' @seealso \code{\link{plot.gg_udependent}}
+#'
+#' @examples
+#' \donttest{
+#' set.seed(42)
+#' uv <- varPro::uvarpro(iris[, -5], ntree = 50)
+#' gg <- gg_udependent(uv)
+#' print(gg)
+#' }
+#'
+#' @importFrom varPro get.beta.entropy sdependent
+#' @importFrom igraph graph_from_adjacency_matrix degree delete_vertices as_data_frame V
+#' @export
+gg_udependent <- function(object,
+                           threshold  = 0.25,
+                           q.signal   = 0.75,
+                           directed   = TRUE,
+                           min.degree = NULL,
+                           ...) {
+  .validate_udep_inputs(object, threshold, directed)
+
+  ## ---- Compute cross-variable dependency matrix ----------------------------
+  imp_mat <- varPro::get.beta.entropy(object)
+
+  ## ---- Helper: build and return an empty gg_udependent result ---------------
+  .empty_result <- function(msg) {
+    warning("gg_udependent: ", msg,
+            "\nReturning empty structure. Consider lowering threshold.",
+            call. = FALSE)
+    empty_edges <- data.frame(variable_from = character(0),
+                               variable_to   = character(0),
+                               weight        = numeric(0),
+                               stringsAsFactors = FALSE)
+    empty_nodes <- data.frame(variable = factor(character(0)),
+                               degree   = integer(0),
+                               selected = logical(0),
+                               stringsAsFactors = FALSE)
+    result <- structure(
+      list(edges = empty_edges, nodes = empty_nodes, graph = NULL),
+      class = c("gg_udependent", "list")
+    )
+    attr(result, "provenance") <- .udep_provenance(object, threshold, q.signal,
+                                                     directed, min.degree)
+    result
+  }
+
+  ## ---- Build adjacency from threshold; short-circuit if empty --------------
+  adj_mat <- (imp_mat >= threshold) * 1
+  diag(adj_mat) <- 0
+  if (sum(adj_mat) == 0L) {
+    return(.empty_result(
+      paste0("no edges found at threshold=", threshold)
+    ))
+  }
+
+  ## ---- Call sdependent for signal detection --------------------------------
+  sdep <- varPro::sdependent(imp_mat, threshold = threshold,
+                              q.signal = q.signal, directed = directed,
+                              min.degree = min.degree, plot = FALSE, ...)
+
+  ## ---- Handle empty graph (sdependent may also return character) -----------
+  if (is.character(sdep)) {
+    return(.empty_result(sdep))
+  }
+
+  ## ---- Build igraph from adjacency -----------------------------------------
+  ## For undirected, symmetrise first so edge existence = max(I[i,j], I[j,i])
+  ## and mode = "undirected" is valid (igraph >= 1.6.0 requires symmetry).
+  if (!isTRUE(directed)) {
+    adj_mat <- pmax(adj_mat, t(adj_mat))
+  }
+  g <- igraph::graph_from_adjacency_matrix(
+    adj_mat,
+    mode  = if (isTRUE(directed)) "directed" else "undirected",
+    diag  = FALSE
+  )
+  isolated <- igraph::degree(g, mode = "all") == 0
+  g <- igraph::delete_vertices(g, which(isolated))
+
+  ## ---- Build tidy edge data frame with raw weights -------------------------
+  edge_df <- igraph::as_data_frame(g, what = "edges")
+  if (nrow(edge_df) > 0L) {
+    if (isTRUE(directed)) {
+      edge_df$weight <- mapply(function(i, j) imp_mat[i, j],
+                                edge_df[[1L]], edge_df[[2L]])
+    } else {
+      ## Undirected: weight = max of both directions
+      edge_df$weight <- mapply(
+        function(i, j) max(imp_mat[i, j], imp_mat[j, i]),
+        edge_df[[1L]], edge_df[[2L]])
+    }
+  } else {
+    edge_df$weight <- numeric(0)
+  }
+  names(edge_df)[1:2] <- c("variable_from", "variable_to")
+
+  ## ---- Build tidy node data frame ------------------------------------------
+  vnames  <- igraph::V(g)$name
+  ## degree: out-degree for directed (matches sdependent's signal.vars logic),
+  ## total degree for undirected
+  deg_vec <- if (isTRUE(directed)) {
+    igraph::degree(g, mode = "out")[vnames]
+  } else {
+    igraph::degree(g)[vnames]
+  }
+
+  signal_set <- if (is.null(sdep$signal.vars)) character(0) else sdep$signal.vars
+  node_df <- data.frame(
+    variable = factor(vnames, levels = vnames[order(-deg_vec)]),
+    degree   = as.integer(deg_vec),
+    selected = vnames %in% signal_set,
+    stringsAsFactors = FALSE,
+    row.names = NULL
+  )
+
+  ## ---- Apply min.degree node filtering (user-requested subsetting) ---------
+  if (!is.null(min.degree)) {
+    keep       <- node_df$degree >= min.degree
+    keep_names <- as.character(node_df$variable)[keep]
+    drop_names <- as.character(node_df$variable)[!keep]
+    g          <- igraph::delete_vertices(g, drop_names)
+    edge_df    <- edge_df[
+      edge_df$variable_from %in% keep_names &
+      edge_df$variable_to   %in% keep_names, , drop = FALSE]
+    node_df    <- node_df[keep, , drop = FALSE]
+    rownames(edge_df) <- NULL
+    rownames(node_df) <- NULL
+  }
+
+  ## ---- Set igraph node attributes ------------------------------------------
+  if (length(igraph::V(g)) > 0L) {
+    igraph::V(g)$degree   <- node_df$degree[
+      match(igraph::V(g)$name, as.character(node_df$variable))]
+    igraph::V(g)$selected <- node_df$selected[
+      match(igraph::V(g)$name, as.character(node_df$variable))]
+  }
+
+  ## ---- Set igraph edge weights (order-insensitive for undirected) -----------
+  if (length(igraph::E(g)) > 0L && nrow(edge_df) > 0L) {
+    el <- igraph::as_data_frame(g, what = "edges")
+    if (isTRUE(directed)) {
+      idx <- match(paste(el$from, el$to),
+                   paste(edge_df$variable_from, edge_df$variable_to))
+    } else {
+      key_g <- paste(pmin(el$from, el$to),     pmax(el$from, el$to))
+      key_e <- paste(pmin(edge_df$variable_from, edge_df$variable_to),
+                     pmax(edge_df$variable_from, edge_df$variable_to))
+      idx <- match(key_g, key_e)
+    }
+    igraph::E(g)$weight <- edge_df$weight[idx]
+  }
+
+  ## ---- Assemble result ------------------------------------------------------
+  result <- structure(
+    list(edges = edge_df, nodes = node_df, graph = g),
+    class = c("gg_udependent", "list")
+  )
+  attr(result, "provenance") <- .udep_provenance(object, threshold, q.signal,
+                                                   directed, min.degree)
+  result
+}
+
+## ---- Internal helpers -------------------------------------------------------
+
+#' @keywords internal
+.validate_udep_inputs <- function(object, threshold, directed) {
+  if (missing(object) || is.null(object)) {
+    stop("'object' must be a fitted uvarpro object.", call. = FALSE)
+  }
+  if (!inherits(object, "uvarpro")) {
+    stop("'object' must be a uvarpro fit (class \"uvarpro\").", call. = FALSE)
+  }
+  if (!is.numeric(threshold) || length(threshold) != 1L || threshold <= 0) {
+    stop("'threshold' must be a single positive numeric value.", call. = FALSE)
+  }
+  if (!is.logical(directed) || length(directed) != 1L) {
+    stop("'directed' must be a single logical value.", call. = FALSE)
+  }
+  invisible(NULL)
+}
+
+#' @keywords internal
+.udep_provenance <- function(object, threshold, q.signal, directed, min.degree) {
+  list(
+    threshold  = threshold,
+    q.signal   = q.signal,
+    directed   = directed,
+    min.degree = min.degree,
+    xvar.names = object$xvar.names,
+    n          = nrow(object$x)
+  )
+}