Plot network ties by group in R

Question

I have a dataset of hockey players and who they fight with during the game. I want to collapse all the players into their teams and plot the network with the edges connecting team to team, weighted by how many times players fought between teams.

I created the graph with a node file an an edges file. The node file contains each player and the team they belong to. Example:

NODE FILE:

name   team
Joe    anaheim_ducks
Greg   anaheim_ducks
Marc   anaheim_ducks
Chad   sanjose_sharks
Ed     sanjose_sharks
Perry  sanjose_sharks
Jack   vegas_goldenknights
Dan    vegas_goldenknights
Devin  vegas_goldenknights

EDGE FILE:

source  target
Perry   Jack
Devin   Joe
Jack    Chad
Greg    Jack
Ed      Marc
Dan     Joe

I want either a file or a way to plot the network just based on teams. The edgefile would look like:

team_1                team_2               number_fights
anaheim_ducks         vegas_goldenknights  3
vegas_goldenknights   sanjose_sharks       2
sanjose_sharks        anaheim_ducks        1

Pasted below is the code I have so far:

nhl_nodes <- read_xlsx("nhl_nodes.xlsx")
nhl_edges <- read_xlsx("nhl_edges.xlsx")

ncolor <- 31
nhl_color <- randomcoloR::distinctColorPalette(k = 31)
nhl_color <- as.data.frame(nhl_color)

teams <- as.data.frame(unique(nhl_nodes$team)) %>%
         rename(team = "unique(nhl_nodes$team)") %>%
         cbind(., nhl_color)

nhl_nodes$color <- NA

nhl_nodes <- left_join(nhl_nodes , teams) %>%
             rename(color = nhl_color)


nhl_g<-graph_from_data_frame(d = nhl_edges, vertices = nhl_nodes, 
                             directed=F)

iso <- V(nhl_g)[degree(nhl_g)==0]
nhl_g_test <- delete.vertices(nhl_g, iso)

V(nhl_g_test)$vertex_degree <-  degree(nhl_g_test)

layout=layout.fruchterman.reingold(nhl_g_test)

plot(nhl_g_test, vertex.size=V(nhl_g_test)$vertex_degree,
                 vertex.label=NA)

Answer 1

One could use the contract.vertices function from the igraph package on nhl_g.

nhl_nodes <- data.frame(name, team) 
nhl_edges <- data.frame(source, target)
nhl_g <- graph_from_data_frame(edgelist, directed = F, vertices = vertices)
E(nhl_g )$weight <- 1  # one edgeweight per "fight"
nhl_g_con <- contract.vertices(nhl_g , mapping = as.factor(V(nhl_g )$team),
                                       vertex.attr.comb = list(team = "first", name = "concat"))

Here I generate a new graph object and contract the vertices based on the team category. The argument vertex.attr.comb states that for the team-vector only the first element should be used and that the name-vector of the players should be pasted together (concatenated). The result can be seen below.

Note that this graph has multiple edges between nodes and that the player's names are displayed and not the corresponding teams. This is fixed in the following snippet:

nhl_g_simple <- simplify(nhl_g_con)
par(mfrow = c(1,2))  # plotting parameters
plot(nhl_g_con, main = "nhl_g_con")
plot(nhl_g_simple , edge.label = E(nhl_g_simple )$weight, 
                    vertex.label = V(nhl_g_simple)$team, main = "nhl_g_simple")

The resulting two graphs in comparison:

And from here one can also extract the desired data.frame:

> V(nhl_g_simple)$name <- V(nhl_g_simple)$team
> get.data.frame(nhl_g_simple)
            from                  to weight
1  anaheim_ducks      sanjose_sharks      1
2  anaheim_ducks vegas_goldenknights      3
3 sanjose_sharks vegas_goldenknights      2

I hope this helps.

PS: Please consider using dput() to share your data, this makes it easier for people to use it.