R/bipstructuralholes.R

In sangwonhan3083/bipnet: Bipartite Version of Ronald Burt's Structural Holes and Other Related Measures

#' Get Contacts Information
#'
#' @param adj adjacency matrix
#' @param node corresponding node
#' @return contact vector
#'
#' @export
get_contacts <- function(adj, node) {
  contacts <- c()

  for (i in 1:length(adj[node, ])) {
    if (adj[node, i] != 0) {
      contacts <- c(contacts, i)
    }
  }
  return(contacts)
}


#' Get Effective Size
#'devtoo
#' @param adj adjacency matrix
#' @param i corresponding node
#'
#' @return effective size
#' @export
get_effective_size <- function(adj, i) {
  s_2_i <- c()

  s_1_i <- get_contacts(adj, i)

  if (length(s_1_i) == 0) {
    return(0)
  }

  for (j in s_1_i) {
    temp <- get_contacts(t(adj), j)
    s_2_i <- union(s_2_i, temp)
  }

  if (i %in% s_2_i) {
    s_2_i <- s_2_i[-which(s_2_i == i)]
  }

  if (length(s_2_i) == 0) {
    return(0)
  }

  list_contacts <- c()

  for (j in s_2_i) {
    s_1_j <- get_contacts(adj, j)

    ss_1_j <- intersect(s_1_i, s_1_j)

    list_contacts <- c(list_contacts, ss_1_j)
  }

  agg_redundancy <- 0

  for (i in 1:length(list_contacts)) {
    j_redundancy <- 0
    for (j in 1:length(list_contacts)) {
      if (i == j) {
        next
      }
      overlap <- intersect(list_contacts[i], list_contacts[j])

      if (length(overlap) > 0) {
        j_redundancy <- j_redundancy + 1
      }
    }
    agg_redundancy <- agg_redundancy + j_redundancy / length(s_2_i)
  }

  ES_i <- length(s_2_i) - agg_redundancy

  return(ES_i)
}


#' Get Constraint
#'
#' @param adj adjacency matrix
#' @param n1 corresponding node
#' @param n2 corresponding node
#'
#' @return contraint
#' @export
get_constraint <- function(adj, n1, n2) {
  n1_contacts <- get_constraint(adj, n1)
  n2_contacts <- get_constraint(adj, n2)

  if (length(n1_contacts) == 0) {
    return(1)
  }

  overlap <- intersect(n1_contacts, n2_contacts)
  overlap_size <- length(overlap)
  denom_size <- length(n1_contacts)
  if (length(denom_size == 0)) {
    return(1)
  }

  sigma <- 0
  for (i in overlap) {
    sigma <- sigma + adj[n1, i]
  }

  return(((overlap_size * sigma) / denom_size)^2)
}