The works of Mark Lombardi were known for their complex network, representing a web of conspiracy. They were originally created as pieces of art to tell an interesting story. However, they also represent a method for visualizing complex networks in an aesthetic way.
To begin, we will need to load in a few packages. Of course there is the lombardi package, but we also will need tidyverse for some data preparation, and ggforce to help in generating the visualization.
library(lombardi)
library(tidyverse)
library(ggforce)We begin by setting the maximum size of the graph. Then the node IDs are all placed in groups to create the individual arcs of the Lombardi style graph. We can then use locate_nodes() on each row and get a set of coordinates. These are the coordinates to place each node on the graph.
max_ratio <- 34
# initialization of nodes
nodes <- tibble(id = 1, x = 0, y = max_ratio)
# Aqui vamos metiendo los nodos y los arcos en donde los vamos a localizar
#ENG: Here we are putting the nodes and the arcs where we are going to locate them
nodes_partial <- tibble(ids = list(c(1,2,3,4,38)), x0 = 0, y0 = 0, range = 2 * pi) %>%
add_row(ids = list(c(3,5,6,7,41)), x0 = 25, y0 = -38, range = - pi / 2.95) %>%
add_row(ids = list(c(1,12,13,14,15,16,37,36,35,34,33,32,31)), x0 = (-15), y0 = 0, range = -2 * pi / 2.7) %>%
add_row(ids = list(c(12,17,18,19,20)), x0 = 8, y0 = -1, range = pi / 1.95)
#Locate each node
for (i in 1:nrow(nodes_partial)){
row <- nodes_partial %>% slice(i)
nodes_to_add <- locate_nodes(row$ids, row$x0, row$y0, row$range)
nodes %>% bind_rows(nodes_to_add) -> nodes
}We start preparing the edge list by filtering out the bidirectional edges. These will be added back into the graph later. For now it is easier to add the main edges that are unidirectional.
# Calculamos los edges de los:
# type == "main", direction == 1
# type == "sub"
# filter Info_Viz_Edge_List to those nodes at nodes
Info_Viz_Edge_List %>%
filter((type == "main" & direction == 1) | type == "sub") -> Info_Viz_Edge_List_filtered
# Add center of the edge from nodes_partial
Info_Viz_Edge_List_filtered %>%
rowwise() %>%
mutate(ids = list(c(from, to))) %>%
ungroup() -> Info_Viz_Edge_List_listNow we can take the edge list and start adding the coordinates to form the arcs the edges will form. First we add some center points to
edges <- tibble(from = numeric(),
to = numeric(),
type = character(),
direction = integer(),
x0 = numeric(),
y0 = numeric())
for(i in 1:nrow(Info_Viz_Edge_List_list)){
Info_Viz_Edge_List_list %>% slice(i) -> fila
fila %>% pull(ids) %>% unlist -> ids_vec_edges
match <- FALSE
j <- 0
while(!match & j < nrow(nodes_partial)){
j <- j + 1
ids_vec_edges_partial <- nodes_partial %>% slice(j) %>% pull(ids) %>% unlist
if(length(setdiff(ids_vec_edges, ids_vec_edges_partial)) == 0) {
i1 <- which(ids_vec_edges[1] == ids_vec_edges_partial)
i2 <- which(ids_vec_edges[2] == ids_vec_edges_partial)
if((i2 - i1) == 1 | j == 1) match <- TRUE
}
}
if(match){
select(fila, from, to, type, direction) %>%
bind_cols(nodes_partial %>% slice(j) %>% select(x0, y0)) %>%
bind_rows(edges) -> edges
} else
{
select(fila, from, to, type, direction) %>%
bind_cols(tibble(x0 = NA, y0 = NA)) %>%
bind_rows(edges) -> edges
}
}edges %>%
inner_join(nodes, by = c("from" = "id")) %>%
inner_join(nodes, by = c("to" = "id"), suffix = c("ini", "end")) -> edges_xy
# Fill in NA with cuasi-inf centers
# first of all check if there is a table with rules for locate the center
single_arcs <- tibble(from = 35, to = 16, dist = 3) %>%
add_row(from = 15, to = 5, dist = 7) %>%
add_row(from = 6, to = 15, dist = -13) %>%
add_row(from = 34, to = 19, dist = -28) %>%
add_row(from = 7, to = 6, dist = -8)
edges_xy %>%
left_join(single_arcs, by = c("from", "to")) %>%
mutate(x0 = case_when(is.na(x0) ~ (xini + xend)/2 + coalesce(dist, 1000)*cos((atan2(yend-yini, xend-xini)+pi/2)),
TRUE ~ x0),
y0 = case_when(is.na(y0) ~ (yini + yend)/2 + coalesce(dist, 1000)*sin((atan2(yend-yini, xend-xini)+pi/2)),
TRUE ~ y0)) -> edges_xyNow we create the data frame edges_points which will be used to define the arc for every edge.
edges_xy %>%
split(seq(nrow(.))) %>%
lapply(function(row) arco(row$xini,
row$yini,
row$xend,
row$yend,
row$x0,
row$y0,
h = 0) %>%
mutate(type = row$type,
direction = row$direction,
from = row$from,
to = row$to)) %>%
bind_rows(.id = "edge_id") %>%
mutate(edge_id = as.numeric(edge_id)) -> edges_points1
max_id <- max(edges_points1$edge_id)
Info_Viz_Edge_List %>%
filter(type == "main", direction == 2) %>%
split(seq(nrow(.))) %>%
lapply(function(row){
edges_points1 %>%
filter(from == row %>% pull(to),
to == row %>% pull(from),
type == "main",
direction == 1) %>%
map_df(rev) %>%
select(edge_id, x, y, part) %>%
bind_cols(select(row, type, direction, from, to)) %>%
mutate(edge_id = edge_id + max_id)
}) %>% bind_rows() -> edges_points2
edges_points1 %>%
bind_rows(edges_points2) -> edges_pointsAnd finally, before we create the visualization, we can create dataframes to define how to draw the arrows on the edges.
Info_Viz_Edge_List %>%
filter((type == "main" & direction == 1) | (type == "sub")) %>%
anti_join(Info_Viz_Edge_List %>%
filter(type == "main" , direction == 2) %>%
rename(from = to, to = from) %>%
select(to, from),
by = c("from", "to")) %>%
mutate(fraction = 0.5) -> arrows_centered
Info_Viz_Edge_List %>%
anti_join(arrows_centered,
by = c("from", "to")) %>%
mutate(fraction = 0.65) -> arrows_double
#### hasta este punto para seguir luego/Users/afriedman/Dropbox/My Mac (MacBook-Pro.local)/Desktop/inputs.R
# edges_points %>%
# inner_join(bind_rows(arrows_centered, arrows_double),
# by = c("type", "direction", "from", "to")) %>%
# group_by(edge_id) %>%
# group_split() %>%
# lapply(function(df) arrow(df, l = 1.175, f = df %>% slice(1) %>% pull(fraction))) %>%
# bind_rows() -> arrows_points
edges_points %>%
inner_join(nodes, by = c("to" = "id"),
suffix = c("", "_to")) %>%
inner_join(labels, by = c("to" = "id")) %>%
group_by(edge_id) %>%
group_split() %>%
lapply(function(df) arrow(df, l = 1.175)) %>%
bind_rows() -> arrows_points##Generate the Plot
ggplot() +
geom_path(aes(x,y, group = edge_id),
data = edges_points %>% filter(type == "main",
direction == 1,
part == "edge"),
lwd = 0.5) +
geom_path(aes(x,y, group = edge_id),
data = edges_points %>% filter(type == "sub",
part == "edge"),
linetype = "dashed",
lwd = 0.5) +
geom_polygon(aes(x,y, group = edge_id),
data = arrows_points %>% filter(part == "arrow"),
fill = "black") +
# lwd = 0.5) +
geom_circle(aes(x0 = x, y0 = y, r = r),
data = nodes %>% inner_join(Info_Viz_Labels, by = "id"),
color = "black",
fill = "white") +
geom_text(aes(x,y, label = label_b),
size = 5.5,
data = nodes %>% inner_join(Info_Viz_Labels, by = "id")) +
coord_equal() +
theme_void() -> lombardiHere is the final network graph.