library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
library(tidygraph)
## 
## Attaching package: 'tidygraph'
## The following object is masked from 'package:igraph':
## 
##     groups
## The following object is masked from 'package:stats':
## 
##     filter
library(ggraph)
## Loading required package: ggplot2
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v tibble  3.1.0     v dplyr   1.0.5
## v tidyr   1.1.3     v stringr 1.4.0
## v readr   1.4.0     v forcats 0.5.1
## v purrr   0.3.4
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::as_data_frame() masks tibble::as_data_frame(), igraph::as_data_frame()
## x purrr::compose()       masks igraph::compose()
## x tidyr::crossing()      masks igraph::crossing()
## x dplyr::filter()        masks tidygraph::filter(), stats::filter()
## x dplyr::groups()        masks tidygraph::groups(), igraph::groups()
## x dplyr::lag()           masks stats::lag()
## x purrr::simplify()      masks igraph::simplify()
similitud <- read_delim("https://github.com/martinmontane/martinmontane.github.io/raw/master/similitud.csv",delim=";")
## 
## -- Column specification --------------------------------------------------------
## cols(
##   sectorSalida = col_character(),
##   sectorLlegada = col_character(),
##   RijCorregido = col_double(),
##   flow = col_double()
## )
glimpse(similitud)
## Rows: 140,589
## Columns: 4
## $ sectorSalida  <chr> "11-1010", "11-1010", "11-1010", "11-1010", "11-1010", "~
## $ sectorLlegada <chr> "11-1010", "11-1020", "11-2010", "11-2020", "11-2030", "~
## $ RijCorregido  <dbl> -1.0000000, 0.9159743, -1.0000000, 0.6218945, -1.0000000~
## $ flow          <dbl> 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 2, 1, 0, 0, 0,~
similitud <- similitud %>% filter(flow>10)
glimpse(similitud)
## Rows: 425
## Columns: 4
## $ sectorSalida  <chr> "11-2020", "11-2020", "11-2020", "11-2020", "11-2020", "~
## $ sectorLlegada <chr> "11-9190", "41-1010", "41-2030", "41-3090", "41-4010", "~
## $ RijCorregido  <dbl> 0.6045836, 0.7280474, 0.5294999, 0.6888004, 0.7288310, 0~
## $ flow          <dbl> 75, 16, 30, 11, 24, 28, 30, 19, 11, 15, 12, 31, 40, 19, ~
descripcion <- read_delim("https://raw.githubusercontent.com/martinmontane/martinmontane.github.io/master/descripcion.csv",delim=";")
## 
## -- Column specification --------------------------------------------------------
## cols(
##   broadGroup = col_character(),
##   Desc = col_character()
## )
glimpse(descripcion)
## Rows: 461
## Columns: 2
## $ broadGroup <chr> "11-1010", "11-1020", "11-1030", "11-2010", "11-2020", "11-~
## $ Desc       <chr> "Chief Executives", "General and Operations Managers", "Leg~

Preparamos el dataset para procesarlo y generar un grafo

similitud <- similitud %>%
               mutate(RijSimple=ifelse(RijCorregido>0,1,0)) %>% 
               filter(RijSimple == 1)
grafo <- graph_from_data_frame(similitud,directed = FALSE)
class(grafo)
## [1] "igraph"

y lo ploteamos

plot(grafo)

Eliminamos los loops

grafo <- igraph::simplify(grafo,remove.loops=TRUE)
plot(grafo)

lo conviertemos en el formato tbl_graph que tidygraph puede manipular

grafo <- as_tbl_graph(grafo)
class(grafo)
## [1] "tbl_graph" "igraph"

ahora quedan separados nodos y edges

cuando queremos operar hay que activar unos u otros

ahora la manipulación del grafo pasa a ser similar a la de los dataset que tiene tidyverse

usamos mutate para identificar nodos y aristas

