Centralidad en redes

Datos

En este ejemplos consideramos la red de aeropuertos de EU:

library(tidyverse)
library(tidygraph)
library(ggraph)
library(igraphdata)
data("USairports")

US airport network, 2010 December Description The network of passanger flights between airports in the United States. The data set was compiled based on flights in 2010 December. This network is directed and edge directions correspond to flight directions. Each edge is specific to a single carrier aircraft type. Multiple carriers between the same two airports are denoted by multiple edges.

name Symbolic vertex name, this is the three letter IATA airport code.

City City and state, where the airport is located.

Position Position of the airport, in WGS coordinates.

Edge attributes:

Carrier Name of the airline. The network includes both domestic and international carriers that performed at least one flight in December of 2010.

Departures The number of departures (for a given airline and aircraft type.

Seats The total number of seats available on the flights carried out by a given airline, using a given aircraft type.

Passengers The total number of passangers on the flights carried out by a given airline, using a given aircraft type.

Aircraft Type of the aircraft.

Distance The distance between the two airports, in miles.

# ver detalles
?USairports

Nota que cada arista corresponde a una aerolínea (carrier) y tipo de avión (Aircraft), y los nodos son los aeropuertos. Los datos de las aristas corresponden a vuelos de Diciembre de 2010, y es una gráfica dirigida.

airports <- USairports %>% as_tbl_graph()
airports

# A tbl_graph: 755 nodes and 23473 edges
#
# A directed multigraph with 6 components
#
# Node Data: 755 x 3 (active)
  name  City          Position        
  <chr> <chr>         <chr>           
1 BGR   Bangor, ME    N444827 W0684941
2 BOS   Boston, MA    N422152 W0710019
3 ANC   Anchorage, AK N611028 W1495947
4 JFK   New York, NY  N403823 W0734644
5 LAS   Las Vegas, NV N360449 W1150908
6 MIA   Miami, FL     N254736 W0801726
# … with 749 more rows
#
# Edge Data: 23,473 x 8
   from    to Carrier             Departures Seats Passengers Aircraft Distance
  <int> <int> <chr>                    <dbl> <dbl>      <dbl>    <int>    <dbl>
1     1     4 British Airways Plc          1   226        193      627      382
2     1     4 British Airways Plc          1   299        253      819      382
3     2     7 British Airways Plc          1   216        141      627      200
# … with 2.347e+04 more rows

Esta gŕafica es un multigrafo (puede haber varias aristas con la misma dirección en un par de nodos). Nos interesa en primer lugar agregar a un grafo, y considerar el total de pasajeros (puedes también considerar número de asientos, por ejemplo) que viajó entre cada par de aeropuertos. Podemos agregar de las siguiente forma:

# seleccionamos solo pasajeros
vertices <- airports %>% 
  activate(edges) %>% 
  select(to, from, Passengers) %>% as_tibble()
# agregar considerarando el total de pasajeros
vertices_agregados <- vertices %>% 
  group_by(to, from) %>% 
  summarise(pax = sum(Passengers))
# nodos, y agregar estado a la ciudad
nodos <- airports %>% activate(nodes) %>% 
  as_tibble() %>% 
  separate(City, into = c('ciudad_nombre', 'estado'), sep = ', ')
# construir nueva red
aeropuertos <- tbl_graph(nodes = nodos, edges = vertices_agregados) 
aeropuertos 

# A tbl_graph: 755 nodes and 8265 edges
#
# A directed multigraph with 6 components
#
# Node Data: 755 x 4 (active)
  name  ciudad_nombre estado Position        
  <chr> <chr>         <chr>  <chr>           
1 BGR   Bangor        ME     N444827 W0684941
2 BOS   Boston        MA     N422152 W0710019
3 ANC   Anchorage     AK     N611028 W1495947
4 JFK   New York      NY     N403823 W0734644
5 LAS   Las Vegas     NV     N360449 W1150908
6 MIA   Miami         FL     N254736 W0801726
# … with 749 more rows
#
# Edge Data: 8,265 x 3
   from    to   pax
  <int> <int> <dbl>
1     2     1     2
2     4     1    35
3     6     1     3
# … with 8,262 more rows

Filtro de conexiones débiles

Podemos también filtrar opcionalmente aquellas conexiones que tengan un número de pasajeros bajo durante el mes de observación. La distribución de pasajeros podemos examinarla con_

pasajeros <- aeropuertos %>% activate(edges) %>% 
  select(from, to , pax)
quantile(pull(pasajeros, pax), seq(0, 1, 0.1))

      0%      10%      20%      30%      40%      50%      60%      70%      80%      90%     100% 
     1.0     13.0     50.0    142.0    862.2   1856.0   3343.4   5273.8   8948.2  18117.2 142839.0 

corte_pax <- 100
aero_grandes <- aeropuertos %>% activate(edges) %>% 
  filter(pax > corte_pax) %>% 
  activate(nodes) %>% 
  filter(!node_is_isolated()) #eliminar nodos que quedan sin conexiones

Haz una primera gráfica (checa también como colorear según una variable de nodos):

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros")) %>% 
    ggraph(layout = 'fr', niter = 2000) +  #fr es un algoritmo basado en fuerzas
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_ca)) +
    theme_graph()

