R/convert_inputs.R

In ISMtools: Interpretive Structural Modelling Analysis Tools

#' Convert Input to Adjacency Matrix
#'
#' Converts various input formats (data.frame, matrix) to a standard adjacency
#' matrix suitable for ISM analysis. Performs validation and provides warnings
#' for potential issues.
#'
#' @param x Input data. Can be:
#'   \itemize{
#'     \item A two-column matrix representing an edge list
#'     \item A square matrix (adjacency matrix)
#'     \item A data.frame with source and target columns
#'   }
#' @param from Column name or index for source nodes (if x is a data.frame).
#'   Default is 1.
#' @param to Column name or index for target nodes (if x is a data.frame).
#'   Default is 2.
#' @param nodes Optional character vector of predefined node names. If provided,
#'   ensures the resulting matrix includes all specified nodes.
#' @param validate Logical. If \code{TRUE} (default), validates the input and
#'   provides warnings for potential issues.
#'
#' @return A square numeric adjacency matrix with node names as row and column names.
#'   A value of 1 at position (i,j) indicates a directed edge from node i to
#'   node j.
#'
#' @details
#' This function provides flexible input handling for ISM analysis. It can
#' convert edge lists (either as data frames or two-column matrices) into
#' adjacency matrices, or validate and return existing adjacency matrices.
#'
#' When \code{validate = TRUE}, the function checks:
#' \itemize{
#'   \item Square matrices contain only 0s and 1s (or logical values)
#'   \item Edge list nodes exist in the predefined node list (if provided)
#'   \item Column names exist in data frames
#' }
#'
#' @seealso
#' \code{\link{create_relation_matrix}} for a higher-level interface,
#' \code{\link{ssim_to_matrix}} for SSIM conversion,
#' \code{\link{compute_reachability}} for computing reachability matrices.
#'
#' @export
#' @examples
#' # From data frame edge list
#' edge_df <- data.frame(source = c("A", "B"), target = c("B", "C"))
#' convert_to_matrix(edge_df, from = "source", to = "target")
#'
#' # From matrix edge list
#' edge_mat <- matrix(c("A", "B", "B", "C"), ncol = 2, byrow = TRUE)
#' convert_to_matrix(edge_mat)
#'
#' # Existing adjacency matrix (validated and returned)
#' adj_mat <- matrix(c(0, 1, 0, 0,
#'                     0, 0, 1, 1,
#'                     0, 0, 0, 0,
#'                     0, 0, 0, 0), nrow = 4, byrow = TRUE)
#' convert_to_matrix(adj_mat)
#'
#' # With predefined nodes (ensures all nodes are included)
#' edge_df <- data.frame(source = "A", target = "B")
#' convert_to_matrix(edge_df, from = "source", to = "target",
#'                   nodes = c("A", "B", "C", "D"))
convert_to_matrix <- function(x, from = 1, to = 2, nodes = NULL, validate = TRUE) {

  if (is.matrix(x)) {
    if (ncol(x) == 2 && !is.numeric(x[1, 1])) {
      # Process edge list matrix (character/factor columns)
      return(.convert_edge_list_matrix(x, nodes, validate))
    } else if (nrow(x) == ncol(x)) {
      # Process square matrix (potential adjacency matrix)
      return(.validate_adjacency_matrix(x, validate))
    } else if (ncol(x) == 2) {
      # Numeric two-column matrix - treat as edge list with indices
      return(.convert_edge_list_matrix(x, nodes, validate))
    } else {
      stop("Input matrix must be either a two-column edge list or a square adjacency matrix.",
           call. = FALSE)
    }
  } else if (is.data.frame(x)) {
    return(.convert_edge_list_df(x, from, to, nodes, validate))
  } else {
    stop("Unsupported input type. Please provide a data frame, matrix, or adjacency matrix.",
         call. = FALSE)
  }
}

