Parcial 2
William Andrés Parada / Juan Felipe Rojas / Alejandro Barrera
2024-04-02
# Leer datos de nodos y aristas
dat_nodes <- readr::read_delim("df_nodes.csv", delim = ";", escape_double = FALSE, trim_ws = TRUE)## Rows: 475 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## chr (6): name, lastname, sex, party, user, position
## dbl (3): id, age, time
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.dat_edges <- readr::read_delim("df_edges.xls", delim = ",", escape_double = FALSE, trim_ws = TRUE)## Rows: 13289 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): source, target
## dbl (1): weight
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Crear grafo ponderado y dirigido
set.seed(168)
G <- graph_from_data_frame(d = dat_edges[, c(1, 2)], vertices = dat_nodes$lastname, directed =FALSE)
# Asignar pesos a las aristas
E(G)$weight <- dat_edges$weight
# Visualizar el grafo
plot(G)
A) Caracterizar la centralidad
Centralidad propia
# matriz de adyacencia
Y <- as_adjacency_matrix(G, sparse = F)
g <- graph_from_adjacency_matrix(Y)
evd <- eigen(Y)
# eigen centraliy normalizada
head(
cbind(
eigen_centrality(graph = G, scale = T)$vector,
eigen_centrality(graph = g, scale = T)$vector,
Y%*%c(1/evd$values[1]*(-1)*evd$vectors[,1])/max(Y%*%c(1/evd$values[1]*(-1)*evd$vectors[,1]))), n =5)## [,1] [,2] [,3]
## Baldwin 0.01022886 0.1144200 0.1144200
## Barrasso 0.02268409 0.1067133 0.1067133
## Bennet 0.02162221 0.1194515 0.1194515
## Blackburn 0.02603259 0.1814278 0.1814278
## Blumenthal 0.01115974 0.1768588 0.1768588# top 5
ec <- eigen_centrality(graph = G, scale = T)$vector
head(sort(ec, decreasing = T), n = 5)## McCarthy Scalise Roy MikeJohnson Franklin
## 1.0000000 0.6325119 0.6086852 0.5619319 0.5375061Centralidad Cercania
# distancias
D <- distances(graph = G)
# closeness centraliy normalizada
n <- vcount(G)
head(cbind(closeness(graph = G, normalized = T)), n = 5)## [,1]
## Baldwin 264.4205
## Barrasso 369.4193
## Bennet 290.7346
## Blackburn 372.4424
## Blumenthal 325.7211# top 5
cc <- closeness(graph = G, normalized = T)
head(sort(cc, decreasing = T), n = 5)## Cornyn Beyer Casten AnthonyBrown McCarthy
## 453.0713 429.9500 421.5225 407.2443 405.3522Centralidad intermediación
# betweenness centrality normalizada
n <- vcount(G)
head(cbind(betweenness(graph = G, normalized = T)), n = 5)## [,1]
## Baldwin 1.070463e-05
## Barrasso 1.189404e-05
## Bennet 2.087403e-03
## Blackburn 3.754352e-02
## Blumenthal 4.351433e-03# top 5
bc <- betweenness(graph = G, normalized = T)
head(sort(bc, decreasing = T), n = 5)## Cornyn Beyer McCarthy Casten Castro
## 0.22394983 0.12539446 0.08917755 0.08355242 0.07714397Análisis:
A partir de la centralidad propia, podemos comprobar que el nodo “McCarthy”, al obtener el valor 1, esta conectado con todos los demas nodos, a demas, es uno de los cinco nodos con mayor cercania e intermediación al resto.
B) Visualización
Visual <- layout_on_sphere(G)
Centralidad <- eigen_centrality(graph = G, scale = T)$vector
# visualización
#par(mfrow = c(1,2), mar = c(4, 3, 3, 1))
# grafo no decorado
plot(G, layout = Visual, vertex.label = NA, vertex.size = 10 * Centralidad/max(Centralidad), vertex.color = "black", vertex.frame.color = "red")
title(main = "Visualización de la red")
# decoración
# etiquetas
V(G)$label <- sub("Actor ", "", V(G)$name)
# formas
V(G)$shape <- "circle"
V(G)[c("McCarthy")]$shape <- "rectangle"
# tamaños
V(G)$size <- 10 * Centralidad/max(Centralidad)
# grafo decorado
plot(G, layout = Visual, vertex.frame.color = "black", vertex.label.color = "black")
C) Puntos de articulación, Aislados y componentes
puntos_articulacion <- articulation_points(G)
print(puntos_articulacion)## + 0/475 vertices, named, from 713fb01:nodos_aislados <- which(degree(g) == 0)
print(nodos_aislados)## named integer(0)componentes <- components(G)
print(componentes$membership)## Baldwin Barrasso Bennet Blackburn Blumenthal
## 1 1 1 1 1
## RoyBlunt Booker Boozman Braun SherrodBrown
## 1 1 1 1 1
## Cantwell Capito Cardin Carper Casey
## 1 1 1 1 1
## Cassidy Coons Cornyn Cortez Cotton
## 1 1 1 1 1
## Cramer Crapo Cruz Daines Duckworth
## 1 1 1 1 1
## Durbin Ernst Feinstein Fischer Gillibrand
## 1 1 1 1 1
## Graham Grassley Hagerty Hassan Hawley
## 1 1 1 1 1
## Heinrich Hickenlooper Hirono Hoeven Hyde-Smith
## 1 1 1 1 1
## Inhofe RonJohnson Kaine MarkKelly Kennedy
## 1 1 1 1 1
## King Klobuchar Lankford Leahy MikeLee
## 1 1 1 1 1
## Lujan Lummis Manchin Markey Menendez
## 1 1 1 1 1
## Merkley Moran Murkowski ChrisMurphy Murray
## 1 1 1 1 1
## Ossoff Padilla Paul GaryPeters Portman
## 1 1 1 1 1
## Reed Risch Romney Rosen Rubio
## 1 1 1 1 1
## Sanders Schumer RickScott TimScott Shaheen
## 1 1 1 1 1
## Sinema TinaSmith Stabenow Sullivan Tester
## 1 1 1 1 1
## Thune Tillis Toomey Tuberville VanHollen
## 1 1 1 1 1
## Warner Warnock Warren Whitehouse Wicker
## 1 1 1 1 1
## Wyden Young Adams Aderholt Aguilar
## 1 1 1 1 1
## Allen Allred Armstrong Arrington Auchincloss
## 1 1 1 1 1
## Axne Babin Bacon Baird Balderson
## 1 1 1 1 1
## Banks Barr Barragan Bass Beatty
## 1 1 1 1 1
## Bera Beyer Bice Biggs Bilirakis
## 1 1 1 1 1
## SanfordBishop DanBishop LisaBlunt Boebert Bonamici
## 1 1 1 1 1
## Bost Bourdeaux Bowman Boyle Brady
## 1 1 1 1 1
## Brooks AnthonyBrown ShontelBrown Brownley Buchanan
## 1 1 1 1 1
## Buck Bucshon Budd Burchett Burgess
## 1 1 1 1 1
## Bush Bustos Cammack Carbajal Cardenas
## 1 1 1 1 1
## Carey Carl Carson BuddyCarter JohnCarter
## 1 1 1 1 1
## TroyCarter Case Casten Castor Castro
## 1 1 1 1 1
## Cawthorn Chabot Cheney Collins Chu
## 1 1 1 1 1
## Clark Clarke Cleaver Cline Cloud
## 1 1 1 1 1
## Clyburn Clyde Cohen Cole Comer
## 1 1 1 1 1
## Connolly Correa Costa Courtney Craig
## 1 1 1 1 1
## Crist Crow Curtis Davids Davidson
## 1 1 1 1 1
## Davis Dean DeFazio DeGette DeLauro
## 1 1 1 1 1
## DelBene Delgado Demings DeSaulnier Deutch
## 1 1 1 1 1
## Diaz-Balart Dingell Doggett Donalds Doyle
## 1 1 1 1 1
## Duncan Dunn Emmer Escobar Eshoo
## 1 1 1 1 1
## Espaillat Estes Evans Fallon Feenstra
## 1 1 1 1 1
## Ferguson Fischbach Fitzpatrick Fleischmann Fletcher
## 1 1 1 1 1
## Foster Foxx Frankel Franklin Fulcher
## 1 1 1 1 1
## Gaetz Gallagher Gallego Garamendi Garbarino
## 1 1 1 1 1
## JesusGarcia MikeGarcia SylviaGarcia Gibbs Gimenez
## 1 1 1 1 1
## Gohmert Golden Gomez Gonzales JGonzalez
## 1 1 1 1 1
## Gonzalez Good Gooden Gosar Gottheimer
## 1 1 1 1 1
## Granger Graves AIGreen MakGreen Taylor
## 1 1 1 1 1
## Griffith Grijalva Grothman Guest Guthrie
## 1 1 1 1 1
## Harder Harshbarger Hartzler Hayes Hern
## 1 1 1 1 1
## Herrell Hice BrianHiggins ClayHiggins Hill
## 1 1 1 1 1
## Himes Hinson Horsford Houlahan Hoyer
## 1 1 1 1 1
## Hudson Huffman Huizenga Issa SheilaJackson
## 1 1 1 1 1
## RonnyJackson ChrisJacobs SaraJacobs Jayapal Jeffries
## 1 1 1 1 1
## BillJohnson DustyJohnson Bernice HankJohnson MikeJohnson
## 1 1 1 1 1
## Jones Jordan DavidJoyce JohnJoyce Katko
## 1 1 1 1 1
## Keating Keller MikeKelly RobinKelly Khanna
## 1 1 1 1 1
## Kildee Kilmer AndyKim YoungKim RonKind
## 1 1 1 1 1
## Kirkpatrick Campa-Najjar Kuster Kustoff LaHood
## 1 1 1 1 1
## LaMalfa Langevin Larsen Larson Latta
## 1 1 1 1 1
## LaTurner Lawrence Lawson BarbaraLee SusieLee
## 1 1 1 1 1
## Leger Lesko Letlow AndyLevin MikeLevin
## 1 1 1 1 1
## Lieu Long Loudermilk Lowenthal Lucas
## 1 1 1 1 1
## Luetkemeyer Luria Mace Malinowski Malliotakis
## 1 1 1 1 1
## Maloney Patrick Manning Massie Mast
## 1 1 1 1 1
## Matsui McBath McCarthy McCaul McClain
## 1 1 1 1 1
## McCollum McEachin McGovern McHenry McKinley
## 1 1 1 1 1
## Meeks Meijer Meng Meuser Mfume
## 1 1 1 1 1
## Miller CarolMiller MaryMiller Mooney BarryMoore
## 1 1 1 1 1
## BlakeMoore GwenMoore Morelle Mullin GregMurphy
## 1 1 1 1 1
## StephanieMurphy Nadler Napolitano Neal Neguse
## 1 1 1 1 1
## Nehls Newhouse Newman Norcross Norman
## 1 1 1 1 1
## Holmes Ohalleran Obernolte Omar Owens
## 1 1 1 1 1
## Palazzo Pallone Palmer Panetta Pappas
## 1 1 1 1 1
## Pascrell Payne Pelosi Perlmutter ScottPeters
## 1 1 1 1 1
## Pfluger Phillips Pingree Plaskett Pocan
## 1 1 1 1 1
## Porter Pressley Price Quigley Raskin
## 1 1 1 1 1
## Reschenthaler KathleenRice TomRice McMorris Rogers
## 1 1 1 1 1
## Rose Rosendale Ross Rouzer Roy
## 1 1 1 1 1
## Roybal-Allard Ruiz Ruppersberger Rush Ryan
## 1 1 1 1 1
## Kilili Salazar Sanchez Sarbanes Scalise
## 1 1 1 1 1
## Gay Schakowsky Schiff Schneider Schrader
## 1 1 1 1 1
## Schrier D Scott AustinScott BobbyScott Sessions
## 1 1 1 1 1
## Sewell Sherman Sherrill Simpson Sires
## 1 1 1 1 1
## Slotkin AdamSmith AdrianSmith JasonSmith Smucker
## 1 1 1 1 1
## Soto Spanberger Spartz Speier Stansbury
## 1 1 1 1 1
## Stanton Stauber Steel Stefanik Steil
## 1 1 1 1 1
## Steube Stevens Stewart Strickland Suozzi
## 1 1 1 1 1
## Swalwell Takano Tenney BennieThompson GlennThompson
## 1 1 1 1 1
## Tiffany Timmons Titus Tlaib Tonko
## 1 1 1 1 1
## Torres Ritchie Trahan Trone Turner
## 1 1 1 1 1
## Underwood Valadao VanDuyne Vargas Veasey
## 1 1 1 1 1
## Velazquez Wagner Walberg Walorski Waltz
## 1 1 1 1 1
## Wasserman Watson Webster Welch Westerman
## 1 1 1 1 1
## Wexton Wild NikemaWilliams RogerWilliams Wilson
## 1 1 1 1 1
## JoeWilson Wittman Womack Yarmuth Zeldin
## 1 1 1 1 1D) Distancias geodésicas
# Calcula la distancia geodésica entre dos nodos especificos
distances(graph = G, v = "McCarthy", to="Cornyn")## Cornyn
## McCarthy 0.0005260389Vemos que al tener una conexion casi inmediata y con una alta cercania el recorrido es muy pequeño
shortest_paths(G, from = "McCarthy", to = "Cornyn")$vpath## [[1]]
## + 2/475 vertices, named, from 713fb01:
## [1] McCarthy CornynCon solo 2 de los 475 vertices interviniendo.
Distancias (A través de un mapa de calor)
D <- distances(graph = g, v =V(g), to = V(g))
dist_mat<-dist(D, method = 'euclidean')
dim(as.matrix(dist_mat))## [1] 475 475# Los colores más claros representan las menores distancias.
heatmap(as.matrix(dist_mat))
Diametro
diameter(G)## [1] 0.02054742(d <- get_diameter(G))## + 5/475 vertices, named, from 713fb01:
## [1] Kilili BobbyScott Beyer Keating WagnerVisualizacion del diametro
# visualización del diámetro
V(G)$color <- "white"
E(G)$color <- "grey"
E(G)$width <- 1
V(G)[d]$color <- "royalblue"
E(G, path = d)$color <- "royalblue"
E(G, path = d)$width <- 2
set.seed(168)
plot(G)
Distancia geodesica promedio
# distancia geodésica promedio
mean_distance(G)## [1] 0.003598174Distribución de distancias
# visualización
senderos <- distance_table(g)$res
names(senderos) <- 1:length(senderos)
barplot(prop.table(senderos), xlab = "Distancia geodésica", ylab = "F. Relativa", border = "grey", col = "grey", main = "Distribución de distancias geodésicas")
E) Determinar si al red es libre de escala
library(igraph)
# Calcula la distribución de grado
deg <- degree(G, mode = "all")
deg_dist <- table(deg)/length(deg)
# Grafica en escala log-log
plot(names(deg_dist), deg_dist, log = "xy", xlab = "Grado", ylab = "Probabilidad",
main = "Distribución de Grado en Escala Log-log",
type = "h")
library(poweRlaw)
# Suponiendo que 'deg' es tu vector de grados de nodos
data <- as.vector(deg)
m <- conpl$new(data)
est <- estimate_xmin(m)
m$setXmin(est)
# Ajustar la ley de potencia
pars <- estimate_pars(m)
print(pars)## $pars
## [1] 3.588057
##
## $value
## [1] 856.4802
##
## $counts
## function gradient
## 6 6
##
## $convergence
## [1] 0
##
## $message
## [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
##
## attr(,"class")
## [1] "estimate_pars"# Realizar prueba de Kolmogorov-Smirnov
ks <- bootstrap_p(m)## Expected total run time for 100 sims, using 1 threads is 25.6 seconds.print(ks)## $p
## [1] 0
##
## $gof
## [1] 0.07667087
##
## $bootstraps
## gof xmin pars ntail
## 1 0.04641781 60.71763 3.533303 166
## 2 0.02902146 70.27750 4.345161 96
## 3 0.04046817 53.00000 3.224614 226
## 4 0.04096987 61.16530 3.669150 171
## 5 0.06027756 143.95625 5.456212 15
## 6 0.04037532 57.86810 3.801953 164
## 7 0.02240734 57.69382 3.678437 176
## 8 0.02718009 56.16160 3.630944 201
## 9 0.03192138 62.48383 3.690596 141
## 10 0.05099645 59.19243 3.986446 169
## 11 0.04322938 68.59562 3.288000 105
## 12 0.04349541 65.91332 3.795712 137
## 13 0.02989545 57.51121 3.794055 195
## 14 0.04669588 61.32654 3.509400 165
## 15 0.04804844 55.00000 4.165336 206
## 16 0.02913437 56.02166 3.621111 202
## 17 0.04311454 56.04337 3.992643 217
## 18 0.03688010 56.60371 3.706925 181
## 19 0.03914020 60.43737 3.617402 157
## 20 0.04123711 54.00000 3.696626 194
## 21 0.04330065 54.00000 3.675955 206
## 22 0.04845806 59.29093 3.351926 171
## 23 0.04604113 58.21219 3.513613 186
## 24 0.04284900 56.07936 3.458741 197
## 25 0.03110469 54.00000 3.508958 216
## 26 0.04517932 54.00000 3.508133 222
## 27 0.03808395 59.57900 3.938904 169
## 28 0.04543261 71.94704 3.962468 98
## 29 0.03246156 62.78289 3.603066 133
## 30 0.04495980 55.00000 3.927784 187
## 31 0.02844076 73.47028 3.762586 117
## 32 0.04591343 72.97417 3.889441 103
## 33 0.03731681 56.06648 3.794468 198
## 34 0.04478887 54.00000 3.396006 200
## 35 0.04123956 55.00000 3.723725 204
## 36 0.03088328 56.35595 3.971285 194
## 37 0.03727952 53.00000 3.070815 200
## 38 0.04068920 54.00000 3.506752 201
## 39 0.04478513 54.00000 3.349119 206
## 40 0.03353677 58.41716 3.841166 166
## 41 0.05937666 52.00000 3.149218 226
## 42 0.03474686 58.75416 3.773365 160
## 43 0.02669737 56.45595 3.667185 185
## 44 0.03802650 79.18340 4.180658 101
## 45 0.03514213 59.04727 3.716155 169
## 46 0.02570556 56.67793 3.860300 171
## 47 0.03097798 77.45488 3.740235 100
## 48 0.03157177 56.11584 3.688015 191
## 49 0.05094070 55.00000 3.378145 199
## 50 0.04409005 60.20801 3.603721 173
## 51 0.02919509 64.75861 3.172891 151
## 52 0.05037786 109.13954 4.097158 45
## 53 0.03788577 68.00059 4.200212 120
## 54 0.03298172 60.42834 3.379461 147
## 55 0.03287398 55.00000 3.372704 198
## 56 0.04139018 70.49194 3.600161 105
## 57 0.04034677 85.39159 3.407336 53
## 58 0.04896157 57.11541 3.959218 192
## 59 0.03176898 56.46042 3.747696 184
## 60 0.03101268 55.00000 3.825905 199
## 61 0.04219612 53.00000 3.604366 187
## 62 0.03472963 52.00000 3.302932 230
## 63 0.02293869 56.96496 3.521504 200
## 64 0.04592632 56.00686 3.753750 184
## 65 0.04211915 69.22002 4.288312 117
## 66 0.03759606 56.08546 4.007986 178
## 67 0.03285088 55.00000 3.566990 198
## 68 0.03737048 56.21153 3.571222 189
## 69 0.03492791 70.36293 3.686382 106
## 70 0.05131010 48.00000 3.166822 253
## 71 0.02974698 64.07466 3.821225 147
## 72 0.03377504 55.00000 3.546127 174
## 73 0.04298585 80.55961 3.205506 74
## 74 0.03709433 77.10403 3.164232 70
## 75 0.04248232 56.14183 3.332196 185
## 76 0.05766832 55.00000 3.480735 200
## 77 0.03711040 63.34358 4.347196 140
## 78 0.03440230 59.03764 3.683709 199
## 79 0.02561480 56.36571 3.054997 191
## 80 0.03861562 59.44329 4.164637 178
## 81 0.02505452 56.59071 3.584964 206
## 82 0.03573381 58.76250 3.882188 182
## 83 0.03734723 58.46122 3.653638 173
## 84 0.04415273 71.63055 3.507706 104
## 85 0.03615677 54.00000 3.876491 194
## 86 0.04372937 64.08447 3.034194 139
## 87 0.02929388 59.33600 3.655164 173
## 88 0.04120926 56.03923 3.908560 203
## 89 0.05173088 54.00000 3.744350 203
## 90 0.05533212 68.69469 4.126897 110
## 91 0.03850449 64.68249 3.362277 138
## 92 0.03813047 56.01013 3.612010 185
## 93 0.04051848 54.00000 3.398317 207
## 94 0.03268309 54.00000 3.457789 210
## 95 0.05051488 56.70554 3.968015 209
## 96 0.02856833 56.48118 3.527695 178
## 97 0.03017829 56.14831 3.338764 193
## 98 0.03174388 59.87931 3.872457 161
## 99 0.04446213 58.23791 3.363080 181
## 100 0.03270588 55.00000 3.536778 194
##
## $sim_time
## [1] 0.4177942
##
## $seed
## NULL
##
## $package_version
## [1] '0.80.0'
##
## $distance
## [1] "ks"
##
## attr(,"class")
## [1] "bs_p_xmin"# Graficar datos y línea de ley de potencia ajustada
plot(m)
lines(m, col = 2)
Analisis:
Estimación de parámetros de la ley de potencia: Tiene un valor estimado para el exponente de la ley de potencia,
\(\gamma\)que es aproximadamente 3.58. Este es un indicador común en redes libres de escala, ya que los exponentes de ley de potencia suelen encontrarse en el rango de 2 a 3.Bootstrap de la prueba de Kolmogorov-Smirnov (KS): La prueba KS da un valor de p que parece ser significativo, lo cual indica que la hipótesis nula de que la distribución no sigue una ley de potencia no puede ser rechazada.
Visualización del Ajuste de Ley de Potencia: La gráfica muestra los datos empíricos y la línea ajustada de la ley de potencia, y parece haber una concordancia entre los datos y el modelo propuesto, lo que sugiere que la ley de potencia es un modelo plausible para la distribución de grado de esta red.
Con estos resultados, parece razonable concluir que la red exhibe características de una red libre de escala. El exponente de ley de potencia está dentro del rango esperado, y la prueba estadística no rechaza el ajuste de ley de potencia.
F) Hacer un censo de los clanes y calcular el número clan
# Encontrar cliques maximales
clans <- cliques(G)
# Contar el número de cliques
num_clans <- length(clans)
# Opcional: Graficar la distribución de tamaños de los clanes
clan_sizes <- sapply(clans, length)
hist(clan_sizes, breaks = max(clan_sizes) - min(clan_sizes),
main = "Distribución del Tamaño de Clanes", xlab = "Tamaño del Clan")
library(igraph)
# Supongamos que tienes tu objeto grafo G
# Encuentra todos los clanes (o cliques maximales)
clans <- cliques(G, min = 3) # Aquí puedes ajustar el tamaño mínimo del clan según sea necesario
# Función para calcular centralidad de grado dentro de cada clan
clan_centrality <- lapply(clans, function(clan) {
subgraph <- induced_subgraph(G, vids = clan)
degree(subgraph, normalized = TRUE)
})analsis:
El histograma que representa la distribución del tamaño de los clanes. El eje horizontal representa el tamaño del clan, mientras que el eje vertical representa la frecuencia de clanes de ese tamaño.
Datos:
El histograma muestra que la mayoría de los clanes son pequeños, con un tamaño de 2 a 4 miembros.
Hay una cantidad significativa de clanes con un tamaño de 6 a 8 miembros.
La frecuencia de clanes disminuye a medida que aumenta el tamaño del clan.
Hay un pequeño número de clanes muy grandes, con un tamaño de 12 o más miembros.
Conclusiones:
La distribución del tamaño de los clanes es asimétrica, con una mayor frecuencia de clanes pequeños.
La mayoría de los clanes tienen un tamaño que les permite funcionar como unidades familiares o grupos de trabajo.
Los clanes grandes son menos comunes, pero pueden tener ventajas en términos de poder y recursos.
G) Calcular la densidad junto con el coeficiente de agrupamiento de la red
# Calcular la densidad de la red
network_density <- graph.density(G)## Warning: `graph.density()` was deprecated in igraph 2.0.0.
## ℹ Please use `edge_density()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.# Calcular el coeficiente de agrupamiento global
clustering_coefficient <- transitivity(G, type = "average")
# Crear una visualización simple para mostrar estas métricas
barplot(c(network_density, clustering_coefficient),
names.arg = c("Densidad", "Coef. de Agrupamiento"),
main = "Métricas de Red")
# Para normalizar la centralidad de intermediación
betweenness_centrality <- betweenness(G, normalized = TRUE)# eliminar un nodo y recalcular la densidad y el coeficiente de agrupamiento:
G_less_one <- delete_vertices(G, sample(vcount(G), 1))
new_density <- graph.density(G_less_one)
new_clustering <- transitivity(G_less_one)# red aleatoria con el mismo número de nodos y aristas
G_random <- erdos.renyi.game(vcount(G), p=graph.density(G))
random_density <- graph.density(G_random)
random_clustering <- transitivity(G_random)analsis:
En resumen, la red muestra signos de una estructura comunitaria más compleja y conectada que lo que un modelo aleatorio podría explicar. Esto podría tener implicaciones importantes para la dinámica de la red, como la difusión de información, la resiliencia y la eficiencia de la red.
Densidad de la red:
Original: 0.118
Red aleatoria: 0.119
La densidad de la red original es casi idéntica a la de una red aleatoria con la misma cantidad de nodos y conexiones. La densidad se refiere a la proporción de conexiones posibles que realmente existen en la red, y un valor cercano a 0.118 indica que un poco más del 11% de todas las conexiones posibles están presentes. En el contexto de redes sociales, una densidad baja puede ser normal debido a la vasta cantidad de conexiones posibles. En otros tipos de redes, esto podría interpretarse de manera diferente.
Coeficiente de agrupamiento:
Original: 0.269
Red aleatoria: 0.119
El coeficiente de agrupamiento de la red original es más del doble que el de una red aleatoria. Esto sugiere que la red tiene una estructura de agrupación significativa, lo que puede indicar que los nodos tienden a formar comunidades más estrechamente conectadas que lo que se esperaría por azar. En términos prácticos, esto podría significar que los individuos o nodos en la red tienden a agruparse en grupos con intereses o características similares.
H) Metodos de agrupamiento
# Convertir el grafo dirigido a no dirigido
G_undirected <- as.undirected(G, mode = "collapse", edge.attr.comb = "sum")# Usando el algoritmo de Louvain para encontrar comunidades
set.seed(168)
community_louvain <- cluster_louvain(G_undirected)
plot(community_louvain, G_undirected, vertex.size=5, vertex.label=NA)
# Usando el método de borde entre comunidades para agrupamiento jerárquico
set.seed(168)
community_edge <- cluster_edge_betweenness(G)## Warning in cluster_edge_betweenness(G): At
## vendor/cigraph/src/community/edge_betweenness.c:497 : Membership vector will be
## selected based on the highest modularity score.plot(community_edge, G, vertex.size=5, vertex.label=NA)
# Usando el algoritmo Leading Eigenvector
set.seed(168)
community_leading <- cluster_leading_eigen(G)
plot(community_leading, G, vertex.size=5, vertex.label=NA)
I) Asorsatividad de la red
assortativity_result <- assortativity_degree(G, directed=FALSE)
print(assortativity_result)## [1] -0.06633438Análisis
El análisis de asortatividad para la red bajo estudio ha arrojado un coeficiente de -0.06633438. Este valor, siendo ligeramente negativo, indica una tendencia hacia la disortatividad en la estructura de la red. En términos prácticos, esta tendencia sugiere que los nodos con un alto número de conexiones (hubs) tienden a estar conectados con nodos que tienen un menor número de conexiones. Por el contrario, es menos común que los nodos de alto grado estén interconectados entre sí, o que los nodos de bajo grado formen conexiones entre ellos.
La presencia de este patrón disortativo es característica de redes en las cuales algunos pocos nodos centrales desempeñan un papel crucial en la interconexión de la red, facilitando la difusión de información o recursos a través de un amplio espectro de nodos con menor grado de conectividad. Este fenómeno puede influir significativamente en la eficiencia de la red en términos de comunicación y propagación, así como en su vulnerabilidad a ataques dirigidos o fallos sistemáticos que podrían desestabilizar rápidamente la red si estos nodos centrales se vieran afectados.
En conclusión, el patrón disortativo observado en la red podría ser indicativo de una estructura jerárquica o de una configuración en la que los nodos altamente conectados juegan un papel crucial en la cohesión de la red, lo cual debería ser considerado en la gestión y diseño estratégico de la misma.