Introduction

For this research I wanted to analyze how well connected the corporate boards of American corporations are and in which ways. To accomplish this goal I have gathered the complete board memberships of nine large companies: Netflix, Amazon, Walmart, Exxon, Berkshire Hathaway, Apple, Nvidia, Coca-cola, and JPMorgan Chase. This list of individuals was expanded by finding and documenting all of the other corporate board memberships those people also hold concurrently and have held in the past. The goal of this past-inclusive data set is to better track track the influence of corporate culture and capture the ongoing relations which are not completely severed when a director changes boards.

This data was collected using https://www.marketscreener.com/.

Network Information

Order = 112

Size = 859

Undirected Network

No other Attributes encoded

This analysis aims to identify the most highly connected inner network

Loading Data and Getting Started

Formatting the Network for Two-Mode analysis

#splits the network by type into two modes
V(g)$type <- bipartite_mapping(g)$type

# Optional: Assign colors for visualization (FALSE=People, TRUE=Companies)
V(g)$color <- ifelse(V(g)$type, "pink", "lightblue")
V(g)$shape <- ifelse(V(g)$type, "square", "circle")


#plot the network for diagnostics
igraph_options(plot.layout=layout_with_kk, edge.arrow.size=0.1,
               vertex.label.cex=0.000085, par(mar=c(0,0,0,0)))

plot(g, 
     vertex.label.cex = 0.0000065, 
     vertex.label.color = "black",
     vertex.size = 4)

Converting from two modes to one

this does make anyone who shares a board with anyone else have the maximum number of ties with the other board members, keep in mind when doing density analysis

bipartite_matrix <- as_biadjacency_matrix(g)

matrix_prod <- bipartite_matrix %*% t(bipartite_matrix)
#flip the order in the multiplication for the company matrix


#removes the diagnals
diag(matrix_prod) <- 0



#create a graph from the matrix product
People_overlap <- graph_from_adjacency_matrix(matrix_prod, 
                                        mode = "undirected", 
                                        weighted = TRUE)

#remove isolates from people overlap
People_overlap <- igraph::delete_vertices(People_overlap, V(People_overlap)[igraph::degree(People_overlap) == 0])

K-Core

#k-cores in igraph

kcore <- coreness(People_overlap)    # Extract k-cores as a data object.
V(People_overlap)$core <- kcore      # Add the cores as a vertex attribute

igraph_options(plot.layout=layout_with_kk, edge.arrow.size=0.1,
               vertex.label.cex=0.00000055, par(mar=c(0,0,0,0)))

plot.igraph(People_overlap, 
            vertex.size = 7,
            vertex.color=V(People_overlap)$core) # plot

table(kcore)
## kcore
##  9 11 12 13 15 
## 15 22 25 34 16

extracting the largest k-core that is part of the network

g13c <- induced_subgraph(People_overlap, kcore==13)

igraph_options(plot.layout=layout_with_kk, edge.arrow.size=0.1,
               vertex.label.cex=0.55, par(mar=c(0,0,0,0)))

plot.igraph(g13c, 
            vertex.size = 7,
            vertex.label.color = "black",
            vertex.color=V(People_overlap)$core) # plot

Write something here about the companies and people involved in this densest of cores

Centrality Scores for the whole graph

#degree and printing the top 10
Degree <- degree(People_overlap)

top10degree <- head(sort(Degree, decreasing = TRUE), 10)

top10degree <- as.data.frame(top10degree)

top10degree
####################
#eigenvector

Eig <- eigen_centrality(People_overlap)$vector
Hub <- hub_score(People_overlap)$vector
Authority <- authority_score(People_overlap)$vector
Betweenness <- betweenness(People_overlap)
Closeness <- closeness(People_overlap)
## Reach at k=2
Reach_2 <- (ego_size(People_overlap, 2)-1)/(vcount(People_overlap)-1)

## Reach at k=3
Reach_3 <- (ego_size(People_overlap, 3)-1)/(vcount(People_overlap)-1)

centralities <- cbind(Degree, Eig, Hub, Authority, Closeness, Reach_2, Reach_3, Betweenness)