#Las aristas actúan como resortes, que no permiten que nodos ligados se alejen mucho
#Los nodos tienen fuerzas de repulsión entre ellos (la analogía física es de cargas elécricas), y también a veces de gravedad entre ellos.
#El algoritmo de representación intenta minimizar la energía de la configuración del sistema de atracciones y repulsiones.

EJEMPLO: AQUI CHECAMOS CÓMO COLOREAR OTRA VARIABLE DE NODOS Podemos colorear por estado, ciudad o nombre del aeropuerto

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_at = ifelse(estado == "GA", "GA", "Otros")) %>%  #Georgia
    ggraph(layout = 'fr', niter = 2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_at)) +
    theme_graph()

Pregunta 1: cuántas componentes tiene esta gráfica (tip: haz un mutate con la función group_components)

Tenemos un total de 575 nodos (aeropuertos) y se generaron 8 grupos (redes conexas) el grupo más grande

componentes <- aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros"))  %>% 
    mutate(grupos = group_components())  %>%
#group_components These functions are wrappers around the various clustering functions provided by igraph. As with the other wrappers they automatically use the graph that is being computed on, and otherwise passes on its arguments to the relevant clustering function. The return value is always a numeric vector of group memberships so that nodes or edges with the same number are part of the same group. Grouping is predominantly made on nodes and currently the only grouping of edges supported is biconnected components.
    ggraph(layout = 'fr', niter = 2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_at)) +
    theme_graph()

componentes$data

componentes$data$name

  [1] "BGR" "BOS" "ANC" "JFK" "LAS" "MIA" "EWR" "LAX" "AEX" "BFI" "ELM" "GEG" "ICT" "PBI" "PIT" "SFO" "VCT" "IAD"
 [19] "ABE" "AGS" "AVL" "AVP" "BDL" "BHM" "BNA" "BTR" "BUF" "BWI" "CAE" "CAK" "CHA" "CHO" "CHS" "CLE" "CLT" "CMH"
 [37] "CRW" "CVG" "DAB" "DAY" "DCA" "DTW" "EWN" "FAY" "GNV" "GPT" "GSO" "GSP" "HPN" "HSV" "ILM" "IND" "JAN" "LEX"
 [55] "LGA" "LIT" "MDT" "MGM" "MKE" "MLB" "MOB" "MSP" "MSY" "MYR" "OAJ" "ORF" "PGV" "PHF" "PHL" "PNS" "PWM" "RDU"
 [73] "RIC" "ROA" "SAV" "SDF" "SRQ" "STL" "SYR" "TLH" "TRI" "TYS" "VPS" "XNA" "ALB" "BGM" "BTV" "ERI" "FLO" "HHH"
 [91] "HTS" "HVN" "IPT" "ISP" "ITH" "LYH" "MHT" "PVD" "ROC" "SBY" "SCE" "SWF" "BFD" "DUJ" "EYW" "FKL" "FLL" "JHW"
