## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(netmem)

data(campnet)
A <- campnet$network
U <- pmax(A, t(A)) # Underlying graph
gender <- campnet$attributes$gender # 1 = woman, 2 = man

## ----inclusion----------------------------------------------------------------
P <- neigh_inclusion(U) # P[u, v] = 1 when u is dominated by v
dominance_pairs(P)[c("comparable", "incomparable", "prop_comparable")]

## ----ranks--------------------------------------------------------------------
dominance_ranks(P)

## ----layers-------------------------------------------------------------------
strict <- P * (1 - t(P))
dominance_layers(strict)$layers

## ----preserved----------------------------------------------------------------
preserved_order(P, betweenness_centrality(U, digraph = FALSE))$preserved

## ----directed-----------------------------------------------------------------
D <- dir_inclusion(A, type = "radial_in")
preserved_order(D, colSums(A))$preserved
preserved_order(D, page_rank_centrality(A))$preserved
preserved_order(D, betweenness_centrality(A))

## ----cliques------------------------------------------------------------------
cliques <- clique_max(U, min = 3)
K <- matrix(0, nrow(U), length(cliques),
  dimnames = list(rownames(U), paste0("C", seq_along(cliques)))
)
for (k in seq_along(cliques)) {
  K[cliques[[k]], k] <- 1
}
K

## ----composition--------------------------------------------------------------
round(alter_composition(A, K), 2)
round(alter_heterogeneity(A, K), 2)

## ----homophily----------------------------------------------------------------
round(cbind(
  ei = alter_homophily(A, K),
  yule = alter_homophily(A, K, method = "yule")
), 2)

## ----brokerage----------------------------------------------------------------
round(brokerage_roles(A, K), 2)

## ----partition----------------------------------------------------------------
round(colSums(partition_centrality(A, K)), 1)

## ----holes--------------------------------------------------------------------
holes <- data.frame(
  gender = gender,
  original = structural_holes(A)$effective_size,
  same_gender = structural_holes(A, gender, beta = 0.5)$effective_size,
  row.names = rownames(A)
)
round(holes, 2)

## ----q_analysis---------------------------------------------------------------
q <- q_analysis(U)
q$q_table
q$components$q1

## ----eccentricity-------------------------------------------------------------
q$eccentricity

## ----corpus-------------------------------------------------------------------
papers <- paste0("p", 1:13)
references <- list(
  p4 = c("p1", "p2", "p3"), p5 = "p4", p6 = "p4", p7 = "p5",
  p8 = c("p6", "p7"), p9 = "p7", p10 = "p7", p11 = "p7", p12 = "p8", p13 = "p8"
)
cites <- matrix(0, 13, 13, dimnames = list(papers, papers))
for (p in names(references)) {
  cites[p, references[[p]]] <- 1
}

authors <- list(
  p1 = "Ada", p2 = "Bo", p3 = c("Ada", "Cy"), p4 = c("Ada", "Bo"), p5 = "Cy",
  p6 = c("Bo", "Di"), p7 = c("Cy", "Ed"), p8 = "Di", p9 = "Ed", p10 = c("Ed", "Flo"),
  p11 = "Flo", p12 = c("Di", "Flo"), p13 = c("Ada", "Di")
)
X <- matrix(0, 6, 13, dimnames = list(c("Ada", "Bo", "Cy", "Di", "Ed", "Flo"), papers))
for (p in names(authors)) {
  X[authors[[p]], p] <- 1
}

## ----spc----------------------------------------------------------------------
flow <- t(cites)
dag_check(flow)$is_dag

spc <- traversal_weights(flow, method = "spc")
matrix_to_edgelist(spc$edge_weights, digraph = TRUE, valued = TRUE)

## ----main_path----------------------------------------------------------------
main_path(flow, method = "global")$routes
main_path(flow, method = "key_route", k = 2)$routes

## ----fractional---------------------------------------------------------------
fractional_approach(cites, t(X), fractional = FALSE)
round(fractional_approach(cites, t(X)), 2)
sum(fractional_approach(cites, t(X)))
sum(cites)

## ----coupling-----------------------------------------------------------------
coupling <- fractional_approach(cites, approach = "bcoupling", symmetric = "geometric")
round(coupling[c("p8", "p9", "p10"), c("p8", "p9", "p10")], 2)

## ----hyperevent---------------------------------------------------------------
H <- hyperevent_dominance(X, cites, tau = 2) # H[u, v] = 1 when u is dominated by v
H
dominance_layers(H)$status