#' Validate and process adjacency matrix
#' @noRd
.validate_adjacency_matrix <- function(x, validate) {
  n <- nrow(x)

  # Convert logical to numeric
  if (is.logical(x)) {
    storage.mode(x) <- "integer"
  }

  if (validate) {
    # Check for 0/1 values
    if (!all(x %in% c(0, 1, TRUE, FALSE))) {
      non_binary <- unique(x[!x %in% c(0, 1, TRUE, FALSE)])
      if (length(non_binary) <= 5) {
        warning("Matrix contains non-binary values: ",
                paste(non_binary, collapse = ", "),
                ". Converting to 0/1 (non-zero = 1).",
                call. = FALSE)
      } else {
        warning("Matrix contains non-binary values. Converting to 0/1 (non-zero = 1).",
                call. = FALSE)
      }
      x <- (x != 0) * 1L
    }

    # Ensure numeric type
    if (!is.numeric(x)) {
      x <- matrix(as.numeric(x), nrow = n, ncol = n, dimnames = dimnames(x))
    }

    # Add dimnames if missing
    if (is.null(rownames(x)) || is.null(colnames(x))) {
      if (is.null(rownames(x)) && is.null(colnames(x))) {
        rownames(x) <- colnames(x) <- as.character(seq_len(n))
      } else if (is.null(rownames(x))) {
        rownames(x) <- colnames(x)
      } else {
        colnames(x) <- rownames(x)
      }
    }
  }

  return(x)
}

#' Convert edge list matrix to adjacency matrix
#' @noRd
.convert_edge_list_matrix <- function(x, nodes, validate) {
  sources <- as.character(x[, 1])
  targets <- as.character(x[, 2])

  # Determine node set
  edge_nodes <- unique(c(sources, targets))

  if (is.null(nodes)) {
    nodes <- sort(edge_nodes)
  } else {
    # Check for nodes in edges but not in predefined list
    if (validate) {
      missing_nodes <- setdiff(edge_nodes, nodes)
      if (length(missing_nodes) > 0) {
        warning("The following nodes appear in edges but not in predefined node list: ",
                paste(missing_nodes, collapse = ", "),
                ". These edges will be ignored.",
                call. = FALSE)
      }
    }
  }

  n <- length(nodes)
  adj_mat <- matrix(0L, nrow = n, ncol = n, dimnames = list(nodes, nodes))

  for (i in seq_len(nrow(x))) {
    src <- sources[i]
    tgt <- targets[i]
    if (src %in% nodes && tgt %in% nodes) {
      adj_mat[src, tgt] <- 1L
    }
  }

  return(adj_mat)
}

#' Convert edge list data frame to adjacency matrix
#' @noRd
.convert_edge_list_df <- function(x, from, to, nodes, validate) {
  # Get source column
  if (is.numeric(from)) {
    if (from > ncol(x)) {
      stop("Column index 'from' (", from, ") exceeds number of columns (", ncol(x), ").",
           call. = FALSE)
    }
    sources <- x[[from]]
  } else {
    from_char <- as.character(from)
    if (!from_char %in% names(x)) {
      stop("Column '", from_char, "' not found in data frame. ",
           "Available columns: ", paste(names(x), collapse = ", "),
           call. = FALSE)
    }
    sources <- x[[from_char]]
  }

  # Get target column
  if (is.numeric(to)) {
    if (to > ncol(x)) {
      stop("Column index 'to' (", to, ") exceeds number of columns (", ncol(x), ").",
           call. = FALSE)
    }
    targets <- x[[to]]
  } else {
    to_char <- as.character(to)
    if (!to_char %in% names(x)) {
      stop("Column '", to_char, "' not found in data frame. ",
           "Available columns: ", paste(names(x), collapse = ", "),
           call. = FALSE)
    }
    targets <- x[[to_char]]
  }

  sources <- as.character(sources)
  targets <- as.character(targets)

  # Determine node set
  edge_nodes <- unique(c(sources, targets))

  if (is.null(nodes)) {
    nodes <- sort(edge_nodes)
  } else {
    # Check for nodes in edges but not in predefined list
    if (validate) {
      missing_nodes <- setdiff(edge_nodes, nodes)
      if (length(missing_nodes) > 0) {
        warning("The following nodes appear in edges but not in predefined node list: ",
                paste(missing_nodes, collapse = ", "),
                ". These edges will be ignored.",
                call. = FALSE)
      }
    }
  }

  n <- length(nodes)
  adj_mat <- matrix(0L, nrow = n, ncol = n, dimnames = list(nodes, nodes))

  for (i in seq_len(nrow(x))) {
    src <- sources[i]
    tgt <- targets[i]
    if (src %in% nodes && tgt %in% nodes) {
      adj_mat[src, tgt] <- 1L
    }
  }

  return(adj_mat)
}