grafo <- grafo %>% mutate(nodo="nodo")
grafo
## # A tbl_graph: 98 nodes and 237 edges
## #
## # An undirected simple graph with 3 components
## #
## # Node Data: 98 x 2 (active)
##   name    nodo 
##   <chr>   <chr>
## 1 11-2020 nodo 
## 2 11-3030 nodo 
## 3 11-9010 nodo 
## 4 11-9030 nodo 
## 5 11-9050 nodo 
## 6 11-9110 nodo 
## # ... with 92 more rows
## #
## # Edge Data: 237 x 2
##    from    to
##   <int> <int>
## 1     1     7
## 2     1    36
## 3     1    39
## # ... with 234 more rows
grafo <- grafo %>% activate(edges) %>% mutate(arista="arista")
grafo
## # A tbl_graph: 98 nodes and 237 edges
## #
## # An undirected simple graph with 3 components
## #
## # Edge Data: 237 x 3 (active)
##    from    to arista
##   <int> <int> <chr> 
## 1     1     7 arista
## 2     1    36 arista
## 3     1    39 arista
## 4     1    41 arista
## 5     1    42 arista
## 6     2     7 arista
## # ... with 231 more rows
## #
## # Node Data: 98 x 2
##   name    nodo 
##   <chr>   <chr>
## 1 11-2020 nodo 
## 2 11-3030 nodo 
## 3 11-9010 nodo 
## # ... with 95 more rows

Usamos left_join para asociar los descriptores de nodos que están en el dataset “descripcion” para poder identificarlos más fácil al analizar algún resutado

grafo <- grafo %>% activate(nodes) %>% left_join(descripcion,by=c("name"="broadGroup"))
grafo
## # A tbl_graph: 98 nodes and 237 edges
## #
## # An undirected simple graph with 3 components
## #
## # Node Data: 98 x 3 (active)
##   name    nodo  Desc                                              
##   <chr>   <chr> <chr>                                             
## 1 11-2020 nodo  Marketing and Sales Managers                      
## 2 11-3030 nodo  Financial Managers                                
## 3 11-9010 nodo  Farmers, Ranchers, and Other Agricultural Managers
## 4 11-9030 nodo  Education Administrators                          
## 5 11-9050 nodo  Food Service Managers                             
## 6 11-9110 nodo  Medical and Health Services Managers              
## # ... with 92 more rows
## #
## # Edge Data: 237 x 3
##    from    to arista
##   <int> <int> <chr> 
## 1     1     7 arista
## 2     1    36 arista
## 3     1    39 arista
## # ... with 234 more rows

Medidas de centralidad

centrality degree es una “medida” de la centralidad del nodo en la red (el más básico) El grado de un nodo es igual a la cantidad de aristas que inciden sobre el nodo

grafo <- grafo %>% activate(nodes) %>% mutate(grado=centrality_degree())
grafo
## # A tbl_graph: 98 nodes and 237 edges
## #
## # An undirected simple graph with 3 components
## #
## # Node Data: 98 x 4 (active)
##   name    nodo  Desc                                               grado
##   <chr>   <chr> <chr>                                              <dbl>
## 1 11-2020 nodo  Marketing and Sales Managers                           5
## 2 11-3030 nodo  Financial Managers                                     3
## 3 11-9010 nodo  Farmers, Ranchers, and Other Agricultural Managers     2
## 4 11-9030 nodo  Education Administrators                               2
## 5 11-9050 nodo  Food Service Managers                                  7
## 6 11-9110 nodo  Medical and Health Services Managers                   2
## # ... with 92 more rows
## #
## # Edge Data: 237 x 3
##    from    to arista
##   <int> <int> <chr> 
## 1     1     7 arista
## 2     1    36 arista
## 3     1    39 arista
## # ... with 234 more rows

Representamos la distribución de grados Para eso tenemos que convertir la info de nodos a un dataframe para poder usar group-summarize y generar una variable “freq” que representa cuantas veces aparece cada grado La variable frec normaliza la medida de grado al indicar una proporcion del total.

dist <- grafo %>% 
  activate(nodes) %>%
  as.data.frame() %>% 
  group_by(grado) %>% 
  summarise(N=n()) %>% 
  mutate(freq=N/sum(N))
summary(dist)
##      grado             N               freq        
##  Min.   : 0.00   Min.   : 1.000   Min.   :0.01020  
##  1st Qu.: 5.25   1st Qu.: 1.000   1st Qu.:0.01020  
##  Median :10.50   Median : 1.500   Median :0.01531  
##  Mean   :11.73   Mean   : 4.455   Mean   :0.04545  
##  3rd Qu.:15.75   3rd Qu.: 3.000   3rd Qu.:0.03061  
##  Max.   :32.00   Max.   :28.000   Max.   :0.28571

y lo graficamos

ggplot(dist) +
  geom_point(aes(y=freq, x=grado)) +
  labs(x="k",y="Pk") +
  theme_minimal()

Hay un solo nodo de grado 32 y unos pocos de grado 0

