library(igraph)
library(ggraph)
library(tidygraph)
library(dplyr)
library(scales)
library(network)
library(networkDynamic)
library(ndtv)# ::::::::::::::::::::::::::::::::::::::::::::::::
#### 0.3 Preparar los datos ####
# ::::::::::::::::::::::::::::::::::::::::::::::::
load("icews_tensor_proyecto.RData")
n_tiempos <- dim(tensor_array)[4]
n_capas <- dim(tensor_array)[3]
n_paises <- dim(tensor_array)[1]
nombres_capas <- c("Material-", "Material+", "Verbal-", "Verbal+")
nombres_paises <- dimnames(tensor_array)$Source# :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#### 1. Elegir los 25 paÃses más centrales ####
# :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# Arreglo para guardar las centralidades
page_cent <- array(NA,
dim = c(n_paises, n_capas, n_tiempos),
dimnames = list(nombres_paises, paste0("Layer_",1:n_capas), paste0("Time_",1:n_tiempos)))
for(m in 1:n_capas){
for(t in 1:n_tiempos){
A <- tensor_array[,,m,t]
g <- graph_from_adjacency_matrix(A, mode = "directed", weighted = TRUE, diag = FALSE)
page_cent[,m,t] <- page_rank(g, directed = TRUE, weights = E(g)$weight)$vector
}
}
# Promedio de centralidades a través del tiempo
cent_mean <- apply(page_cent, c(1,2), mean, na.rm = TRUE)
# Obtener el top de los 25 paÃses más centrales
top25_layers <- vector("list", n_capas)
for(m in 1:n_capas){
ord <- order(cent_mean[,m], decreasing = TRUE)
top25_layers[[m]] <- data.frame(Country = rownames(cent_mean)[ord[1:25]],
MeanEigenCentrality = cent_mean[ord[1:25], m])
}
top25_names <- lapply(top25_layers, \(x) x$Country)
# Los paÃses más centrales para todas las capas
Reduce(intersect, top25_names) ## [1] "United States" "Israel"
## [3] "Occupied Palestinian Territory" "Afghanistan"
## [5] "Iraq" "Pakistan"
## [7] "Russian Federation" "United Kingdom"
## [9] "India" "Iran"
## [11] "China" "Syria"
## [13] "Australia" "France"
## [15] "Turkey" "Japan"
## [17] "South Korea" "North Korea"
## [19] "Ukraine"
# Son 19 paÃses
# - - - - - - - Top 25 global - - - - - - - - - - - - -
overall_mean <- rowMeans(cent_mean)
ord <- order(overall_mean, decreasing = TRUE)
top25_global <- data.frame(Country = names(overall_mean)[ord[1:25]],
MeanEigenCentrality = overall_mean[ord[1:25]])
#top25_global # Son los 19 paises de arriba más otros 6En todos los gráficos se resaltan los dos paÃses con mayor grado. Asà mismo, en los gráficos estáticos el tamaño de los vértices es proporcional a su grado
# - - - - - - - - - - - - - - Tiempo 1 - - - - - - - - - - - - - -
A1 <- tensor_array[indices, indices, 1, 1]
g1 <- graph_from_adjacency_matrix(A1, mode = "directed", weighted = TRUE, diag = FALSE)
V(g1)$grado <- igraph::degree(g1, mode = "all")
set.seed(9)
layout_mn1 <- layout_nicely(g1)
# Tamaño de los nodos
V(g1)$size <- rescale(V(g1)$grado, to = c(5, 15))
# Grosor de las aristas
E(g1)$width <- rescale(E(g1)$weight, to = c(2, 6))
# Etiquetas
V(g1)$label <- case_when(
V(g1)$name == "United States" ~ "USA",
V(g1)$name == "Iraq" ~ "IRQ",
TRUE ~ NA_character_)
# - - - - - - - - - - - - - - Tiempo 132 - - - - - - - - - - - - - -
A2 <- tensor_array[indices, indices, 1, 132]
g2 <- graph_from_adjacency_matrix(A2, mode = "directed", weighted = TRUE, diag = FALSE)
V(g2)$grado <- igraph::degree(g2, mode = "all")
# Tamaño de los nodos
V(g2)$size <- rescale(V(g2)$grado, to = c(5, 15))
# Grosor de las aristas
E(g2)$width <- rescale(E(g2)$weight, to = c(2, 6))
# Etiquetas
V(g2)$label <- case_when(
V(g2)$name == "United States" ~ "USA",
V(g2)$name == "Iraq" ~ "IRQ",
TRUE ~ NA_character_)
# Grafico
par(mfrow = c(1, 2), mar = c(0, 0, 1, 0) )
plot(g1, layout = layout_mn1,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g1)$size,
# Etiquetas
vertex.label = V(g1)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g1)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Material- t=1"
)
plot(g2, layout = layout_mn1,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g2)$size,
# Etiquetas
vertex.label = V(g2)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g2)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Material- t=132"
)tiempos <- 1:24
nombres_paises <- dimnames(tensor_array)[[1]][indices]
# - - - - - - Calcular pesos globales - - - - - -
pesos_todos <- c()
for (t in tiempos) {
A <- tensor_array[indices, indices, 1, t]
pesos_todos <- c(pesos_todos, A[A != 0 & is.finite(A)])
}
pesos_todos <- pesos_todos[is.finite(pesos_todos)]
min_peso <- min(pesos_todos)
max_peso <- max(pesos_todos)
# - - - - - - Construir los edge spells - - - - - -
edge_spells <- list()
contador <- 1
for (t in tiempos) {
A <- tensor_array[indices, indices, 1, t]
# Identificar las aristas existentes
ind <- which(A != 0 & is.finite(A), arr.ind = TRUE)
if (nrow(ind) > 0) {
for (j in seq_len(nrow(ind))) {
tail <- ind[j, 1]
head <- ind[j, 2]
# Peso de la arista
weight <- A[tail, head]
# Grosor proporcional al peso (entre 1 a 10)
edge_width <- 1 + 9 * ( (weight - min_peso) / (max_peso - min_peso) )
edge_spells[[contador]] <- c(t, # onset
t + 1, # terminus
tail, # tail
head, # head
weight, # weight
edge_width # edge.lwd
)
contador <- contador + 1
}
}
}
# Convertir a data.frame
edge_spells <- as.data.frame(do.call(rbind, edge_spells) )
names(edge_spells) <- c("onset", "terminus", "tail", "head", "weight", "edge.lwd")
# - - - - - - Crear la red dinámica - - - - - -
samp.dyn <- networkDynamic(edge.spells = edge_spells,
create.TEAs = TRUE,
edge.TEA.names = c("weight", "edge.lwd"),
directed = TRUE)## Initializing base.net of size 25 imputed from maximum vertex id in edge records
## Activated TEA edge attributes: weight, edge.lwdCreated net.obs.period to describe network
## Network observation period info:
## Number of observation spells: 1
## Maximal time range observed: 1 until 25
## Temporal mode: continuous
## Time unit: unknown
## Suggested time increment: NA
# Asignar nombres a los vértices
network.vertex.names(samp.dyn) <- nombres_paises
# - - - - - - Etiquetas seleccionadas - - - - - -
nombres <- network.vertex.names(samp.dyn)
labels_seleccionados <- ifelse(nombres == "United States", "USA",
ifelse(nombres == "Iraq", "IRQ", "") )
# - - - - - - Renderizar - - - - - -
set.seed(123)
render.d3movie(samp.dyn,
plot.par = list(displaylabels = TRUE,
label = labels_seleccionados,
label.cex = 0.8,
main = "Red del tipo Material- (2004-2005)",
vertex.border = "white",
edge.col = "grey60",
edge.lwd = "edge.lwd"),
output.mode = "htmlWidget")## No slice.par found, using
## slice parameters:
## start:1
## end:25
## interval:1
## aggregate.dur:1
## rule:latest
## Calculating layout for network slice from time 1 to 2
## Calculating layout for network slice from time 2 to 3
## Calculating layout for network slice from time 3 to 4
## Calculating layout for network slice from time 4 to 5
## Calculating layout for network slice from time 5 to 6
## Calculating layout for network slice from time 6 to 7
## Calculating layout for network slice from time 7 to 8
## Calculating layout for network slice from time 8 to 9
## Calculating layout for network slice from time 9 to 10
## Calculating layout for network slice from time 10 to 11
## Calculating layout for network slice from time 11 to 12
## Calculating layout for network slice from time 12 to 13
## Calculating layout for network slice from time 13 to 14
## Calculating layout for network slice from time 14 to 15
## Calculating layout for network slice from time 15 to 16
## Calculating layout for network slice from time 16 to 17
## Calculating layout for network slice from time 17 to 18
## Calculating layout for network slice from time 18 to 19
## Calculating layout for network slice from time 19 to 20
## Calculating layout for network slice from time 20 to 21
## Calculating layout for network slice from time 21 to 22
## Calculating layout for network slice from time 22 to 23
## Calculating layout for network slice from time 23 to 24
## Calculating layout for network slice from time 24 to 25
## Calculating layout for network slice from time 25 to 26
## caching 10 properties for slice 0
## caching 10 properties for slice 1
## caching 10 properties for slice 2
## caching 10 properties for slice 3
## caching 10 properties for slice 4
## caching 10 properties for slice 5
## caching 10 properties for slice 6
## caching 10 properties for slice 7
## caching 10 properties for slice 8
## caching 10 properties for slice 9
## caching 10 properties for slice 10
## caching 10 properties for slice 11
## caching 10 properties for slice 12
## caching 10 properties for slice 13
## caching 10 properties for slice 14
## caching 10 properties for slice 15
## caching 10 properties for slice 16
## caching 10 properties for slice 17
## caching 10 properties for slice 18
## caching 10 properties for slice 19
## caching 10 properties for slice 20
## caching 10 properties for slice 21
## caching 10 properties for slice 22
## caching 10 properties for slice 23
## caching 10 properties for slice 24
## loading ndtv-d3 animation widget...
# - - - - - - - - - - - - - - Tiempo 1 - - - - - - - - - - - - - -
A1 <- tensor_array[indices, indices, 2, 1]
g1 <- graph_from_adjacency_matrix(A1, mode = "directed", weighted = TRUE, diag = FALSE)
V(g1)$grado <- igraph::degree(g1, mode = "all")
set.seed(9)
layout_mp1 <- layout_nicely(g1)
# Tamaño de los nodos
V(g1)$size <- rescale(V(g1)$grado, to = c(5, 15))
# Grosor de las aristas
E(g1)$width <- rescale(E(g1)$weight, to = c(2, 6))
# Etiquetas
V(g1)$label <- case_when(
V(g1)$name == "United States" ~ "USA",
V(g1)$name == "Iraq" ~ "IRQ",
TRUE ~ NA_character_)
# - - - - - - - - - - - - - - Tiempo 132 - - - - - - - - - - - - - -
A2 <- tensor_array[indices, indices, 2, 132]
g2 <- graph_from_adjacency_matrix(A2, mode = "directed", weighted = TRUE, diag = FALSE)
V(g2)$grado <- igraph::degree(g2, mode = "all")
set.seed(9)
layout_mp2 <- layout_nicely(g2)
# Tamaño de los nodos
V(g2)$size <- rescale(V(g2)$grado, to = c(5, 15))
# Grosor de las aristas
E(g2)$width <- rescale(E(g2)$weight, to = c(2, 6))
# Etiquetas
V(g2)$label <- case_when(
V(g2)$name == "United States" ~ "USA",
V(g2)$name == "Iraq" ~ "IRQ",
TRUE ~ NA_character_)
# Grafico
par(mfrow = c(1, 2), mar = c(0, 0, 1, 0) )
plot(g1, layout = layout_mp1,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g1)$size,
# Etiquetas
vertex.label = V(g1)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g1)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Material+ t=1"
)
plot(g2, layout = layout_mp1,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g2)$size,
# Etiquetas
vertex.label = V(g2)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g2)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Material+ t=132"
)# - - - - - - Calcular pesos globales - - - - - -
pesos_todos <- c()
for (t in tiempos) {
A <- tensor_array[indices, indices, 2, t]
pesos_todos <- c(pesos_todos, A[A != 0 & is.finite(A)])
}
pesos_todos <- pesos_todos[is.finite(pesos_todos)]
min_peso <- min(pesos_todos)
max_peso <- max(pesos_todos)
# - - - - - - Construir los edge spells - - - - - -
edge_spells <- list()
contador <- 1
for (t in tiempos) {
A <- tensor_array[indices, indices, 2, t]
# Identificar las aristas existentes
ind <- which(A != 0 & is.finite(A), arr.ind = TRUE)
if (nrow(ind) > 0) {
for (j in seq_len(nrow(ind))) {
tail <- ind[j, 1]
head <- ind[j, 2]
# Peso de la arista
weight <- A[tail, head]
# Grosor proporcional al peso (entre 1 a 10)
edge_width <- 1 + 9 * ( (weight - min_peso) / (max_peso - min_peso) )
edge_spells[[contador]] <- c(t, # onset
t + 1, # terminus
tail, # tail
head, # head
weight, # weight
edge_width # edge.lwd
)
contador <- contador + 1
}
}
}
# Convertir a data.frame
edge_spells <- as.data.frame(do.call(rbind, edge_spells) )
names(edge_spells) <- c("onset", "terminus", "tail", "head", "weight", "edge.lwd")
# - - - - - - Crear la red dinámica - - - - - -
samp.dyn <- networkDynamic(edge.spells = edge_spells,
create.TEAs = TRUE,
edge.TEA.names = c("weight", "edge.lwd"),
directed = TRUE)## Initializing base.net of size 25 imputed from maximum vertex id in edge records
## Activated TEA edge attributes: weight, edge.lwdCreated net.obs.period to describe network
## Network observation period info:
## Number of observation spells: 1
## Maximal time range observed: 1 until 25
## Temporal mode: continuous
## Time unit: unknown
## Suggested time increment: NA
# Asignar nombres a los vértices
network.vertex.names(samp.dyn) <- nombres_paises
# - - - - - - Etiquetas seleccionadas - - - - - -
nombres <- network.vertex.names(samp.dyn)
labels_seleccionados <- ifelse(nombres == "United States", "USA",
ifelse(nombres == "Iraq", "IRQ", "") )
# - - - - - - Renderizar - - - - - -
set.seed(123)
render.d3movie(samp.dyn,
plot.par = list(displaylabels = TRUE,
label = labels_seleccionados,
label.cex = 0.8,
main = "Red del tipo Material+ (2004-2005)",
vertex.border = "white",
edge.col = "grey60",
edge.lwd = "edge.lwd"),
output.mode = "htmlWidget")## No slice.par found, using
## slice parameters:
## start:1
## end:25
## interval:1
## aggregate.dur:1
## rule:latest
## Calculating layout for network slice from time 1 to 2
## Calculating layout for network slice from time 2 to 3
## Calculating layout for network slice from time 3 to 4
## Calculating layout for network slice from time 4 to 5
## Calculating layout for network slice from time 5 to 6
## Calculating layout for network slice from time 6 to 7
## Calculating layout for network slice from time 7 to 8
## Calculating layout for network slice from time 8 to 9
## Calculating layout for network slice from time 9 to 10
## Calculating layout for network slice from time 10 to 11
## Calculating layout for network slice from time 11 to 12
## Calculating layout for network slice from time 12 to 13
## Calculating layout for network slice from time 13 to 14
## Calculating layout for network slice from time 14 to 15
## Calculating layout for network slice from time 15 to 16
## Calculating layout for network slice from time 16 to 17
## Calculating layout for network slice from time 17 to 18
## Calculating layout for network slice from time 18 to 19
## Calculating layout for network slice from time 19 to 20
## Calculating layout for network slice from time 20 to 21
## Calculating layout for network slice from time 21 to 22
## Calculating layout for network slice from time 22 to 23
## Calculating layout for network slice from time 23 to 24
## Calculating layout for network slice from time 24 to 25
## Calculating layout for network slice from time 25 to 26
## caching 10 properties for slice 0
## caching 10 properties for slice 1
## caching 10 properties for slice 2
## caching 10 properties for slice 3
## caching 10 properties for slice 4
## caching 10 properties for slice 5
## caching 10 properties for slice 6
## caching 10 properties for slice 7
## caching 10 properties for slice 8
## caching 10 properties for slice 9
## caching 10 properties for slice 10
## caching 10 properties for slice 11
## caching 10 properties for slice 12
## caching 10 properties for slice 13
## caching 10 properties for slice 14
## caching 10 properties for slice 15
## caching 10 properties for slice 16
## caching 10 properties for slice 17
## caching 10 properties for slice 18
## caching 10 properties for slice 19
## caching 10 properties for slice 20
## caching 10 properties for slice 21
## caching 10 properties for slice 22
## caching 10 properties for slice 23
## caching 10 properties for slice 24
## loading ndtv-d3 animation widget...
# - - - - - - - - - - - - - - Tiempo 1 - - - - - - - - - - - - - -
A1 <- tensor_array[indices, indices, 3, 1]
g1 <- graph_from_adjacency_matrix(A1, mode = "directed", weighted = TRUE, diag = FALSE)
V(g1)$grado <- igraph::degree(g1, mode = "all")
set.seed(9)
layout_vn1 <- layout_nicely(g1)
# Tamaño de los nodos
V(g1)$size <- rescale(V(g1)$grado, to = c(5, 15))
# Grosor de las aristas
E(g1)$width <- rescale(E(g1)$weight, to = c(2, 6))
# Etiquetas
V(g1)$label <- case_when(
V(g1)$name == "United States" ~ "USA",
V(g1)$name == "Iraq" ~ "IRQ",
TRUE ~ NA_character_)
# - - - - - - - - - - - - - - Tiempo 132 - - - - - - - - - - - - - -
A2 <- tensor_array[indices, indices, 3, 132]
g2 <- graph_from_adjacency_matrix(A2, mode = "directed", weighted = TRUE, diag = FALSE)
V(g2)$grado <- igraph::degree(g2, mode = "all")
set.seed(9)
layout_vn2 <- layout_nicely(g2)
# Tamaño de los nodos
V(g2)$size <- rescale(V(g2)$grado, to = c(5, 15))
# Grosor de las aristas
E(g2)$width <- rescale(E(g2)$weight, to = c(2, 6))
# Etiquetas
V(g2)$label <- case_when(
V(g2)$name == "United States" ~ "USA",
V(g2)$name == "Iraq" ~ "IRQ",
TRUE ~ NA_character_)
# Grafico
par(mfrow = c(1, 2), mar = c(0, 0, 1, 0) )
plot(g1, layout = layout_vn2,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g)$size,
# Etiquetas
vertex.label = V(g)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Verbal- t=1"
)
plot(g2, layout = layout_vn2,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g)$size,
# Etiquetas
vertex.label = V(g)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Verbal- t=132"
)# - - - - - - Calcular pesos globales - - - - - -
pesos_todos <- c()
for (t in tiempos) {
A <- tensor_array[indices, indices, 3, t]
pesos_todos <- c(pesos_todos, A[A != 0 & is.finite(A)])
}
pesos_todos <- pesos_todos[is.finite(pesos_todos)]
min_peso <- min(pesos_todos)
max_peso <- max(pesos_todos)
# - - - - - - Construir los edge spells - - - - - -
edge_spells <- list()
contador <- 1
for (t in tiempos) {
A <- tensor_array[indices, indices, 3, t]
# Identificar las aristas existentes
ind <- which(A != 0 & is.finite(A), arr.ind = TRUE)
if (nrow(ind) > 0) {
for (j in seq_len(nrow(ind))) {
tail <- ind[j, 1]
head <- ind[j, 2]
# Peso de la arista
weight <- A[tail, head]
# Grosor proporcional al peso (entre 1 a 10)
edge_width <- 1 + 9 * ( (weight - min_peso) / (max_peso - min_peso) )
edge_spells[[contador]] <- c(t, # onset
t + 1, # terminus
tail, # tail
head, # head
weight, # weight
edge_width # edge.lwd
)
contador <- contador + 1
}
}
}
# Convertir a data.frame
edge_spells <- as.data.frame(do.call(rbind, edge_spells) )
names(edge_spells) <- c("onset", "terminus", "tail", "head", "weight", "edge.lwd")
# - - - - - - Crear la red dinámica - - - - - -
samp.dyn <- networkDynamic(edge.spells = edge_spells,
create.TEAs = TRUE,
edge.TEA.names = c("weight", "edge.lwd"),
directed = TRUE)## Initializing base.net of size 25 imputed from maximum vertex id in edge records
## Activated TEA edge attributes: weight, edge.lwdCreated net.obs.period to describe network
## Network observation period info:
## Number of observation spells: 1
## Maximal time range observed: 1 until 25
## Temporal mode: continuous
## Time unit: unknown
## Suggested time increment: NA
# Asignar nombres a los vértices
network.vertex.names(samp.dyn) <- nombres_paises
# - - - - - - Etiquetas seleccionadas - - - - - -
nombres <- network.vertex.names(samp.dyn)
labels_seleccionados <- ifelse(nombres == "United States", "USA",
ifelse(nombres == "Iraq", "IRQ", "") )
# - - - - - - Renderizar - - - - - -
set.seed(123)
render.d3movie(samp.dyn,
plot.par = list(displaylabels = TRUE,
label = labels_seleccionados,
label.cex = 0.8,
main = "Red del tipo Verbal- (2004-2005)",
vertex.border = "white",
edge.col = "grey60",
edge.lwd = "edge.lwd"),
output.mode = "htmlWidget")## No slice.par found, using
## slice parameters:
## start:1
## end:25
## interval:1
## aggregate.dur:1
## rule:latest
## Calculating layout for network slice from time 1 to 2
## Calculating layout for network slice from time 2 to 3
## Calculating layout for network slice from time 3 to 4
## Calculating layout for network slice from time 4 to 5
## Calculating layout for network slice from time 5 to 6
## Calculating layout for network slice from time 6 to 7
## Calculating layout for network slice from time 7 to 8
## Calculating layout for network slice from time 8 to 9
## Calculating layout for network slice from time 9 to 10
## Calculating layout for network slice from time 10 to 11
## Calculating layout for network slice from time 11 to 12
## Calculating layout for network slice from time 12 to 13
## Calculating layout for network slice from time 13 to 14
## Calculating layout for network slice from time 14 to 15
## Calculating layout for network slice from time 15 to 16
## Calculating layout for network slice from time 16 to 17
## Calculating layout for network slice from time 17 to 18
## Calculating layout for network slice from time 18 to 19
## Calculating layout for network slice from time 19 to 20
## Calculating layout for network slice from time 20 to 21
## Calculating layout for network slice from time 21 to 22
## Calculating layout for network slice from time 22 to 23
## Calculating layout for network slice from time 23 to 24
## Calculating layout for network slice from time 24 to 25
## Calculating layout for network slice from time 25 to 26
## caching 10 properties for slice 0
## caching 10 properties for slice 1
## caching 10 properties for slice 2
## caching 10 properties for slice 3
## caching 10 properties for slice 4
## caching 10 properties for slice 5
## caching 10 properties for slice 6
## caching 10 properties for slice 7
## caching 10 properties for slice 8
## caching 10 properties for slice 9
## caching 10 properties for slice 10
## caching 10 properties for slice 11
## caching 10 properties for slice 12
## caching 10 properties for slice 13
## caching 10 properties for slice 14
## caching 10 properties for slice 15
## caching 10 properties for slice 16
## caching 10 properties for slice 17
## caching 10 properties for slice 18
## caching 10 properties for slice 19
## caching 10 properties for slice 20
## caching 10 properties for slice 21
## caching 10 properties for slice 22
## caching 10 properties for slice 23
## caching 10 properties for slice 24
## loading ndtv-d3 animation widget...
# - - - - - - - - - - - - - - Tiempo 1 - - - - - - - - - - - - - -
A1 <- tensor_array[indices, indices, 4, 1]
g1 <- graph_from_adjacency_matrix(A1, mode = "directed", weighted = TRUE, diag = FALSE)
V(g1)$grado <- igraph::degree(g1, mode = "all")
set.seed(9)
layout_vp1 <- layout_nicely(g1)
# Tamaño de los nodos
V(g1)$size <- rescale(V(g1)$grado, to = c(5, 15))
# Grosor de las aristas
E(g1)$width <- rescale(E(g1)$weight, to = c(2, 6))
# Etiquetas
V(g1)$label <- case_when(
V(g1)$name == "United States" ~ "USA",
V(g1)$name == "United Kingdom" ~ "UK",
TRUE ~ NA_character_)
# - - - - - - - - - - - - - - Tiempo 132 - - - - - - - - - - - - - -
A2 <- tensor_array[indices, indices, 4, 132]
g2 <- graph_from_adjacency_matrix(A2, mode = "directed", weighted = TRUE, diag = FALSE)
V(g2)$grado <- igraph::degree(g2, mode = "all")
set.seed(9)
layout_vp2 <- layout_nicely(g2)
# Tamaño de los nodos
V(g2)$size <- rescale(V(g2)$grado, to = c(5, 15))
# Grosor de las aristas
E(g2)$width <- rescale(E(g2)$weight, to = c(2, 6))
# Etiquetas
V(g2)$label <- case_when(
V(g2)$name == "United States" ~ "USA",
V(g2)$name == "United Kingdom" ~ "UK",
TRUE ~ NA_character_)
par(mfrow = c(1, 2), mar = c(0, 0, 1, 0) )
# Grafico
plot(g1, layout = layout_vp2,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g)$size,
# Etiquetas
vertex.label = V(g)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Verbal+ t=1"
)
plot(g2, layout = layout_vp2,
# Nodos
vertex.color = "dodgerblue2",
vertex.frame.color = "white",
vertex.size = V(g)$size,
# Etiquetas
vertex.label = V(g)$label,
vertex.label.color = "black",
vertex.label.cex = 0.8,
# Aristas
edge.width = E(g)$width,
edge.color = adjustcolor("grey60", alpha.f = 0.5),
edge.arrow.size = 0.4,
# Sin mostrar leyenda
rescale = TRUE,
# TÃtulo
main = "Red del tipo Verbal+ t=132"
)# - - - - - - Calcular pesos globales - - - - - -
pesos_todos <- c()
for (t in tiempos) {
A <- tensor_array[indices, indices, 4, t]
pesos_todos <- c(pesos_todos, A[A != 0 & is.finite(A)])
}
pesos_todos <- pesos_todos[is.finite(pesos_todos)]
min_peso <- min(pesos_todos)
max_peso <- max(pesos_todos)
# - - - - - - Construir los edge spells - - - - - -
edge_spells <- list()
contador <- 1
for (t in tiempos) {
A <- tensor_array[indices, indices, 4, t]
# Identificar las aristas existentes
ind <- which(A != 0 & is.finite(A), arr.ind = TRUE)
if (nrow(ind) > 0) {
for (j in seq_len(nrow(ind))) {
tail <- ind[j, 1]
head <- ind[j, 2]
# Peso de la arista
weight <- A[tail, head]
# Grosor proporcional al peso (entre 1 a 10)
edge_width <- 1 + 9 * ( (weight - min_peso) / (max_peso - min_peso) )
edge_spells[[contador]] <- c(t, # onset
t + 1, # terminus
tail, # tail
head, # head
weight, # weight
edge_width # edge.lwd
)
contador <- contador + 1
}
}
}
# Convertir a data.frame
edge_spells <- as.data.frame(do.call(rbind, edge_spells) )
names(edge_spells) <- c("onset", "terminus", "tail", "head", "weight", "edge.lwd")
# - - - - - - Crear la red dinámica - - - - - -
samp.dyn <- networkDynamic(edge.spells = edge_spells,
create.TEAs = TRUE,
edge.TEA.names = c("weight", "edge.lwd"),
directed = TRUE)## Initializing base.net of size 25 imputed from maximum vertex id in edge records
## Activated TEA edge attributes: weight, edge.lwdCreated net.obs.period to describe network
## Network observation period info:
## Number of observation spells: 1
## Maximal time range observed: 1 until 25
## Temporal mode: continuous
## Time unit: unknown
## Suggested time increment: NA
# Asignar nombres a los vértices
network.vertex.names(samp.dyn) <- nombres_paises
# - - - - - - Etiquetas seleccionadas - - - - - -
nombres <- network.vertex.names(samp.dyn)
labels_seleccionados <- ifelse(nombres == "United States", "USA",
ifelse(nombres == "United Kingdom", "UK", "") )
# - - - - - - Renderizar - - - - - -
set.seed(123)
render.d3movie(samp.dyn,
plot.par = list(displaylabels = TRUE,
label = labels_seleccionados,
label.cex = 0.8,
main = "Red del tipo Verbal+ (2004-2005)",
vertex.border = "white",
edge.col = "grey60",
edge.lwd = "edge.lwd"),
output.mode = "htmlWidget")## No slice.par found, using
## slice parameters:
## start:1
## end:25
## interval:1
## aggregate.dur:1
## rule:latest
## Calculating layout for network slice from time 1 to 2
## Calculating layout for network slice from time 2 to 3
## Calculating layout for network slice from time 3 to 4
## Calculating layout for network slice from time 4 to 5
## Calculating layout for network slice from time 5 to 6
## Calculating layout for network slice from time 6 to 7
## Calculating layout for network slice from time 7 to 8
## Calculating layout for network slice from time 8 to 9
## Calculating layout for network slice from time 9 to 10
## Calculating layout for network slice from time 10 to 11
## Calculating layout for network slice from time 11 to 12
## Calculating layout for network slice from time 12 to 13
## Calculating layout for network slice from time 13 to 14
## Calculating layout for network slice from time 14 to 15
## Calculating layout for network slice from time 15 to 16
## Calculating layout for network slice from time 16 to 17
## Calculating layout for network slice from time 17 to 18
## Calculating layout for network slice from time 18 to 19
## Calculating layout for network slice from time 19 to 20
## Calculating layout for network slice from time 20 to 21
## Calculating layout for network slice from time 21 to 22
## Calculating layout for network slice from time 22 to 23
## Calculating layout for network slice from time 23 to 24
## Calculating layout for network slice from time 24 to 25
## Calculating layout for network slice from time 25 to 26
## caching 10 properties for slice 0
## caching 10 properties for slice 1
## caching 10 properties for slice 2
## caching 10 properties for slice 3
## caching 10 properties for slice 4
## caching 10 properties for slice 5
## caching 10 properties for slice 6
## caching 10 properties for slice 7
## caching 10 properties for slice 8
## caching 10 properties for slice 9
## caching 10 properties for slice 10
## caching 10 properties for slice 11
## caching 10 properties for slice 12
## caching 10 properties for slice 13
## caching 10 properties for slice 14
## caching 10 properties for slice 15
## caching 10 properties for slice 16
## caching 10 properties for slice 17
## caching 10 properties for slice 18
## caching 10 properties for slice 19
## caching 10 properties for slice 20
## caching 10 properties for slice 21
## caching 10 properties for slice 22
## caching 10 properties for slice 23
## caching 10 properties for slice 24
## loading ndtv-d3 animation widget...