[109] "LWB" "MCO" "PKB" "TPA" "ACT" "AOO" "BHB" "BKW" "BPT" "CKB" "CLL" "DRT" "GRK" "IAH" "JST" "LCH" "LFT" "MAF"
[127] "MGW" "MLU" "ORD" "PBG" "PQI" "SHD" "SHV" "TYR" "CID" "MCI" "MLI" "MSN" "OKC" "OMA" "SBN" "SGF" "TUL" "ABQ"
[145] "ATL" "AUS" "BKG" "DEN" "DFW" "HOU" "MDW" "PDX" "PHX" "PIE" "RSW" "SAN" "SAT" "SEA" "SLC" "SMF" "SNA" "TUS"
[163] "ABY" "ACY" "BMI" "DSM" "FNT" "GLH" "GRR" "GTR" "JAX" "MEM" "SJU" "UTM" "GUM" "ROP" "SPN" "TIQ" "SIT" "AMA"
[181] "FSM" "GGG" "LAW" "LBB" "SJT" "SPS" "STT" "STX" "TXK" "BOI" "BUR" "HNL" "KOA" "LIH" "OAK" "OGG" "ONT" "RNO"
[199] "SJC" "JHM" "LNY" "MKK" "HOM" "KEB" "PGM" "SOV" "AIN" "BTI" "FAI" "FYU" "GAL" "KAL" "KSM" "NUI" "NUL" "ORV"
[217] "OTZ" "PHO" "PIZ" "RBY" "SCC" "VEE" "WTK" "ADQ" "KLN" "KOZ" "OLH" "ORI" "MTM" "WFB" "HCR" "MCG" "AET" "AKP"
[235] "HSL" "KYU" "MRI" "TAL" "AKI" "ATT" "BET" "CYF" "EEK" "KKH" "KKI" "KLG" "KPN" "KUK" "KWK" "KWN" "KWT" "MLL"
[253] "NME" "NUP" "OOK" "PKA" "RSH" "TLT" "WNA" "WTL" "WWT" "AKN" "ANI" "BRW" "CDV" "DLG" "EMK" "ENA" "HPB" "UNK"
[271] "VDZ" "ABL" "BKC" "DRG" "ELI" "GAM" "GLV" "IAN" "KKA" "KTS" "KVL" "OBU" "OME" "RDB" "SHG" "SHH" "SKK" "SMK"
[289] "SVA" "TLA" "WBB" "WLK" "WMO" "ABI" "COS" "CRP" "EGE" "ELP" "FAT" "GJT" "HDN" "JAC" "MFE" "MTJ" "PSP" "SFB"
[307] "ADK" "BLI" "EUG" "JNU" "KTN" "PSG" "PUW" "WRG" "YAK" "BQN" "LGB" "PSE" "AUK" "CDB" "DUT" "KOT" "KVC" "MOU"
[325] "MYU" "SCM" "VAK" "ATK" "PQS" "ILI" "SDP" "SNP" "BVU" "TYE" "GST" "HNH" "HNS" "SGY" "ATW" "GUC" "SWO" "BIL"
[343] "BZN" "DLH" "FAR" "FSD" "GRB" "GTF" "IDA" "MBS" "MOT" "MSO" "ABR" "AZO" "BIS" "COU" "DAL" "ECP" "EVV" "FWA"
[361] "GFK" "LAN" "LNK" "LSE" "MQT" "PIA" "PLN" "RST" "TVC" "LJN" "EFD" "FOE" "RAP" "AZA" "BFL" "HRL" "TWF" "BED"
[379] "BQK" "CMI" "GCK" "LCK" "MQY" "PSM" "RFD" "YIP" "ILG" "MHK" "ESD" "FRD" "ASE" "DRO" "AHN" "CNM" "MCN" "MKL"
[397] "OWB" "BID" "WST" "LAR" "ACV" "BTM" "CDC" "CEC" "CIC" "CLD" "CMX" "COD" "CPR" "CWA" "EAU" "EKO" "FCA" "GCC"
[415] "HLN" "IPL" "IYK" "LMT" "LWS" "MFR" "MKG" "MMH" "MOD" "MRY" "OTH" "PAH" "PIH" "PSC" "RDD" "RDM" "RKS" "SBA"
[433] "SBP" "SGU" "SMX" "SPI" "SUN" "YUM" "BLD" "DQR" "GCN" "PGA" "AIA" "ALS" "BFF" "CDR" "CEZ" "CNY" "CVN" "CYS"
[451] "DDC" "DIK" "EAR" "FMN" "GDV" "GGW" "GRI" "HON" "HVR" "HYS" "IGM" "ISN" "JLN" "LBF" "LBL" "MBL" "MCE" "MCK"
[469] "OLF" "PIR" "PRC" "PUB" "RHI" "RIW" "SDY" "SHR" "SOW" "SVC" "TBN" "TEX" "VEL" "VIS" "WRL" "DHN" "FNL" "FTW"
[487] "IFP" "ISO" "LRD" "PAM" "PGD" "SCK" "TOL" "YNG" "ALW" "EAT" "STS" "YKM" "SIG" "SPB" "SSB" "VQS" "CEF" "CSG"
[505] "IAG" "LBE" "ORH" "RME" "MEI" "VLD" "CLM" "LKE" "BRO" "NYL" "ALO" "APN" "ATY" "BJI" "BRD" "CIU" "DVL" "ESC"
[523] "FOD" "HIB" "IMT" "INL" "JMS" "MCW" "MSL" "PIB" "SUX" "TUP" "TVF" "ACK" "LEB" "MVY" "PVC" "1G4" "VGT" "BRL"
[541] "DEC" "DBQ" "ROW" "SAF" "ENV" "ART" "AUG" "CGI" "EWB" "HGR" "HYA" "IRK" "LNS" "MAZ" "MSS" "MWA" "OGS" "RKD"
[559] "RUT" "SLK" "UIN" "FLG" "ITO" "AST" "ELD" "HRO" "ONP" "PDT" "SLN" "STC" "STJ" "PPG" "CPX" "JRV" "LFI"