los de grado 0 son los que tenian loops y los eliminamos

grafo <- grafo %>% activate(nodes) %>% filter(!grado == 0)

Ordenamos el dataset por grado, de manera descendente

grafo %>% activate(nodes) %>% arrange(desc(grado)) %>% as_tibble()
## # A tibble: 96 x 4
##    name    nodo  Desc                                                grado
##    <chr>   <chr> <chr>                                               <dbl>
##  1 11-9190 nodo  Miscellaneous Managers                                 32
##  2 37-2010 nodo  Building Cleaning Workers                              28
##  3 53-3030 nodo  Driver/Sales Workers and Truck Drivers                 24
##  4 51-9190 nodo  Miscellaneous Production Workers                       21
##  5 43-6010 nodo  Secretaries and Administrative Assistants              17
##  6 53-7060 nodo  Laborers and Material Movers, Hand                     16
##  7 41-2030 nodo  Retail Salespersons                                    15
##  8 35-1010 nodo  Supervisors of Food Preparation and Serving Workers    14
##  9 47-2060 nodo  Construction Laborers                                  13
## 10 41-2010 nodo  Cashiers                                               12
## # ... with 86 more rows
igraph::diameter(grafo)
## [1] 6

Paths

ahora vamos a estudiar secuencias (caminos) entre nodos. Un camino es una secuencia de nodos y para identificarlos resulta útil asignarles un id

grafo <- grafo %>% 
         activate(nodes) %>% 
         mutate(nodeID=V(.))
grafo
## # A tbl_graph: 96 nodes and 237 edges
## #
## # An undirected simple graph with 1 component
## #
## # Node Data: 96 x 5 (active)
##   name    nodo  Desc                                             grado nodeID   
##   <chr>   <chr> <chr>                                            <dbl> <igrph.v>
## 1 11-2020 nodo  Marketing and Sales Managers                         5 1        
## 2 11-3030 nodo  Financial Managers                                   3 2        
## 3 11-9010 nodo  Farmers, Ranchers, and Other Agricultural Manag~     2 3        
## 4 11-9030 nodo  Education Administrators                             2 4        
## 5 11-9050 nodo  Food Service Managers                                7 5        
## 6 11-9110 nodo  Medical and Health Services Managers                 2 6        
## # ... with 90 more rows
## #
## # Edge Data: 237 x 3
##    from    to arista
##   <int> <int> <chr> 
## 1     1     7 arista
## 2     1    36 arista
## 3     1    39 arista
## # ... with 234 more rows

ahora analizaremos los caminos dentro de una red. Entre dos nodos puese haber múltiples caminos y pueden ser de distinta longitud (la longitud es la cantidad de aristas que debemos recorrer desde elnodo origen y el destino). Lo qu en general interesa es el camino más corto entre dos nodos que nos dice cuan relacionados estan esos nodos. la función shortest_paths(). Le pasamos un grafo, un nodo de salida y entrada y le decimos que queremos obtener tanto los nodos como las aristas que unen a esos dos puntos.

En este caso se eligieron dos nodos (porque el profe sabía que tenian potencial!)

salida será un vector, que solo cntendrá el codigo del nodo, pero que tiene el formato de un objeto igraph:

salida <- grafo %>% #carga en salida
activate(nodes) %>% #activando primero los nodos
  filter(name == "15-1120") %>% #filtrando el nodo que queremos identificar
  pull(nodeID) #extrayendo un vector en base al nodeID de ese nodo -> 

llegada <- grafo %>%
  activate(nodes) %>%
  filter(name == "51-6050") %>%
  pull(nodeID)

path <- shortest_paths(
  graph = grafo,
  from = salida,
  to = llegada,
  output = 'both'
) #obtiene el path mas corto y devuelve una lista, pero solo con los datos de nodos y aristas del camino más corto
salida
## + 1/96 vertex, named, from 8b747bc:
## [1] 15-1120
llegada
## + 1/96 vertex, named, from 8b747bc:
## [1] 51-6050
path
## $vpath
## $vpath[[1]]
## + 7/96 vertices, named, from 8b747bc:
## [1] 15-1120 15-1110 11-9190 11-9050 35-1010 51-6030 51-6050
## 
## 
## $epath
## $epath[[1]]
## + 6/237 edges from 8b747bc (vertex names):
## [1] 15-1110--15-1120 11-9190--15-1110 11-9050--11-9190 11-9050--35-1010
## [5] 35-1010--51-6030 51-6030--51-6050
## 
## 
## $predecessors
## NULL
## 
## $inbound_edges
## NULL

