PS8 JLBlack
JL Black
2022-11-10
ECO5315—Microeconomics and Networks, Fall 2022 Problem Set 8: Homophily, Affiliation and Structural Balance
Question 1: Affiliation Networks
(based on EK Chapter 4, Exercises 2 and 4)
- Use the sample code below to replicate the bipartite graph representing the affiliation network of boards of directors in Figure 4.4.
edges <- data.frame(from=c("John Doerr", "John Doerr", "Shirley Tilghman",
"Arthur Levinson", "Arthur Levinson", "Al Gore",
"Steve Jobs", "Steve Jobs", "Andrea Jung",
"Andrea Jung", "Susan Hockfield"),
to=c("Amazon", "Google", "Google",
"Google", "Apple", "Apple",
"Apple", "Disney", "Apple",
"GE", "GE"))
g <- graph.data.frame(edges, directed=FALSE)
V(g)$type <- bipartite_mapping(g)$type
V(g)$shape <- ifelse(V(g)$type, "circle", "rectangle")
L <- layout_as_bipartite(g)
L <- L[,c(2,1)] # flip bipartite graph to Left-Right
plot(g, layout = L, vertex.size = 40)
- A projected graph is a graph showing just people as nodes linked when the two people share a common focus. Use R to draw the projected graph of the affiliation network from part (a). The nodes will be the seven people linked if they serve on the same board.
edges <- data.frame(from=c("John Doerr", "John Doerr", "Shirley Tilghman",
"Arthur Levinson", "Arthur Levinson", "Al Gore",
"Steve Jobs", "Steve Jobs", "Andrea Jung",
"Andrea Jung", "Susan Hockfield"),
to=c("Amazon", "Google", "Google",
"Google", "Apple", "Apple",
"Apple", "Disney", "Apple",
"GE", "GE"))
g <- graph.data.frame(edges, directed=FALSE)
V(g)$type <- bipartite_mapping(g)$type
V(g)$shape <- ifelse(V(g)$type, "circle", "rectangle")
L <- layout_as_bipartite(g)
L <- L[,c(2,1)] # flip bipartite graph to Left-Right
plot(g, layout = L, vertex.size = 40)
projected_g <- bipartite_projection(g, multiplicity = TRUE)
projected_g## $proj1
## IGRAPH 531390b UNW- 7 10 --
## + attr: name (v/c), shape (v/c), weight (e/n)
## + edges from 531390b (vertex names):
## [1] John Doerr --Shirley Tilghman John Doerr --Arthur Levinson
## [3] Shirley Tilghman--Arthur Levinson Arthur Levinson --Al Gore
## [5] Arthur Levinson --Steve Jobs Arthur Levinson --Andrea Jung
## [7] Al Gore --Steve Jobs Al Gore --Andrea Jung
## [9] Steve Jobs --Andrea Jung Andrea Jung --Susan Hockfield
##
## $proj2
## IGRAPH c06d452 UNW- 5 4 --
## + attr: name (v/c), shape (v/c), weight (e/n)
## + edges from c06d452 (vertex names):
## [1] Amazon--Google Google--Apple Apple --Disney Apple --GEmembers <- projected_g$proj1
boards <- projected_g$proj2
plot(members)
#plot(boards)
#project to one mode
#https://rpubs.com/pjmurphy/317838
get.adjacency(g)## 12 x 12 sparse Matrix of class "dgCMatrix"## [[ suppressing 12 column names 'John Doerr', 'Shirley Tilghman', 'Arthur Levinson' ... ]]##
## John Doerr . . . . . . . 1 1 . . .
## Shirley Tilghman . . . . . . . . 1 . . .
## Arthur Levinson . . . . . . . . 1 1 . .
## Al Gore . . . . . . . . . 1 . .
## Steve Jobs . . . . . . . . . 1 1 .
## Andrea Jung . . . . . . . . . 1 . 1
## Susan Hockfield . . . . . . . . . . . 1
## Amazon 1 . . . . . . . . . . .
## Google 1 1 1 . . . . . . . . .
## Apple . . 1 1 1 1 . . . . . .
## Disney . . . . 1 . . . . . . .
## GE . . . . . 1 1 . . . . .get.adjacency(members)## 7 x 7 sparse Matrix of class "dgCMatrix"
## John Doerr Shirley Tilghman Arthur Levinson Al Gore Steve Jobs
## John Doerr . 1 1 . .
## Shirley Tilghman 1 . 1 . .
## Arthur Levinson 1 1 . 1 1
## Al Gore . . 1 . 1
## Steve Jobs . . 1 1 .
## Andrea Jung . . 1 1 1
## Susan Hockfield . . . . .
## Andrea Jung Susan Hockfield
## John Doerr . .
## Shirley Tilghman . .
## Arthur Levinson 1 .
## Al Gore 1 .
## Steve Jobs 1 .
## Andrea Jung . 1
## Susan Hockfield 1 .# as.matrix(g)
# ? project_to_one_mode(adj_mat = edges, mode = "rows")- Show the relative `importance’ of the seven people by ranking them using three different measures of centrality.
types <- V(g)$type ## getting each vertex `type` let's us sort easily
deg <- degree(g)
bet <- betweenness(g)
clos <- closeness(g)
eig <- eigen_centrality(g)$vector
cent_df <- data.frame(types, deg, bet, clos, eig)
cent_df[order(cent_df$type, decreasing = TRUE),] ## sort w/ `order` by `type`## types deg bet clos eig
## Amazon TRUE 1 0 0.02127660 0.1310248
## Google TRUE 3 26 0.03448276 0.5376694
## Apple TRUE 4 41 0.04347826 1.0000000
## Disney TRUE 1 0 0.02439024 0.2436903
## GE TRUE 2 10 0.02702703 0.3222097
## John Doerr FALSE 2 10 0.02702703 0.2959992
## Shirley Tilghman FALSE 1 0 0.02564103 0.2380007
## Arthur Levinson FALSE 2 28 0.04000000 0.6806533
## Al Gore FALSE 1 0 0.03030303 0.4426526
## Steve Jobs FALSE 2 10 0.03225806 0.5505227
## Andrea Jung FALSE 2 18 0.03448276 0.5852795
## Susan Hockfield FALSE 1 0 0.02127660 0.1426269V(g)$size <- degree(g)
V(g)$label.cex <- degree(g) * 0.7
plot(g, layout = layout_with_graphopt)
- Use R to draw the graph shown in Figure 4.20.
edges_fig4.20 <- data.frame(from=c("A", "A", "B",
"C", "D", "B"),
to=c("B", "D", "C",
"D", "E", "E"))
g_4.20 <- graph.data.frame(edges_fig4.20, directed=FALSE)
V(g_4.20)$type <- bipartite_mapping(g_4.20)$type
V(g_4.20)$shape <- ifelse(V(g_4.20)$type, "circle", "square")
L <- layout_as_bipartite(g_4.20)
# flip bipartite graph to Left-Right
plot(g_4.20, vertex.size = 30)
- Give examples of two different affiliation networks with the same people but different set of foci that would give the same projected graph as in Figure 4.20. Use R to draw these two affiliation networks as bipartite graphs.
Answer: Fig4.20a Jared, Meade, and Alonso all connect to the foci Micro and HealthEcon.
edges_fig4.20a <- data.frame(from=c("Jared", "Jared",
"Alonso", "Alonso",
"Meade", "Meade"),
to=c("Micro", "HealthEcon", "Micro",
"HealthEcon", "Micro",
"HealthEcon"))
g_4.20a <- graph.data.frame(edges_fig4.20a, directed=FALSE)
V(g_4.20a)$type <- bipartite_mapping(g_4.20a)$type
V(g_4.20a)$shape <- ifelse(V(g_4.20a)$type, "circle", "rectangle")
L <- layout_as_bipartite(g_4.20a)
L <- L[,c(2,1)] # flip bipartite graph to Left-Right
plot(g_4.20a, layout = L, vertex.size = 25)
Answer: Fig4.20b Dr. Phan, Dr. Richards, and Dr. Kim all connect to the foci Health Services Research (HSR) and Hankamer.
edges_fig4.20b <- data.frame(from=c("Dr.Phan", "Dr.Phan", "Dr.Richards",
"Dr.Richards", "Dr.Kim", "Dr.Kim"),
to=c("HSR", "Hankamer", "HSR", "Hankamer", "HSR", "Hankamer"))
g_4.20b <- graph.data.frame(edges_fig4.20b, directed=FALSE)
V(g_4.20b)$type <- bipartite_mapping(g_4.20b)$type
V(g_4.20b)$shape <- ifelse(V(g_4.20b)$type, "circle", "rectangle")
L <- layout_as_bipartite(g_4.20b)
L <- L[,c(2,1)] # flip bipartite graph to Left-Right
plot(g_4.20b, layout = L, vertex.size = 32, vertex.color="gray")
- Use R to draw the graph shown in Figure 4.22.
edges_fig4.22 <- data.frame(from=c("A", "A", "A", "B", "B", "B", "D", "D", "C", "C"),
to=c("B", "E", "C", "E", "F", "D", "F", "C", "E", "F"))
g_4.22 <- graph.data.frame(edges_fig4.22, directed=FALSE)
plot(g_4.22, vertex.size = 20, vertex.color="lightgreen")
- Use R to draw an affiliation network with Figure 4.22 as the projected graph. Explain why any affiliation network would need at least four foci to generate 4.22 as the projected graph.
Answer: It will take at least 4 foci to have enough separate places for affiliations to form. Fewer foci would mean more affiliations between the people named in the affiliation network.
edges_fig4.22 <- data.frame(from=c("Jared", "Jared", "Jared",
"Meade", "Meade", "Meade",
"Alonso", "Jay", "Alonso", "Jay"),
to=c("Meade", "Patrick", "Alonso", "Patrick", "Josh", "Jay", "Josh", "Alonso", "Patrick", "Josh"))
g_4.22 <- graph.data.frame(edges_fig4.22, directed=FALSE)
plot(g_4.22, vertex.size = 40, vertex.color="lightblue")
##Question 2: Homophily
- Run the sample code below to show attributes of nodes and visualize homophily and inverse homophily. Are the values for assortativity() by gender and race as you would expect for the network as well as assortativity by some random trait?
Answer: The male to female edges are what I would expect given some level of homophilic preference. However, the race and random edges are not what I expected. I assume though, that if the same random assignment were run multiple times then the result would show up with more homophilic edges as per the Schelling model.
nodes <- data.frame(v=c(1,2,3,4,5,6,7,8,9,10),
gender=c("F","F","F", "F","F","F", "M", "M", "M", "M"))
nodes## v gender
## 1 1 F
## 2 2 F
## 3 3 F
## 4 4 F
## 5 5 F
## 6 6 F
## 7 7 M
## 8 8 M
## 9 9 M
## 10 10 Medges <- data.frame(from=c(2, 1, 1, 2, 1, 3, 1, 4, 4, 5, 7, 8, 7, 2, 2, 4, 6, 6, 10, 10),
to=c(4, 2, 3, 3, 4, 4, 5, 5, 6, 6, 8, 9, 9, 8, 7, 7, 7, 9, 9, 8))
edges## from to
## 1 2 4
## 2 1 2
## 3 1 3
## 4 2 3
## 5 1 4
## 6 3 4
## 7 1 5
## 8 4 5
## 9 4 6
## 10 5 6
## 11 7 8
## 12 8 9
## 13 7 9
## 14 2 8
## 15 2 7
## 16 4 7
## 17 6 7
## 18 6 9
## 19 10 9
## 20 10 8#?graph_from_data_frame
g <- graph_from_data_frame(d=edges, vertices=nodes, directed = FALSE)
values <- as.numeric(factor(V(g)$gender)) # code gender as a number
?V
V(g)$color <- ifelse(V(g)$gender == "M", "light blue", "pink")
plot(g,
vertex.size = 20,
vertex.label.cex = 1)
assortativity(g, values)## [1] 0.4666667# add race attribute
race <- data.frame(v=c(1,2,3,4,5,6,7,8,9,10),
race=c("B","B","W", "B","W","W", "W", "B", "B","W"))
nodes2 <- left_join(nodes, race, by="v")
g2 <- graph_from_data_frame(d=edges, vertices=nodes2, directed = FALSE)
values <- as.numeric(factor(V(g2)$race))
V(g2)$color <- ifelse(V(g2)$race == "B", "gray", "white")
plot(g2,
vertex.size = 20,
vertex.label.cex = 1)
assortativity(g2, values)## [1] -0.3299233# add a random attribute to the node
set.seed(15) # set seed so the random numbers are repeatable
V(g2)$random <- rnorm(10, mean=0, sd=1) # create a node trait that varies randomly across nodes
V(g2)$color <- ifelse(V(g2)$random < 0, "green", "gold")
plot(g2,
vertex.size = 20,
vertex.label.cex = 1)
assortativity(g2, V(g2)$random)## [1] -0.05224505- Refer to the code for the Karate club in the last problem set. Based on the communities generated by the partitioning operations, add a trait for each of the nodes called `Size’ taking values “L” and “S” so that the network exhibits homophily. Report the assortativity by Size.
Karate_Links <- data.matrix(read.table(file = "soc-karate.mtx", skip = 1, header = FALSE))
fig313_Graph <- graph_from_edgelist(Karate_Links, directed = FALSE)
plot(fig313_Graph)
fig313c <- cluster_leading_eigen(fig313_Graph)
modularity(fig313c)## [1] 0.3934089membership(fig313c)## [1] 1 3 3 3 1 1 1 3 2 2 1 1 3 3 2 2 1 3 2 3 2 3 2 4 4 4 2 4 4 2 2 4 2 2V(fig313_Graph)$Size <- ifelse(membership(fig313c)<3, "S", "L")
values <- as.numeric(factor(V(fig313_Graph)$Size))
assortativity(fig313_Graph, values)## [1] 0.3982895fig313c <- cluster_walktrap(fig313_Graph)
modularity(fig313c)## [1] 0.3532216membership(fig313c)## [1] 1 1 2 1 5 5 5 1 2 2 5 1 1 2 3 3 5 1 3 1 3 1 3 4 4 4 3 4 2 3 2 2 3 3V(fig313_Graph)$Size <- ifelse(membership(fig313c)<3, "S", "L")
values <- as.numeric(factor(V(fig313_Graph)$Size))
assortativity(fig313_Graph, values)## [1] 0.5381579fig313c <- cluster_edge_betweenness(fig313_Graph)
modularity(fig313c)## [1] 0.4012985membership(fig313c)## [1] 1 1 2 1 3 3 3 1 4 5 3 1 1 1 4 4 3 1 4 1 4 1 4 4 2 2 4 2 2 4 4 2 4 4V(fig313_Graph)$Size <- ifelse(membership(fig313c)<3, "S", "L")
values <- as.numeric(factor(V(fig313_Graph)$Size))
assortativity(fig313_Graph, values)## [1] 0.5640309plot(fig313c, fig313_Graph)
V(fig313_Graph)## + 34/34 vertices, from 62d88f9:
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [26] 26 27 28 29 30 31 32 33 34values <- as.numeric(factor(V(fig313_Graph)$Size))
#can I plot with colors based on L or S homophily?
#plot(fig313_Graph,
# vertex.size = ifelse(membership(fig313c)$Size == "S", "light green", "light gray")
# vertex.label.cex = 1)
assortativity(fig313_Graph, values)## [1] 0.5640309plot(fig313c, fig313_Graph)
- Add a trait called “Experience” that takes values “O” and “N” to the nodes so that the network exhibits inverse homophily by Experience. Report the assortativity by Experience.
Karate_Links <- data.matrix(read.table(file = "soc-karate.mtx", skip = 1, header = FALSE))
fig313_Graph <- graph_from_edgelist(Karate_Links, directed = FALSE)
fig313c <- cluster_leading_eigen(fig313_Graph)
modularity(fig313c)## [1] 0.3934089membership(fig313c)## [1] 1 3 3 3 1 1 1 3 2 2 1 1 3 3 2 2 1 3 2 3 2 3 2 4 4 4 2 4 4 2 2 4 2 2V(fig313_Graph)$Size <- ifelse(membership(fig313c)<4, "O", "N")
values <- as.numeric(factor(V(fig313_Graph)$Exp))
V(fig313_Graph)$color <- ifelse(V(fig313_Graph)$Exp == "O", "green", "red")## Warning in length(vattrs[[name]]) <- vc: length of NULL cannot be changedfig313c <- cluster_walktrap(fig313_Graph)
modularity(fig313c)## [1] 0.3532216 membership(fig313c)## [1] 1 1 2 1 5 5 5 1 2 2 5 1 1 2 3 3 5 1 3 1 3 1 3 4 4 4 3 4 2 3 2 2 3 3V(fig313_Graph)$Size <- ifelse(membership(fig313c)<4, "O", "N")
values <- as.numeric(factor(V(fig313_Graph)$Exp))
fig313c <- cluster_edge_betweenness(fig313_Graph)
modularity(fig313c)## [1] 0.4012985 membership(fig313c)## [1] 1 1 2 1 3 3 3 1 4 5 3 1 1 1 4 4 3 1 4 1 4 1 4 4 2 2 4 2 2 4 4 2 4 4V(fig313_Graph)$Size <- ifelse(membership(fig313c)<4, "O", "N")
values <- as.numeric(factor(V(fig313_Graph)$Exp))
plot(fig313c, fig313_Graph)
V(fig313_Graph)## + 34/34 vertices, from d269b1b:
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [26] 26 27 28 29 30 31 32 33 34values <- as.numeric(factor(V(fig313_Graph)$Exp))
# Not sure what is missing from assortativity yet.
# assortativity(fig313_Graph, values)##Question 3: Structural Balance (based on EK Chapter 5, Exercises 2 3)
- From the sample code draw the balanced network shown in Figure 5.19. Show two ways in which a fourth node D can join the network and the network retains balance. Use R to draw these two networks.
from <- c("C", "A", "B")
to <- c("A", "B", "C")
names <- c("A", "B", "C")
x <- c(0, 2, 1)
y <- c(0, 0, 1/sqrt(3))
edges <- cbind.data.frame(from,to)
nodes <- cbind.data.frame(names, x, y)
g <- graph_from_data_frame(d=edges, vertices=nodes, directed = FALSE)
V(g)## + 3/3 vertices, named, from 34fa4c1:
## [1] A B CE(g)## + 3/3 edges from 34fa4c1 (vertex names):
## [1] A--C A--B B--CE(g)$label="+"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
E(g)$label="-"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
E(g)[1]$label="+"
E(g)[2]$label="-"
E(g)[3]$label="-"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
a. Show two ways in which a fourth node D can join the network and the
network retains balance. Use R to draw these two networks. With forth
nodes version 1.
from <- c("C", "A", "B", "D", "C")
to <- c("A", "B", "D", "C", "B")
names <- c("A", "B", "C", "D")
x <- c(0, 2, 1, 2)
y <- c(0, 0, 1, 2)
edges <- cbind.data.frame(from,to)
nodes <- cbind.data.frame(names, x, y)
g <- graph_from_data_frame(d=edges, vertices=nodes, directed = FALSE)
V(g)## + 4/4 vertices, named, from 1e66147:
## [1] A B C DE(g)## + 5/5 edges from 1e66147 (vertex names):
## [1] A--C A--B B--D C--D B--CE(g)$label="+"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 30,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
E(g)$label="-"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 30,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
E(g)[1]$label="+"
E(g)[2]$label="-"
E(g)[3]$label="-"
E(g)[4]$label="+"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 30,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
- Show two ways in which a fourth node D can join the network and the network retains balance. Use R to draw these two networks.
With forth nodes version 2.
from <- c("A", "A", "B", "4", "4")
to <- c("B", "C", "C", "A", "B")
names <- c("A", "B", "C", "4")
x <- c(0, 2, 1, 1)
y <- c(0, 0, 1, 2)
edges <- cbind.data.frame(from,to)
nodes <- cbind.data.frame(names, x, y)
g <- graph_from_data_frame(d=edges, vertices=nodes, directed = FALSE)
V(g)## + 4/4 vertices, named, from 37ac12f:
## [1] A B C 4E(g)## + 5/5 edges from 37ac12f (vertex names):
## [1] A--B A--C B--C A--4 B--4E(g)$label="+"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
E(g)$label="-"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
E(g)[1]$label="+"
E(g)[2]$label="-"
E(g)[3]$label="-"
E(g)[4]$label="+"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
- Use R to draw the weakly balanced network in Figure 5.21. Applying the Characterization of Weakly Balanced Networks, describe in words the different ways that a fourth node D can join and the network still retains weak balance or explain why this is impossible. If possible, use R to draw one possible network.
Answer: As shown in section a above a forth node “4”could be added that connects to A and B. If the links between A and “4” and between B and “4” are negative then the resulting figure remains weakly balanced. Alternatively, “4” could be enemies with A,B, and C while A,B, and C become freinds with eachother. This would also be a balanced network.
from <- c("C", "A", "B")
to <- c("A", "B", "C")
names <- c("A", "B", "C")
x <- c(0, 2, 1)
y <- c(0, 0, 1/sqrt(3))
edges <- cbind.data.frame(from,to)
nodes <- cbind.data.frame(names, x, y)
g <- graph_from_data_frame(d=edges, vertices=nodes, directed = FALSE)
V(g)## + 3/3 vertices, named, from 8ec589e:
## [1] A B CE(g)## + 3/3 edges from 8ec589e (vertex names):
## [1] A--C A--B B--CE(g)[1]$label="-"
E(g)[2]$label="-"
E(g)[3]$label="-"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
- Use R to draw the unbalanced network in Figure 5.22.
Answer: Here is the Figure from 5.22.
from <- c("C", "A", "B")
to <- c("A", "B", "C")
names <- c("A", "B", "C")
x <- c(0, 2, 1)
y <- c(0, 0, 1/sqrt(3))
edges <- cbind.data.frame(from,to)
nodes <- cbind.data.frame(names, x, y)
g <- graph_from_data_frame(d=edges, vertices=nodes, directed = FALSE)
V(g)## + 3/3 vertices, named, from 4cd1443:
## [1] A B CE(g)## + 3/3 edges from 4cd1443 (vertex names):
## [1] A--C A--B B--CE(g)[1]$label="+"
E(g)[2]$label="-"
E(g)[3]$label="+"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")
C. How many ways can a fourth node D join the network so that it is not involved in any unbalanced triangles? If it is possible, use R to draw such a network.
Answer: Here is 5.22 with a forth node attached in a balanced way. There are 5 other ways to add a forth node without involving any unbalanced triangles.
from <- c("A", "A", "B", "4", "4")
to <- c("B", "C", "C", "A", "B")
names <- c("A", "B", "C", "4")
x <- c(0, 2, 1, 1)
y <- c(0, 0, 1, 2)
edges <- cbind.data.frame(from,to)
nodes <- cbind.data.frame(names, x, y)
g <- graph_from_data_frame(d=edges, vertices=nodes, directed = FALSE)
V(g)## + 4/4 vertices, named, from 789ab26:
## [1] A B C 4E(g)## + 5/5 edges from 789ab26 (vertex names):
## [1] A--B A--C B--C A--4 B--4E(g)[1]$label="+"
E(g)[2]$label="-"
E(g)[3]$label="+"
E(g)[4]$label="+"
E(g)[5]$label="+"
plot(g, layout=as.matrix(nodes[,c("x","y")]),
vertex.size = 50,
vertex.color = "gold",
vertex.label.color = "blue",
vertex.label.cex = 2,
edge.arrow.size = 1,
edge.width = 3,
edge.color = "gray",
edge.label.x = c(-1/sqrt(3)-0.05, 0, 1/sqrt(3)+0.05),
edge.label.y = c(0, -1.1, 0),
edge.label.cex = 2,
edge.label.color = "black")