componentes$data$grupos

  [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [55] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[109] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[163] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[217] 1 1 1 1 1 1 1 1 1 1 1 1 4 4 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[271] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[325] 1 1 1 1 1 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[379] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 5 5 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[433] 1 1 1 1 1 1 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[487] 1 1 1 6 1 1 1 1 1 1 1 1 1 7 7 1 1 1 1 1 1 1 1 1 1 8 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1
[541] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 6

Preguntar qué significa el parámetro strong/weak

NO CORRER ESTE CHUNK:

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros"),group=group_components(type = "strong")) %>% 
    ggraph(layout = 'fr', niter = 2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_ca)) +
    theme_graph()

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros"),group=group_components(type = "weak")) %>% 
    ggraph(layout = 'fr', niter = 2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_ca)) +
    theme_graph()

Pregunta 2: prueba otro layout: kk o graphopt, por ejemplo. ¿Puedes reconocer estructuras distintas? ¿Qué método parece funcionar mejor?

Parece que el layout kk elimina de la gráfica los vértices que no son fuertemente conexos es más sencillo apreciar la red pues hace un zoom a donde hay mayor cantidad de nodos conexos. Con este gráfico, notamos que el estado de California (nodos rojos) cuenta con muchos más aeropuertos que aparentemente cada uno debe conectarse con distintos aeropuertos de otros estados.

