Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Visualize al possible signed triads
library(signnet)
library(igraph)
library(ggraph)
library(patchwork)
triads <- c("003-000000", "012-0000P0", "012-0000N0",
"102-0000PP", "102-0000NP", "102-0000NN", "021C-0PP000",
"021C-0NP000", "021C-0PN000", "021C-0NN000", "021U-0P0P00",
"021U-0N0P00", "021U-0N0N00", "021D-P0P000", "021D-N0P000",
"021D-N0N000", "111U-0P00PP", "111U-0N00PP", "111U-0P00NP",
"111U-0P00PN", "111U-0N00NP", "111U-0N00PN", "111U-0P00NN",
"111U-0N00NN", "111D-P000PP", "111D-N000PP", "111D-P000NP",
"111D-P000PN", "111D-N000NP", "111D-N000PN", "111D-P000NN",
"111D-N000NN", "201-00PPPP", "201-00NPPP", "201-00PNPP",
"201-00NNPP", "201-00NPNP", "201-00NPPN", "201-00PNPN",
"201-00NNNP", "201-00NNPN", "201-00NNNN", "030C-P00PP0",
"030C-N00PP0", "030C-N00PN0", "030C-N00NN0", "030T-0P0PP0",
"030T-0N0PP0", "030T-0P0NP0", "030T-0P0PN0", "030T-0N0NP0",
"030T-0N0PN0", "030T-0P0NN0", "030T-0N0NN0", "120U-0P0PPP",
"120U-0N0PPP", "120U-0P0PNP", "120U-0N0NPP", "120U-0N0PNP",
"120U-0N0PPN", "120U-0P0PNN", "120U-0N0NNP", "120U-0N0PNN",
"120U-0N0NNN", "120D-P0P0PP", "120D-N0P0PP", "120D-P0P0NP",
"120D-N0N0PP", "120D-N0P0NP", "120D-P0N0NP", "120D-P0P0NN",
"120D-N0N0NP", "120D-N0P0NN", "120D-N0N0NN", "120C-0PP0PP",
"120C-0NP0PP", "120C-0PN0PP", "120C-0PP0NP", "120C-0PP0PN",
"120C-0NN0PP", "120C-0NP0NP", "120C-0NP0PN", "120C-0PN0NP",
"120C-0PN0PN", "120C-0PP0NN", "120C-0NN0NP", "120C-0NN0PN",
"120C-0NP0NN", "120C-0PN0NN", "120C-0NN0NN", "210-PPP0PP",
"210-NPP0PP", "210-PNP0PP", "210-PPN0PP", "210-PPP0NP",
"210-PPP0PN", "210-NNP0PP", "210-NPN0PP", "210-NPP0NP",
"210-NPP0PN", "210-PNN0PP", "210-PNP0NP", "210-PNP0PN",
"210-PPN0NP", "210-PPN0PN", "210-PPP0NN", "210-NNN0PP",
"210-NNP0NP", "210-NNP0PN", "210-NPN0NP", "210-NPN0PN",
"210-NPP0NN", "210-PNN0NP", "210-PNN0PN", "210-PNP0NN",
"210-PPN0NN", "210-NNN0NP", "210-NNN0PN", "210-NNP0NN",
"210-NPN0NN", "210-PNN0NN", "210-NNN0NN", "300-PPPPPP",
"300-NPPPPP", "300-NNPPPP", "300-NPNPPP", "300-PNNPPP",
"300-PPNPNP", "300-NNNPPP", "300-NNPNPP", "300-NPNPNP",
"300-PNNPPN", "300-NNNNPP", "300-NNNPNP", "300-NNNPPN",
"300-NPNPNN", "300-NNNNNP", "300-NNNNNN")
graph_from_triad <- function(x){
A <- matrix(0,3,3)
edge_seq <- strsplit(x,"-")[[1]][2]
edges <- strsplit(edge_seq,"")[[1]]
A[1,2] <- ifelse(edges[1]=="0",0,ifelse(edges[1]=="N",-1,1))
A[2,1] <- ifelse(edges[2]=="0",0,ifelse(edges[2]=="N",-1,1))
A[1,3] <- ifelse(edges[3]=="0",0,ifelse(edges[3]=="N",-1,1))
A[3,1] <- ifelse(edges[4]=="0",0,ifelse(edges[4]=="N",-1,1))
A[2,3] <- ifelse(edges[5]=="0",0,ifelse(edges[5]=="N",-1,1))
A[3,2] <- ifelse(edges[6]=="0",0,ifelse(edges[6]=="N",-1,1))
g <- graph_from_adjacency_matrix_signed(A,"directed")
g$name <- x
V(g)$y <- c(1,0,0)
V(g)$x <- c(0.5,0,1)
V(g)$name <- c("u","v","w")
g
}
gList <- lapply(triads,graph_from_triad)
pList <- lapply(seq_along(gList),function(i){
if(i!=1){
ggraph(gList[[i]],"manual",x = V(g)$x,y = V(g)$y)+
geom_edge_parallel(aes(edge_color=as.factor(sign)), n=2, end_cap=circle(9,"pt"), edge_width=1,
arrow=arrow(angle = 15, length = unit(0.15, "inches"), ends = "last", type = "closed"),
show.legend = FALSE)+
geom_node_point(shape=21,fill="white",color="black",size=8)+
geom_node_text(aes(label=name),size=6) +
scale_edge_color_manual(values = c(`-1` = "firebrick", `1` = "steelblue"))+
theme_graph()+
theme(plot.title = element_text(hjust=0.5,size=12))+
labs(title=gList[[i]]$name)+coord_fixed(clip = "off")
} else{
ggraph(gList[[i]],"manual",x = V(g)$x,y = V(g)$y)+
geom_node_point(shape=21,fill="white",color="black",size=8)+
geom_node_text(aes(label=name),size=6) +
scale_edge_color_manual(values = c(`-1` = "firebrick", `1` = "steelblue"))+
theme_graph()+
theme(plot.title = element_text(hjust=0.5,size=12))+
labs(title=gList[[i]]$name)+coord_fixed(clip = "off")
}
})
wrap_plots(pList,ncol = 6,byrow = TRUE)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment