R/summarise_nonparametric_edges.R

In InterconectaR: Psychological Network Analysis and Psychometric Insights

#' @title Summarise Nonparametric Edges
#' @description Summarises nonparametric bootstrap results for network edges from bootnet.
#' @param nonParametricBoot A bootnet nonparametric bootstrap object.
#' @param stat_type Character, type of statistic to summarise (default "edge").
#' @param probs Numeric vector of length 2 for confidence interval quantiles.
#' @param quiet Logical, suppress printing.
#' @return A data frame with edge bootstrap summary statistics.
#' @export
#' @examples
#' \donttest{
#' set.seed(123)
#' n <- 300
#' f1 <- rnorm(n)
#' f2 <- 0.3 * f1 + rnorm(n)
#' items <- data.frame(
#'   sapply(1:4, function(i) 0.7 * f1 + rnorm(n, 0, 0.7)),
#'   sapply(1:4, function(i) 0.7 * f2 + rnorm(n, 0, 0.7))
#' )
#' names(items) <- c(paste0("A", 1:4), paste0("B", 1:4))
#'
#' net <- bootnet::estimateNetwork(items, default = "EBICglasso")
#' edge_boot <- bootnet::bootnet(net, nBoots = 20, nCores = 1, verbose = FALSE)
#' summarise_nonparametric_edges(edge_boot)
#' }
#' @importFrom dplyr filter select group_by summarise left_join mutate arrange desc n if_else
#' @importFrom rlang .data
summarise_nonparametric_edges <- function(nonParametricBoot,
                                          stat_type = "edge",
                                          probs = c(0.025, 0.975),
                                          quiet = TRUE) {
  dplyr <- asNamespace("dplyr")

  # Validaciones
  if (!all(c("bootTable", "sampleTable") %in% names(nonParametricBoot))) {
    stop("El objeto no parece provenir de bootnet: faltan 'bootTable' y/o 'sampleTable'.")
  }
  if (length(probs) != 2 || any(is.na(probs))) {
    stop("'probs' debe ser num\u00e9rico de longitud 2, por ejemplo c(0.025, 0.975).")
  }
  probs <- sort(probs)

  boot <- nonParametricBoot$bootTable
  samp <- nonParametricBoot$sampleTable

  needed_cols <- c("type", "id", "value")
  if (!all(needed_cols %in% names(samp))) {
    stop("A 'sampleTable' le faltan columnas: ",
         paste(setdiff(needed_cols, names(samp)), collapse = ", "))
  }
  if (!all(needed_cols %in% names(boot))) {
    stop("A 'bootTable' le faltan columnas: ",
         paste(setdiff(needed_cols, names(boot)), collapse = ", "))
  }

  # 1) Muestra (puntos rojos)
  sample_edges <- samp |>
    dplyr$filter(.data$type == stat_type) |>
    dplyr$select("id", sample = "value")

  # 2) Resumen bootstrap (puntos negros y banda)
  boot_edges <- boot |>
    dplyr$filter(.data$type == stat_type) |>
    dplyr$group_by(.data$id) |>
    dplyr$summarise(
      boot_mean = mean(.data$value, na.rm = TRUE),
      ci_lo     = stats::quantile(.data$value, probs[1], na.rm = TRUE),
      ci_hi     = stats::quantile(.data$value, probs[2], na.rm = TRUE),
      n_boot    = dplyr$n(),
      .groups   = "drop"
    )

  # 3) Tabla final
  edge_plot_values <- sample_edges |>
    dplyr$left_join(boot_edges, by = "id") |>
    dplyr$mutate(
      ci_covers_zero = dplyr$if_else(
        !is.na(.data$ci_lo) & !is.na(.data$ci_hi),
        .data$ci_lo <= 0 & .data$ci_hi >= 0,
        NA
      )
    ) |>
    dplyr$arrange(dplyr$desc(abs(.data$boot_mean)))

  if (!quiet) print(utils::head(edge_plot_values))
  return(edge_plot_values)
}