En cambio, graphopt mantiene todos los nodos pero parece alejar del centro aquellos aeropuertos que tienen poca o nula conexión con el resto de la red lo cual da una perspectiva más alejada y más difícil de leer

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros")) %>% 
    ggraph(layout = 'kk') +  #Argument `niter' is deprecated and has no effect
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_ca)) +
    theme_graph()

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros")) %>% 
    ggraph(layout = 'graphopt', niter = 2000) +  #fr es un algoritmo basado en fuerzas
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_ca)) +
    theme_graph()

Extraer componente grande

Filtra la componente conexa más grande:

aero <- aero_grandes %>% 
    activate(nodes) %>% 
    mutate(component = group_components()) %>%
    filter(component == 1)

Intermediación

Calcula intermediación:

aero <- aero %>% activate(nodes) %>% 
  mutate(intermediacion = centrality_betweenness())

Pregunta 3: ¿cuáles son los aeropuertos con intermediación más grande? (convierte el objeto de la gráfica a tibble después de activar nodos).

El aeropuerto con mayor intermediación es ANC (Aeropuerto Internacional de Anchorage, Alaska) con 86685.51871 Otros aeropuertos importantes son: 35444.42724, DEN, Denver, Colorado 33673.75778, MSP, Minneapolis, Minesota 31411.75000, BET, Bethel, Alaska 30286.27085, SEA, Seattle, Washington 29361.47210, ORD, Chicago, Illinois 26290.08520, ATL, Atlanta, Georgia

aero <- aero %>% 
  activate(nodes) %>% 
  as_tibble %>%
view(aero)

Ahora haz una gráfica coloreando con un estado relevante (considera tu respuesta de la pregunta anterior) y usando la intermediación como tamaño:

aero %>%
    activate(nodes) %>% 
    mutate(color_edo = ifelse(estado == "AK", "AK", "Otros")) %>% 
    ggraph(layout = 'fr', niter=2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(size = intermediacion, colour=color_edo)) +
    theme_graph()

Pregunta 4 Explica el nodo con mayor intermediación de la gráfica. ¿Qué conecta?

Seleccionamos el estado de Alaska ya que 2 de sus aeropuertos tienen una intermediación alta.

Con ello, vemos que el aeropuerto de Anchorage está conectando de manera casi exclusiva todos los aeropuertos de Alaska aeropuestos de otros estados de los estados.

Centralidad de eigenvector

Calcula centralidad de eigenvector, y ahora usa tamaño para esta centralidad y color para intermediación

aero <- aero %>%
    activate(nodes) %>% 
    mutate(central_eigen = centrality_eigen())

aero %>%
    activate(nodes) %>% 
    mutate(color_edo = ifelse(estado == "AK", "AK", "Otros")) %>% 
    ggraph(layout = 'fr', niter=2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(size = central_eigen, colour=intermediacion)) +
    theme_graph()

Pregunta 5 ¿Cuáles son los aeropuertos con mayor centralidad de eigenvector? Contrasta con intermediación.

El aeropuerto de ATL que tiene mayor centralidad es el séptimo lugar en intermediación, por otro lado, el aeropuerto de ORD se coloca en segundo lugar de centralidad de eigenvector con la sexta posición el aeropuerto de DFW es el tercer lugar en centralidad. Sin embargo, no figuró en los primeros lugares bajo intermediación.

El aeropuerto con mayor centralidad de eigenvector es ATL (Aeropuerto Internacional de Atlanta, Georgia) con 1 Otros aeropuertos importantes son: 0.98400301, ORD, Chicago, Illinois 0.92300746, DFW, Dallas/Ft.Worth, Texas 0.91313227, DEN, Denver, Colorado 0.90823356, MSP, Minneapolis, Minesota 0.89876803, DTW, Detroit, Michigan 0.86630960, LAS, Las Vegas, Nevada