kable(head(centralities, 10), digits = 3, caption = "Centralities")
Centralities
Degree Eig Hub Authority Closeness Reach_2 Reach_3 Betweenness
Warren Buffett 24 0.909 0.909 0.909 0.004 0.595 0.919 38.348
Kenneth Chenault 15 0.413 0.413 0.413 0.004 0.568 0.919 45.455
Wally Weitz 14 0.410 0.410 0.410 0.004 0.405 0.901 4.402
Steve Burke 30 0.891 0.891 0.891 0.005 0.892 1.000 407.073
Charlotte Guyman 17 0.448 0.448 0.448 0.004 0.640 0.919 82.240
Sue Decker 17 0.530 0.530 0.530 0.004 0.604 0.910 28.247
Chris Davis 24 0.851 0.851 0.851 0.004 0.595 0.919 46.724
Tom Murphy 13 0.385 0.385 0.385 0.003 0.405 0.901 0.368
Meryl Witmer 13 0.385 0.385 0.385 0.003 0.405 0.901 0.368
Gregory Abel 15 0.458 0.458 0.458 0.004 0.486 0.910 27.595

make this table look good (filtering for only the top 10 in each category). interpret the meaning of these numbers within the network

Girvan-Neuman (Edge Betweenness)

eb <- cluster_edge_betweenness(People_overlap)

V(People_overlap)$group <- membership(eb) # assign membership to vertices

sizes(eb)
## Community sizes
##  1  2  3  4  5  6  7  8 
## 24 14 10 11 13 13 15 12
g_eb1 <- induced_subgraph(People_overlap, V(People_overlap)$group==1) # extract nodes in group 1

g_eb2 <- induced_subgraph(People_overlap, V(People_overlap)$group==2) # extract nodes in group 2

g_eb4 <- induced_subgraph(People_overlap, V(People_overlap)$group==4) # extract nodes in group 4

igraph_options(plot.layout=layout_with_kk, edge.arrow.size=0.1,
               vertex.label.cex=0.75, par(mar=c(0,0,0,0)))
plot(g_eb1)

plot(g_eb2)

plot(g_eb4)

plot(eb, People_overlap,
     vertex.color="white",
     vertex.label.cex=0.0015,
     vertex.size = 4,
     par(mar = c(1, 1, 4, 1)),
     layout = layout_with_kk, 
     main="Max Modularity Solution")

add labels to each of these groups for readability, interepret the meaning of the groupings

Comparing Louvain to Girman-Neuman

lv <- cluster_louvain(People_overlap)

igraph_options(plot.layout=layout_with_fr, 
               edge.arrow.size=0.1,
               vertex.label.cex=0.5,
               par(mar=c(0,0,0,0)))
plot(lv,
     People_overlap,
     vertex.size = 5)

Bicomponents

dg <- decompose(People_overlap, mode="weak", 
                min.vertices = 5)

max.g <- which.max(sapply(dg, vcount))
g2 <- dg[[1]]
#g3 <- dg[[2]]

igraph_options(plot.layout=layout_with_kk, edge.arrow.size=0.1, vertex.size=4,
               vertex.label.cex=0.75, par(mar=c(0,0,0,0)))
plot(g2)

#plot(g3)

the largest bicomponent is basically the whole graph, so not very useful, but the second largest is exxon’s boards and their connections. which is notably isolated from the rest of the network.

Articulation Points

g %>%
  articulation_points() %>%
  as.list() %>%
  names() %>%
  as.data.frame() %>%
  `colnames<-`("Cut Points")
V(g)$color = ifelse(V(g) %in%
                    articulation_points(g),   
                    "red", "lightblue")
igraph_options(plot.layout=layout_with_kk, edge.arrow.size=0.1, vertex.size=4,
               vertex.label.cex=0.75, par(mar=c(0,0,0,0)))

plot(g, vertex.label.cex=.000005, edge.width = 1)

Burts Constraint

const <- constraint(People_overlap)
invConstraint <- 1.125 - const  # (Inverse constraint = brokerage potential)
head(sort(const, decreasing = TRUE),7)
##   Harvey Jones   Mark Stevens     Tench Coxe Robert Burgess   Stephen Neal 
##      0.3164588      0.3161251      0.3161251      0.3161251      0.3161251 
##   Persis Drell    John Dabiri 
##      0.3161251      0.3161251