en path está el camino mas corto, representado por los 7 nodos y las 6 aristas que lo cmponen la distancia del path es 6

reconstruimos un grafo a partir de los datos obtenidos

camino <- grafo %>%
    subgraph.edges(eids = path$epath %>% unlist()) %>%
    as_tbl_graph() #as_tbl_graph lo convierte en un tipo igraph (que igraph reconoce como grafo)
plot(camino) #grafica camino

ahora vamos a calcular las distancias (caminos más cortos entre todos los vértices que quedan en grafo)

distancias <- shortest.paths(grafo)

“distancias” es una tabla con todos los nodos en columnas, todos los nodos en fila y la distancia que hay entre cada nodo de salida y llegada (camino más corto)

Esta matriz podemos convertirla en algo un dataset que podamos manipular con las funciones conocidas. Usamos pivot_longer() para que pase a formato largo y rename() para emprolijar los nombres de las columnas. Además, ordenamos de mayor a menor según la distancia

distancias_long <- distancias %>% 
  as_tibble(rownames = NA) %>% #convierte en un data frame 
  rownames_to_column() %>% 
  pivot_longer(.,cols =2:ncol(.)) %>%
  rename(nodo1=rowname,
         nodo2=name,
         distancia=value) %>% 
  arrange(desc(distancia))

lista de pares de ocupaciones que están conectadas de manera directa

Si están conectadas de manera directa, sus shorterst paths deben valer 1 A partir de “distancias_long” Filtramos los pares de nodos cuyas distancias sean 1

distancias_direct <- distancias_long %>%
  filter(distancia==1)
summary (distancias_direct)
##     nodo1              nodo2             distancia
##  Length:474         Length:474         Min.   :1  
##  Class :character   Class :character   1st Qu.:1  
##  Mode  :character   Mode  :character   Median :1  
##                                        Mean   :1  
##                                        3rd Qu.:1  
##                                        Max.   :1
head(distancias_direct,10)
## # A tibble: 10 x 3
##    nodo1   nodo2   distancia
##    <chr>   <chr>       <dbl>
##  1 11-2020 11-9190         1
##  2 11-2020 41-1010         1
##  3 11-2020 41-2030         1
##  4 11-2020 41-3090         1
##  5 11-2020 41-4010         1
##  6 11-3030 11-9190         1
##  7 11-3030 13-2010         1
##  8 11-3030 43-3070         1
##  9 11-9010 45-2090         1
## 10 11-9010 53-3030         1

Hay 474 pares de nodos conectados de manera directa, como vemos a partir del head, elnodo 11-2020 está conectado de manera directa a 5 nodos, mientras que el 11-3030 solo a 3 (lo que coincide con el grado de cada uno de estos nodos)

OTROS CRITERIOS DE CENTRALIDAD

grafoParaGrafico <- grafo %>% 
         activate(nodes) %>% 
         mutate(betweeness=centrality_betweenness(),
                clusteringLocal=local_transitivity()) %>% 
         arrange(desc(betweeness))
grafoParaGrafico
## # A tbl_graph: 96 nodes and 237 edges
## #
## # An undirected simple graph with 1 component
## #
## # Node Data: 96 x 7 (active)
##   name   nodo  Desc                    grado nodeID   betweeness clusteringLocal
##   <chr>  <chr> <chr>                   <dbl> <igrph.>      <dbl>           <dbl>
## 1 11-91~ nodo  Miscellaneous Managers     32  7            1832.          0.0585
## 2 37-20~ nodo  Building Cleaning Work~    28 32            1064.          0.148 
## 3 43-60~ nodo  Secretaries and Admini~    17 52             615.          0.221 
## 4 53-30~ nodo  Driver/Sales Workers a~    24 78             615.          0.167 
## 5 51-91~ nodo  Miscellaneous Producti~    21 76             439.          0.233 
## 6 47-20~ nodo  Construction Laborers      13 61             317.          0.321 
## # ... with 90 more rows
## #
## # Edge Data: 237 x 3
##    from    to arista
##   <int> <int> <chr> 
## 1     1    46 arista
## 2    46    63 arista
## 3     7    46 arista
## # ... with 234 more rows