El aeropuerto con mayor intermediación es ANC (Aeropuerto Internacional de Anchorage, Alaska) con 86685.51871 Otros aeropuertos importantes son: 35444.42724, DEN, Denver, Colorado 33673.75778, MSP, Minneapolis, Minesota 31411.75000, BET, Bethel, Alaska 30286.27085, SEA, Seattle, Washington 29361.47210, ORD, Chicago, Illinois 26290.08520, ATL, Atlanta, Georgia

aero <- aero %>% 
  activate(nodes) %>% 
  as_tibble %>%
view(aero)

Examinar centralidad

Elimina los aeropuertos de Alaska y vuelve a graficar, esta vez usando centralidad de eigenvector para color y tamaño.

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% #Eliminamos estado de Alaska
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) + #Usamos layoutgraphopt
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  theme_graph() 

Pregunta 6: ¿calcular centralidad y luego filtrar nodos es lo mismo que filtrar nodos y luego calcular centralidad? No es lo mismo, ya que la centralidad depende de la importancia de los nodos vecinos. Es decir, si primero filtramos los nodos de Alaska y luego calculamos centralidad entonces estos no se toman en cuenta para el cálculo y si los quitamos después de calcular la centralidad, en realidad sólo estamos omitiendo nodos que sí se consideraron para calcular los nodos.

Definición Centralidad de eigenvector

Esta medida considera que la importancia de un nodo está dado por la suma normalizada de las importancias de sus vecinos. De esta forma, es importante estar cercano a nodos importantes (como en cercanía), pero también cuenta conectarse a muchos nodos (como en grado).

• Nótese que esta es una descripción circular: para saber la importancia de un nodo, hay que saber la importancia de sus vecinos.

Pregunta 7: experimenta con los parámetros del layout (por ejemplo, los 2 que se usan arriba). ¿Cómo obtienes mejores resultados?

Cambiamos los parámetros spring constant y charge.

Aumentar spring constant (Por ejemplo a 10) hace que los nodos con mayor centralidad se aglomeren y traslapen. Por lo que visualmente no es posible apreciarlos bien. Por el contrario, si reducimos este valor a por ejemplo 0.01, los nodos con mayor centralidad se separan demasiado llegando a los extemos del gráfico.

Disminuir charge (por ejemplo a 0.001) hace que los nodos se separen más entre sí, mientras que aumentar la carga (por ejemplo a 0.5) hace que los nodos se repelan.

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% #Eliminamos estado de Alaska
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) + #Usamos layoutgraphopt
  #The spring constant, the default value is one.
  #The charge of the vertices, used to calculate electric repulsion. The default is 0.001.
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  theme_graph() 

Pregunta 8 (más difícil): etiqueta los nodos. Etiqueta solo los nodos que tengan centralidad de eigenvector alta. Puedes experimentar (layout, colores, tamaño de texto) con este código:

nodos_imp <- aero %>% activate(nodes) %>% as_tibble() %>%
    arrange(desc(central_eigen))
qplot(pull(nodos_imp, central_eigen))

Comprobamos cuáles son:

etiquetas <- aero %>% activate(nodes) %>% as_tibble() %>%
    filter(estado!="AK") %>% 
    arrange(desc(central_eigen)) %>% 
    top_n(10) %>% 
    select(name)

Selecting by central_eigen

cota_centro<-.85

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% 
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) + 
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  geom_node_text(aes(filter=central_eigen>cota_centro,label =name, alpha = central_eigen), repel = FALSE, size = 3, color = "red") +
  theme_graph() 

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% 
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) + 
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  geom_node_text(aes(label = ifelse(central_eigen > cota_centro, name, NA), alpha = central_eigen), repel = TRUE, size = 3, color = "black") +
  theme_graph()