Lo graficamos Usamos el tamaño de los nodos para representar el betweeness, agregamos el nodeID para identificarlos (preferible a la descripción que empasta el gráfico), y los coloremos de rojo para qiue en los nodos de gran tamaño no se borre el nodeID

ggraph(grafoParaGrafico) +
  geom_edge_link(color="grey90") +
  geom_node_point(aes(size=betweeness, color="red")) +
  geom_node_text(aes(label=nodeID)) +
  theme_minimal() +
  guides(size=FALSE) +
  labs(x="",y="") +
  theme(axis.text = element_blank())
## Using `stress` as default layout
## Don't know how to automatically pick scale for object of type igraph.vs. Defaulting to continuous.

grafoParaGrafico <- grafo %>% 
         activate(nodes) %>% 
         mutate(betweness=centrality_betweenness(),
                clusteringLocal=local_transitivity()) %>% 
         arrange(desc(clusteringLocal))
grafoParaGrafico
## # A tbl_graph: 96 nodes and 237 edges
## #
## # An undirected simple graph with 1 component
## #
## # Node Data: 96 x 7 (active)
##   name   nodo  Desc                      grado nodeID  betweness clusteringLocal
##   <chr>  <chr> <chr>                     <dbl> <igrph>     <dbl>           <dbl>
## 1 11-90~ nodo  Farmers, Ranchers, and O~     2  3              0               1
## 2 15-11~ nodo  Computer and Information~     2 11              0               1
## 3 15-11~ nodo  Software Developers and ~     2 12              0               1
## 4 35-30~ nodo  Bartenders                    2 28              0               1
## 5 37-30~ nodo  Grounds Maintenance Work~     3 33              0               1
## 6 41-10~ nodo  First-Line Supervisors o~     3 36              0               1
## # ... with 90 more rows
## #
## # Edge Data: 237 x 3
##    from    to arista
##   <int> <int> <chr> 
## 1    23    60 arista
## 2     6    23 arista
## 3    23    54 arista
## # ... with 234 more rows

Lo graficamos Ahora Usamos el tamaño de los nodos para representar el clusteringLocal, tambien agregamos el nodeID para identificarlos y los coloremos de rojo. Bajamos la transparencia de las aristas para que se vean mejor las relaciones de clustering

ggraph(grafoParaGrafico) +
  geom_edge_link(color="grey50") +
  geom_node_point(aes(size=clusteringLocal), color="red") +
  geom_node_text(aes(label=nodeID)) +
  theme_minimal() +
  guides(size=FALSE) +
  labs(x="",y="") +
  theme(axis.text = element_blank())
## Using `stress` as default layout
## Don't know how to automatically pick scale for object of type igraph.vs. Defaulting to continuous.

Análisis de resultados

Los nodos que presentan mayor betweeness no coinciden con los que tenen mayores valores de clustringLocal. Ampliando el análisis, los nodos con alto betweeness tienen tambien un alto valor de grado y un relativo bajo clustering local (el máximo esperable es 1). Por otro lado los que presentan un alto clustering local, tienen 0 en el betweeness y un bajo valor de grado (2 o 3 en los primeros que aparecen en la lista)

Si observamos el grafico en base al betweeness, los nodos mas grandes son aquelos por los que pasan muchas conexiones a nodos que a su vez se conectan con otros que no necesariamente conectados entre si. Están bastante en el “centro” del gráfico y a simple vista podemos ver que forman parte de muchos caminos entre nodos que están en extremos opuestos del gráfico, es de esperar que muchos shorter paths pasen por ellos.

En cambio los que presentan alto grado de clusteringLocal son nodos con pocas conexiones, a nodos bastante conectados entre si, por lo tanto no pueden pasar muchos shorter paths, salvo la conexión con dichos nodos. Tomemos como ejemplo el nodo 3, tiene solo dos conexiones directas, al 58 y al 78 (este de hecho es uno de los de alto betweeness), no hay shorter paths que puedan pasar por el 3 salvo los que 3 tengan al 3 en un extremo, ya que si un path pasara tocando al 58 y al 3 como pasos intermedios, debería seguir por el 7, por lo tanto sería mas corto uno que se saltee al 3 y pase directamente por la conexión entre el 58 y el 7.

Por otra parte, si analizamos las ocupaciones como tales, las de alto betweeness parecen ser ocupaciones que requieren poca especialización, posiblemente ocupaciones de inicio de carreras laborales, mientras que las de alto clusteringLocal parecen ocupaciones con un nivel de expertice alto, posiblemente “de llegada”.