1 Enunciado

Seleccione todas las empresas vinculadas a los siguientes sectores económicos (deben ponerse de acuerdo para que cada uno seleccione un sector diferente):

  • AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA (trabajada por Joselina D.)

  • INDUSTRIAS MANUFACTURERAS NO METÁLICAS (trabajada por Patricio C.)

  • INDUSTRIAS MANUFACTURERAS METÁLICAS (trabajada por Daniel T.)

  • COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS (trabajada por Melanie O.)

A partir de la base de datos que haya construido, genere las siguientes dos redes unimodales:

G = {Nodos = {Empresa 1, Empresa 2, …, Empresa N}, Links = {rubro 1, rubro 2,…})

G = {Nodos = {rubro 1, rubro 2, …, rubo K}, Links = {total de empresas que conectan los rubros})

Preguntas:

  1. Haga un análisis descriptivo de cada una de las redes generadas e incluya visualizaciones.

  2. Analice si las redes generadas pudieran ser explicadas por procesos de Erdös-Renyi, Strogatz-Watts o Barabasi-Albert.

Nota, para el desarrollo voy a analizar cada red estos dos elementos; reorganizandolos de la siguiente manera:

Red de empresas:

  1. Analisis descriptivo

  2. Explicaciones de formación de red por procesos caraterísticos

Red de rubros:

  1. Analisis descriptivo

  2. Explicaciones de formación de red por procesos caraterísticos

2 Trabajo de base de datos

El primer lugar se trabaja la base de datos, para construir la edgelist a partir de la cual se generará la red. En este caso, tenemos una red bipartita de empresas y rubros, de la cual se tienen dos proyecciones unimodales; una red de rubros y una red de empresas.

Nota: Todo el manejo de datos y conformación de las matrices de adjacencia fue trabajado en conjunto con mis compañeros, en especial con Joselina Davyt-Colo.

2.1 Importar datos desde excel

library(knitr)
library(kableExtra)
library(readxl)

# Primero, aseguramos inicar en un entorno sin elementos
rm(list = ls())

# Ingresamos los datos de las empresas
datos_empresas <- readxl::read_excel("data/sociedades_anonimas_codigos.xlsx")
# nos quedamos con las columnas que de los 2 primeros rubros
datos_empresas <- datos_empresas[,1:6]

# Ingresamos los códigos de los rubros
datos_codigos <- readxl::read_excel("data/sociedades_anonimas_codigos.xlsx",2, col_names=FALSE)

La tabla de datos de empresas tiene la siguiente estructura:

knitr::kable(datos_empresas[1:6,]) %>% 
    kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
rut nombre rubro1 codigo1 rubro2 codigo2
76675290 AD RETAIL S.A. SOCIEDADES DE INVERSION Y RENTISTAS DE CAPITALES MOBILIARIOS EN GENERA 659920 EMPRESAS DE ASESORIA, CONSULTORIA FINANCIERA Y DE APOYO AL GIRO 671929
76147513 ADDWISE CORREDORES DE BOLSA DE PRODUCTOS S.A. CORREDORES DE BOLSA 671210 EMPRESAS DE ASESORIA, CONSULTORIA FINANCIERA Y DE APOYO AL GIRO 671929
98000000 ADMINISTRADORA DE FONDOS DE PENSIONES CAPITAL S.A. ADMINISTRADORAS DE FONDOS DE PENSIONES (AFP) 660200 OTRAS ACTIVIDADES EMPRESARIALES N.C.P. 749990
98000100 ADMINISTRADORA DE FONDOS DE PENSIONES HABITAT S.A. ADMINISTRADORAS DE FONDOS DE PENSIONES (AFP) 660200 NA NA
96639280 ADMINISTRADORA GENERAL DE FONDOS SECURITY S.A. SOCIEDADES DE INVERSION Y RENTISTAS DE CAPITALES MOBILIARIOS EN GENERA 659920 OTRAS ACTIVIDADES AUXILIARES DE LA INTERMEDIACION FINANCIERA N.C.P. 671990
76762250 ADMINISTRADORA DE FONDOS DE PENSIONES MODELO S.A. ADMINISTRADORAS DE FONDOS DE PENSIONES (AFP) 660200 NA NA

Mientras que la tabla de datos de códigos tiene esta otra:

knitr::kable(datos_codigos[1:6,]) %>% 
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
…1 …2 …3 …4 …5
AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA NA NA NA NA
Código CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA Afecto a IVA Categoría Disponible Internet
NA NA NA Tributaria NA
11111 CULTIVO DE TRIGO SI 1 SI
11112 CULTIVO DE MAIZ SI 1 SI
11113 CULTIVO DE AVENA SI 1 SI

2.2 Data wrangling de códigos de rubros

La tabla de códigos no está completamente ordenada en filas y columnas, sino que tiene subtítulos para los distintos sectores y subsectores. A continuación se reordena el dataframe de códigos, generando dos columnas nuevas donde esté identificado el sector y el subsector.

# generamos dos columnas donde luego se ubicarán los valores de sector y subsector
datos_codigos$a <- "a"
datos_codigos$b <- "b"

Hasta ahora el dataframe tiene la siguiente estructura:

library(knitr)
library(kableExtra)
knitr::kable(datos_codigos[1:5,])  %>% 
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
…1 …2 …3 …4 …5 a b
AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA NA NA NA NA a b
Código CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA Afecto a IVA Categoría Disponible Internet a b
NA NA NA Tributaria NA a b
11111 CULTIVO DE TRIGO SI 1 SI a b
11112 CULTIVO DE MAIZ SI 1 SI a b

En la que puede observarse que los nombres de las columnas y valore de algunas columnas no son los correctos. El sector aparece en la primera fila de la columna 1, y el subsector aparece cuando en la columna 1 se tiene el vaor “Código”. La idea es en las columnas a y b poner los valores del sector y subsector, es decir poner:

datos_codigos[1,1]
## # A tibble: 1 x 1
##   ...1                                       
##   <chr>                                      
## 1 AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA

como valor de la sexta columna “a”; y:

datos_codigos[2,2]
## # A tibble: 1 x 1
##   ...2                                                              
##   <chr>                                                             
## 1 CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA

como valor de la séptima columna “b”.

Adjudicación de los valores para el subsector

# Subsectores

# el siguiente loop dice que si el valor de la primer columna es "Código" entonces a la séptima columna se le adjudicará el valor de la misma fila de la segunda columna (la cual tiene el valor de los subsectores), en caso contrario tomará el valor de la i-1 fila. Este loop se puede hacer así porque la primer fila contiene el subsector

for(i in 2:nrow(datos_codigos)) {
  if(isTRUE(datos_codigos[i,1]== "Código")) {
    datos_codigos[i,7] <- datos_codigos[i,2]
  } else {
      datos_codigos[i,7] <- datos_codigos[i-1,7]
  } 
}

El dataframe ha tomado la siguiente forma:

library(knitr)
library(kableExtra)
knitr::kable(datos_codigos[1:5,])  %>% 
    kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
…1 …2 …3 …4 …5 a b
AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA NA NA NA NA a b
Código CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA Afecto a IVA Categoría Disponible Internet a CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
NA NA NA Tributaria NA a CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11111 CULTIVO DE TRIGO SI 1 SI a CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11112 CULTIVO DE MAIZ SI 1 SI a CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA

Ya hemos generados los valores del subsector.

Adjudicación de los valores para el sector

# Reemplazo de la fila 1 de la columna 6 por la fila 1 de la columna 1
datos_codigos[1,6] <- datos_codigos[1,1]
#colnames(datos_codigos)

# loop para colocar los valores del sector en la columna 6
# Si el valor de la columna 1 es "Código" o es na o es numérico: coloca el valor de la fila i-1 de la columna 6 en la columna 6 fila i
# En caso contrario coloca en la fila i el valor de la columna 1 fila i

for(i in 2:nrow(datos_codigos)) {
  if(isTRUE(datos_codigos[i,1]== "Código") | isTRUE(is.na(datos_codigos[i,1]))
     | !is.na(as.numeric(datos_codigos[i,1])) ) {
    datos_codigos[i,6] <- datos_codigos[i-1,6]
  } else {
      datos_codigos[i,6] <- datos_codigos[i,1]
  } 
}

Veamos ahora como ha quedado el dataframe

library(knitr)
library(kableExtra)
knitr::kable(datos_codigos[1:5,])  %>% 
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "200px")
…1 …2 …3 …4 …5 a b
AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA NA NA NA NA AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA b
Código CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA Afecto a IVA Categoría Disponible Internet AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
NA NA NA Tributaria NA AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11111 CULTIVO DE TRIGO SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11112 CULTIVO DE MAIZ SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA

Si bien tenemos el valor del sector y el subsector en las columnas 6 y 7, aún tenemos que corregir el nombre de las columnas y quitar algunas filas que no corresponden.

# quitamos la primer fila que no corresponde
datos_codigos <- datos_codigos[-1,]

# adjudicamos los nombres de las columnas con los valores de la fila 1
colnames(datos_codigos) <- datos_codigos[1,]

# Pasamos la primer columna llamada "Código" como numérica, ya que sabemos que en el caso de los valores no numéricos se va a generar un NA (además de los que ya existían)
datos_codigos$Código <- as.numeric(datos_codigos$Código)

# Quitamos los NA del dataframe
datos_codigos <-datos_codigos[!is.na(datos_codigos$Código),]

# Cambiamos los nombres de algunas columnas que siguen incorrectas
names(datos_codigos)[2] <- "cod_descripcion"
names(datos_codigos)[6] <- "sector"
names(datos_codigos)[7] <- "subsector"
#datos_codigos$Código <- as.numeric(datos_codigos$Código)

Listo tenemos ordeando el dataframe de códigos y sin NA:

library(knitr)
library(kableExtra)
knitr::kable(datos_codigos[1:6,])  %>% 
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
Código cod_descripcion Afecto a IVA Categoría  Disponible Internet sector subsector
11111 CULTIVO DE TRIGO SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11112 CULTIVO DE MAIZ SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11113 CULTIVO DE AVENA SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11114 CULTIVO DE ARROZ SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11115 CULTIVO DE CEBADA SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA
11119 CULTIVO DE OTROS CEREALES SI 1 SI AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA CULTIVOS EN GENERAL; CULTIVO DE PRODUCTOS DE MERCADO; HORTICULTURA 
colSums(is.na(datos_codigos))
##              Código     cod_descripcion        Afecto a IVA          Categoría  
##                   0                   0                   0                   0 
## Disponible Internet              sector           subsector 
##                   0                   0                   0

2.2.1 Dataframe completo

Unimos (join/merge) el dataframe de empresas con el dataframe de codigos, por el nro de código.

Tomando en consideración el rubro 1 y el rubro 2 realizamos dos join de las tablas, a fines de seleccionar el sector de AGRICULTURA vinculado al sector del rubro 1 y al sector del rubro 2.

library(knitr)
library(kableExtra)
datos <- dplyr::left_join(datos_empresas, datos_codigos, by = c("codigo1" = "Código"))
datos2 <- dplyr::left_join(datos, datos_codigos, by = c("codigo2" = "Código"))
knitr::kable(datos2[1:3,])  %>% 
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
rut nombre rubro1 codigo1 rubro2 codigo2 cod_descripcion.x Afecto a IVA.x Categoría .x Disponible Internet.x sector.x subsector.x cod_descripcion.y Afecto a IVA.y Categoría .y Disponible Internet.y sector.y subsector.y
76675290 AD RETAIL S.A. SOCIEDADES DE INVERSION Y RENTISTAS DE CAPITALES MOBILIARIOS EN GENERA 659920 EMPRESAS DE ASESORIA, CONSULTORIA FINANCIERA Y DE APOYO AL GIRO 671929 SOCIEDADES DE INVERSIÓN Y RENTISTAS DE CAPITALES MOBILIARIOS EN GENERAL NO 1 SI INTERMEDIACIÓN FINANCIERA OTROS TIPOS DE INTERMEDIACIÓN FINANCIERA EMPRESAS DE ASESORÍA, CONSULTORÍA FINANCIERA Y DE APOYO AL GIRO ND 1 SI INTERMEDIACIÓN FINANCIERA ACT. AUX. DE LA INTERMEDIACIÓN FINANCIERA, EXCEPTO PLANES DE SEGUROS
76147513 ADDWISE CORREDORES DE BOLSA DE PRODUCTOS S.A. CORREDORES DE BOLSA 671210 EMPRESAS DE ASESORIA, CONSULTORIA FINANCIERA Y DE APOYO AL GIRO 671929 CORREDORES DE BOLSA SI 1 SI INTERMEDIACIÓN FINANCIERA ACT. AUX. DE LA INTERMEDIACIÓN FINANCIERA, EXCEPTO PLANES DE SEGUROS EMPRESAS DE ASESORÍA, CONSULTORÍA FINANCIERA Y DE APOYO AL GIRO ND 1 SI INTERMEDIACIÓN FINANCIERA ACT. AUX. DE LA INTERMEDIACIÓN FINANCIERA, EXCEPTO PLANES DE SEGUROS
98000000 ADMINISTRADORA DE FONDOS DE PENSIONES CAPITAL S.A. ADMINISTRADORAS DE FONDOS DE PENSIONES (AFP) 660200 OTRAS ACTIVIDADES EMPRESARIALES N.C.P. 749990 ADMINISTRADORAS DE FONDOS DE PENSIONES (AFP) SI 1 NO INTERMEDIACIÓN FINANCIERA FINANCIACIÓN PLANES DE SEG. Y DE PENSIONES, EXCEPTO AFILIACIÓN OBLIG. OTRAS ACTIVIDADES EMPRESARIALES N.C.P. SI 1 SI ACTIVIDADES INMOBILIARIAS, EMPRESARIALES Y DE ALQUILER ACT. EMPRESARIALES Y DE PROFESIONALES PRESTADAS A EMPRESAS N.C.P.

2.3 Elaboración Red de empresas

Los sectores que hay en los datos son:

# Sector rubro 1
unique(datos2$sector.x)
##  [1] "INTERMEDIACIÓN FINANCIERA"                                             
##  [2] "SUMINISTRO DE ELECTRICIDAD, GAS Y AGUA"                                
##  [3] "COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS"
##  [4] "EXPLOTACIÓN DE MINAS Y CANTERAS"                                       
##  [5] "ACTIVIDADES INMOBILIARIAS, EMPRESARIALES Y DE ALQUILER"                
##  [6] "OTRAS ACTIVIDADES DE SERVICIOS COMUNITARIAS, SOCIALES Y PERSONALES"    
##  [7] "INDUSTRIAS MANUFACTURERAS NO METÁLICAS"                                
##  [8] NA                                                                      
##  [9] "CONSTRUCCIÓN"                                                          
## [10] "PESCA"                                                                 
## [11] "ADM. PUBLICA Y DEFENSA; PLANES DE SEG. SOCIAL AFILIACIÓN OBLIGATORIA"  
## [12] "TRANSPORTE, ALMACENAMIENTO Y COMUNICACIONES"                           
## [13] "AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA"                           
## [14] "INDUSTRIAS MANUFACTURERAS METÁLICAS"                                   
## [15] "HOTELES Y RESTAURANTES"                                                
## [16] "ENSEÑANZA"                                                             
## [17] "SERVICIOS SOCIALES Y DE SALUD"
# Sector rubro 2
unique(datos2$sector.y)
##  [1] "INTERMEDIACIÓN FINANCIERA"                                             
##  [2] "ACTIVIDADES INMOBILIARIAS, EMPRESARIALES Y DE ALQUILER"                
##  [3] NA                                                                      
##  [4] "SUMINISTRO DE ELECTRICIDAD, GAS Y AGUA"                                
##  [5] "TRANSPORTE, ALMACENAMIENTO Y COMUNICACIONES"                           
##  [6] "INDUSTRIAS MANUFACTURERAS NO METÁLICAS"                                
##  [7] "OTRAS ACTIVIDADES DE SERVICIOS COMUNITARIAS, SOCIALES Y PERSONALES"    
##  [8] "ADM. PUBLICA Y DEFENSA; PLANES DE SEG. SOCIAL AFILIACIÓN OBLIGATORIA"  
##  [9] "CONSTRUCCIÓN"                                                          
## [10] "COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS"
## [11] "SERVICIOS SOCIALES Y DE SALUD"                                         
## [12] "PESCA"                                                                 
## [13] "INDUSTRIAS MANUFACTURERAS METÁLICAS"                                   
## [14] "AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA"                           
## [15] "EXPLOTACIÓN DE MINAS Y CANTERAS"                                       
## [16] "HOTELES Y RESTAURANTES"

Nos quedamos con “COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS” para los rubros 1 y 2.

comercio <- subset(datos2, datos2$sector.x == "COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS" 
                      | datos2$sector.y == "COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS")
comercio<- comercio[!is.na(comercio$rut),]

Cantidad de empresas:

# Sector rubro 1
table(comercio$sector.x)
## 
##                            AGRICULTURA, GANADERÍA, CAZA Y SILVICULTURA 
##                                                                      1 
## COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS 
##                                                                     24 
##                                                           CONSTRUCCIÓN 
##                                                                      2 
##                                        EXPLOTACIÓN DE MINAS Y CANTERAS 
##                                                                      1 
##                                    INDUSTRIAS MANUFACTURERAS METÁLICAS 
##                                                                      5 
##                                 INDUSTRIAS MANUFACTURERAS NO METÁLICAS 
##                                                                      8 
##                                 SUMINISTRO DE ELECTRICIDAD, GAS Y AGUA 
##                                                                      4
# Sector rubro 2
table(comercio$sector.y)
## 
##                 ACTIVIDADES INMOBILIARIAS, EMPRESARIALES Y DE ALQUILER 
##                                                                      2 
## COMERCIO AL POR MAYOR Y MENOR; REP. VEH.AUTOMOTORES/ENSERES DOMÉSTICOS 
##                                                                     25 
##                                                 HOTELES Y RESTAURANTES 
##                                                                      1 
##                                              INTERMEDIACIÓN FINANCIERA 
##                                                                      8 
##     OTRAS ACTIVIDADES DE SERVICIOS COMUNITARIAS, SOCIALES Y PERSONALES 
##                                                                      2 
##                            TRANSPORTE, ALMACENAMIENTO Y COMUNICACIONES 
##                                                                      7

Los nodos de nuestra red serán las siguientes empresas:

library(tidyverse)
library(dplyr)
library(tibble)

nodos_com <- data.frame(nombre =unique(comercio$nombre))
nodos_com <- nodos_com %>% tibble::rowid_to_column("id")
nodos_com$id <- paste0("E", nodos_com$id)
combinaciones_com <- expand.grid(nodos_com[,1], nodos_com[,1])
knitr::kable(nodos_com, booktabs = TRUE) %>%
    kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
id nombre
E1 AGENCIAS UNIVERSALES S.A.
E2 AGROSUPER S.A.
E3 AZUL AZUL S.A.
E4 BLANCO Y NEGRO S.A.
E5 CENCOSUD S.A.
E6 CHILECTRA S.A.
E7 CLUB HIPICO DE PUNTA ARENAS S.A.
E8 COAGRA S.A.
E9 COCA COLA EMBONOR S.A.
E10 COMPAÑIA AGROPECUARIA COPEVAL S.A.
E11 COMPAÑIA SUD AMERICANA DE VAPORES S.A.
E12 CRUZADOS S.A.D.P.
E13 CTI S.A.
E14 DETROIT CHILE S.A.
E15 EMBOTELLADORA ANDINA S.A.
E16 EMPRESA DE TRANSPORTE DE PASAJEROS METRO S.A.
E17 EMPRESA NACIONAL DEL PETROLEO
E18 EMPRESAS CABO DE HORNOS S.A.
E19 EMPRESAS COPEC S.A.
E20 EMPRESAS LA POLAR S.A.
E21 EMPRESAS LIPIGAS S.A.
E22 EMPRESAS TATTERSALL S.A.
E23 ENERSIS S.A.
E24 ENVASES DEL PACIFICO S.A.
E25 FORUS S.A.
E26 GASCO S.A.
E27 GMAC COMERCIAL AUTOMOTRIZ CHILE S.A.
E28 METROGAS S.A.
E29 MOLIBDENOS Y METALES S. A.
E30 MULTIEXPORT FOODS S.A.
E31 OXIQUIM S.A.
E32 PROMOTORA CMR FALABELLA S.A.
E33 S. A. FERIA DE LOS AGRICULTORES
E34 SOCIEDAD ANONIMA VIÑA SANTA RITA
E35 SOCIEDAD CONCESIONARIA RUTAS DEL PACIFICO S.A.
E36 SOCIEDAD DE ARTESANOS SANTA LUCIA S.A.
E37 SOCIEDAD EDUCATIVA LEONARDO DA VINCI S.A.
E38 SOPROLE INVERSIONES S.A.
E39 TELEFONICA CHILE S.A.
E40 TELEFONICA LARGA DISTANCIA S.A.
E41 TERMAS DE PUYEHUE S.A.
E42 VALPARAISO SPORTING CLUB S.A.
E43 VIÑA SAN PEDRO TARAPACA S.A.
E44 WALMART CHILE S.A.
E45 WATTS S.A.

Vamos a tomar en consideración el rubro 1 y el rubro 2 para crear la red de empresas donde los links son los rubros.

G1 = {Nodos = {Empresa 1, Empresa 2, …, Empresa N}, Links = {rubro 1, rubro 2,…})

library(tidyverse)
df <- comercio[,c(2,4,6)]
df <- left_join(df, nodos_com, by ="nombre")
df <- df[,c(4,2,3)]

df2 <- df %>% 
  full_join(df, by="codigo1") %>% 
  group_by(id.x,id.y) %>%
  select(codigo1, id.x, id.y) %>%
  full_join(df, by=c("codigo1" ="codigo2")) %>%
  group_by(id.x, id.y, id) 

df3 <- df2[,c(1,2,3)] %>%
  rename(id = id.y)

df4 <- df2[!duplicated(df2[,c(1,2,4)]),c(1,2,4)] %>%
  filter(!is.na(id)) %>%
  filter(!is.na(id.x)) %>%
  bind_rows(df3) %>% 
  group_by(id.x,id) %>%
  summarise(link = length(unique(codigo1))) %>%
  filter(id.x != id) %>%
  filter(!is.na(id))

Pares de empresas vinculadas por rubro 1 o rubro2:

knitr::kable(df4)%>%
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
id.x id link
E1 E21 1
E10 E20 1
E12 E3 1
E12 E4 1
E15 E9 1
E16 E32 1
E16 E37 1
E19 E17 1
E19 E23 1
E19 E24 1
E19 E34 1
E19 E35 1
E19 E38 1
E19 E39 1
E19 E40 1
E19 E43 1
E19 E44 1
E19 E7 1
E20 E10 1
E21 E26 1
E21 E28 1
E22 E33 1
E23 E17 1
E23 E19 1
E23 E24 1
E23 E34 1
E23 E35 1
E23 E38 1
E23 E39 1
E23 E40 1
E23 E43 1
E23 E44 1
E23 E7 1
E26 E21 1
E26 E28 1
E28 E21 1
E28 E26 1
E3 E12 1
E3 E4 1
E32 E16 1
E32 E37 1
E33 E22 1
E34 E43 1
E37 E16 1
E37 E32 1
E38 E17 1
E38 E19 1
E38 E23 1
E38 E24 1
E38 E34 1
E38 E35 1
E38 E39 1
E38 E40 1
E38 E43 1
E38 E44 1
E38 E7 1
E39 E17 1
E39 E19 1
E39 E23 1
E39 E24 1
E39 E34 1
E39 E35 1
E39 E38 1
E39 E40 1
E39 E43 1
E39 E44 1
E39 E7 1
E4 E12 1
E4 E3 1
E40 E17 1
E40 E19 1
E40 E23 1
E40 E24 1
E40 E34 1
E40 E35 1
E40 E38 1
E40 E39 1
E40 E43 1
E40 E44 1
E40 E7 1
E43 E34 1
E9 E15 1

2.3.1 Matriz de adyacencia de empresas

Usando la información anterior, se construye la matriz de adyacencia de las empresas, con la cual se trabajará el análisis.

list_com <- merge(combinaciones_com, df4, by.x = c("Var1", "Var2"), by.y = c("id.x", "id"), all.x = TRUE)
list_com$link <- ifelse(is.na(list_com$link), 0, list_com$link)
comercio_adj <- tidyr::spread(list_com, "Var2", "link")
row.names(comercio_adj) <- comercio_adj[,1]
comercio_adj <- comercio_adj[,-1]

2.4 Elaboración de red de rubros

Siguiendo la definición de la red proyectada , para el sector de comercio:

G2 = {Nodos = {rubro 1, rubro 2,…}, Links = {Total empresas que conectan dos rubros})

Los nodos son los siguientes:

nodos_com_rubro <- data.frame(rubro = unique(as.vector(rbind(comercio$rubro1, comercio$rubro2))))

nodos_com_rubro <- nodos_com_rubro %>% 
  rowid_to_column("id") %>%
  mutate(id = paste0("R",id))

combinaciones_com_rubro <- expand.grid(nodos_com_rubro[,1], nodos_com_rubro[,1])
knitr::kable(nodos_com_rubro) %>%
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
id rubro
R1 VENTA AL POR MAYOR DE COMBUSTIBLES LIQUIDOS
R2 MANIPULACION DE LA CARGA
R3 VENTA AL POR MAYOR DE MAQUINAS Y EQUIPOS DE OFICINA; INCLUYE MATERIALE
R4 SOCIEDADES DE INVERSION Y RENTISTAS DE CAPITALES MOBILIARIOS EN GENERA
R5 VENTA AL POR MENOR DE PRENDAS DE VESTIR EN GENERAL, INCLUYE ACCESORIOS
R6 ACTIVIDADES DE CLUBES DE DEPORTES Y ESTADIOS
R7 ESTACIONAMIENTO DE VEHICULOS Y PARQUIMETROS
R8 GRANDES ESTABLECIMIENTOS (VENTA DE ALIMENTOS); HIPERMERCADOS
R9 DISTRIBUCION DE ENERGIA ELECTRICA
R10 VENTA AL POR MENOR DE ARTICULOS ELECTRODOMESTICOS Y ELECTRONICOS PARA
R11 CONSTRUCCION DE EDIFICIOS COMPLETOS O DE PARTES DE EDIFICIOS
R12 VENTA AL POR MAYOR DE OTROS PRODUCTOS N.C.P.
R13 FABRICACION DE MAQUINARIA AGROPECUARIA Y FORESTAL
R14 VENTA AL POR MENOR DE COMBUSTIBLE PARA AUTOMOTORES
R15 ELABORACION DE BEBIDAS NO ALCOHOLICAS
R16 MAYORISTAS DE VINOS Y BEBIDAS ALCOHOLICAS Y DE FANTASIA
R17 VENTA O COMPRAVENTA AL POR MENOR DE VEHICULOS AUTOMOTORES NUEVOS O USA
R18 VENTA DE MOTOCICLETAS
R19 COMERCIO AL POR MENOR DE ARTICULOS Y ARTEFACTOS USADOS N.C.P.
R20 TRANSPORTE MARITIMO Y DE CABOTAJE DE PASAJEROS
R21 EXPLOTACION DE INSTALACIONES ESPECIALIZADAS PARA LAS PRACTICAS DEPORTI
R22 FABRICACION DE OTROS PRODUCTOS ELABORADOS DE METAL N.C.P.
R23 CONSTRUCCION Y REPARACION DE BUQUES; ASTILLEROS
R24 VENTA AL POR MAYOR DE MAQUINARIA, HERRAMIENTAS, EQUIPO Y MATERIALES N.
R25 VENTA AL POR MENOR DE OTROS PRODUCTOS EN PEQUENOS ALMACENES NO ESPECIA
R26 TRANSPORTE URBANO DE PASAJEROS VIA FERROCARRIL (INCLUYE METRO)
R27 EXTRACCION DE PETROLEO CRUDO Y GAS NATURAL
R28 CULTIVO DE UVA DE MESA
R29 VENTA AL POR MAYOR DE MATERIAS PRIMAS AGRICOLAS
R30 FABRICACION DE GAS; DISTRIBUCION DE COMBUSTIBLES GASEOSOS POR TUBERIAS
R31 CORRETAJE DE GANADO (FERIAS DE GANADO)
R32 SERVICIOS DE ALMACENAMIENTO Y DEPOSITO
R33 FABRICACION DE PAPEL Y CARTON ONDULADO Y DE ENVASES DE PAPEL Y CARTON
R34 FABRICACION DE CALZADO
R35 VENTA AL POR MAYOR DE PRODUCTOS TEXTILES, PRENDAS DE VESTIR Y CALZADO
R36 VENTA AL POR MENOR DE APARATOS, ARTICULOS, EQUIPO DE USO DOMESTICO N.C
R37 VENTA AL POR MAYOR DE VEHICULOS AUTOMOTORES (IMPORTACION, DISTRIBUCION
R38 OTROS TIPOS DE INTERMEDIACION MONETARIA N.C.P.
R39 VENTA AL POR MENOR DE CARBON, LENA Y OTROS COMBUSTIBLES DE USO DOMESTI
R40 FABRICACION DE PRODUCTOS PRIMARIOS DE METALES PRECIOSOS Y DE OTROS MET
R41 MAYORISTAS DE PRODUCTOS DEL MAR (PESCADO, MARISCOS, ALGAS)
R42 FABRICACION DE SUSTANCIAS QUIMICAS BASICAS, EXCEPTO ABONOS Y COMPUESTO
R43 OTRAS ACTIVIDADES AUXILIARES DE LA INTERMEDIACION FINANCIERA N.C.P.
R44 OTROS TIPOS DE CORRETAJES O REMATES N.C.P. (NO INCLUYE SERVICIOS DE MA
R45 ELABORACION DE VINOS
R46 OBRAS DE INGENIERIA
R47 COMERCIO AL POR MENOR DE ARTICULOS TIPICOS (ARTESANIAS)
R48 ARRIENDO DE INMUEBLES AMOBLADOS O CON EQUIPOS Y MAQUINARIAS
R49 COMPRA, VENTA Y ALQUILER (EXCEPTO AMOBLADOS) DE INMUEBLES PROPIOS O AR
R50 OTROS SERVICIOS DE TELECOMUNICACIONES N.C.P.
R51 COMERCIO AL POR MENOR DE LIBROS
R52 HOTELES
R53 VENTA AL POR MENOR DE PRODUCTOS DE CONFITERIAS, CIGARRILLOS, Y OTROS
R54 COMERCIO DE ARTICULOS DE SUMINISTROS DE OFICINAS Y ARTICULOS DE ESCRIT
R55 FABRICACION Y/O REPARACION DE LENTES Y ARTICULOS OFTALMOLOGICOS
R56 ELABORACION DE OTROS PRODUCTOS ALIMENTICIOS NO CLASIFICADOS EN OTRA PA

A continuación se crea la edge list:

df_rubros <- comercio[,c(1,3,5)] %>%
  left_join(nodos_com_rubro, by =c("rubro1" = "rubro")) %>%
  rename(id1 = id) %>%
  left_join(nodos_com_rubro, by =c("rubro2" = "rubro")) %>%
  rename(id2 = id)

df2_rubros <- df_rubros %>% 
  select(rut, id1, id2) %>%
  full_join(df_rubros, by="rut") %>% 
  group_by(id1.x,id2.x) %>% 
  summarise(link = length(unique(rut))) %>% 
  filter(id1.x!=id2.x) %>%
  ungroup()

La lista de rubros vinculados a través de empresas es la siguiente:

knitr::kable(df2_rubros)%>%
  kable_styling(latex_options="scale_down", font_size = 11)%>%
  scroll_box(width = "100%", height = "300px")
id1.x id2.x link
R1 R2 1
R11 R12 1
R12 R32 1
R12 R4 2
R12 R50 2
R13 R14 1
R15 R16 2
R17 R18 2
R19 R20 1
R22 R10 1
R23 R24 1
R25 R26 1
R25 R43 1
R25 R49 1
R27 R12 1
R28 R29 1
R3 R4 1
R30 R1 1
R30 R36 1
R30 R39 1
R31 R4 1
R31 R44 1
R33 R12 1
R34 R35 1
R37 R38 1
R40 R24 1
R41 R4 1
R42 R24 1
R45 R12 2
R46 R12 1
R47 R48 1
R5 R21 1
R5 R6 1
R5 R7 1
R51 R52 1
R53 R54 1
R55 R12 1
R56 R16 1
R8 R4 1
R9 R10 1

2.4.1 Matriz de adyacencia rubros:

list_com_rubro <- merge(combinaciones_com_rubro, df2_rubros, by.x = c("Var1", "Var2"), by.y = c("id1.x", "id2.x"), all.x = TRUE)
list_com_rubro$link <- ifelse(is.na(list_com_rubro$link), 0, list_com_rubro$link)
comercio_adj_rubro <- tidyr::spread(list_com_rubro, "Var2", "link")
row.names(comercio_adj_rubro) <- comercio_adj_rubro[,1]
comercio_adj_rubro <- comercio_adj_rubro[,-1]

3 Análisis de Red de empresas

Definiremos la red de empresas en el sector de Comercio como la proyeccion de la red bivariada de empresas y rubros, en la cual los nodos estan compuestos por empresas y los vínculos por los rubros en los cuales operan.

G = {Nodos = {Empresa 1, Empresa 2, …, Empresa N}, Links = {rubro 1, rubro 2,…})

3.1 Análisis descriptivo

Partiendo de la matriz de adjacencia elaborada, construimos el grafo correspondiente y como primera aproximacón lo graficamos. Esta corresponde a una red no direccionada con pesos, ya que dos empresas pueden estar vinculadas por más de un rubro.

library(igraph)

# Elaboración red empresa  

red_ecom <- igraph::graph.adjacency(as.matrix(comercio_adj))
plot(red_ecom, edge.arrow.size=.001,vertex.label.cex=0.5, vertex.size=15)

3.1.1 Conectividad y densidad

Es apreciable (del grafo) que hay un grupo de empresas que conforman un componente gigante, y varios clusters de menor tamaño, triadas, diadas e islas. Por lo cual es una red dispersa.

Esto es más evidente al estudiar la densidad de la red , que indica cual es la proporción de los edges (o vínculos/links) presentes del total posible de vínculos en esta red.

edge_density(red_ecom, loops=F)
## [1] 0.04141414

Es decir, solo un 4.1% de los posibles links, se observan empíricamente. Dada la baja densidad de la red, se extraerá el componente gigante y se trabajará con este a partir de ahora. Probablemente ocurre dada la diversidad de rubros que existe en este sector industruil.

componentes_ecom <- clusters(red_ecom)
componentes_ecom
## $membership
##  E1  E2  E3  E4  E5  E6  E7  E8  E9 E10 E11 E12 E13 E14 E15 E16 E17 E18 E19 E20 
##   1   2   3   3   4   5   6   7   8   9  10   3  11  12   8  13   6  14   6   9 
## E21 E22 E23 E24 E25 E26 E27 E28 E29 E30 E31 E32 E33 E34 E35 E36 E37 E38 E39 E40 
##   1  15   6   6  16   1  17   1  18  19  20  13  15   6   6  21  13   6   6   6 
## E41 E42 E43 E44 E45 
##  22  23   6   6  24 
## 
## $csize
##  [1]  4  1  3  1  1 12  1  2  2  1  1  1  3  1  2  1  1  1  1  1  1  1  1  1
## 
## $no
## [1] 24
g_ecom <- which.max(componentes_ecom$csize) # identificamos el gigante
redg_ecom <- induced.subgraph(red_ecom, which(componentes_ecom$membership == g_ecom)) # nos quedamos con el componente gigante

V(red_ecom)
## + 45/45 vertices, named, from fb96172:
##  [1] E1  E2  E3  E4  E5  E6  E7  E8  E9  E10 E11 E12 E13 E14 E15 E16 E17 E18 E19
## [20] E20 E21 E22 E23 E24 E25 E26 E27 E28 E29 E30 E31 E32 E33 E34 E35 E36 E37 E38
## [39] E39 E40 E41 E42 E43 E44 E45
V(redg_ecom)
## + 12/12 vertices, named, from 94fc44c:
##  [1] E7  E17 E19 E23 E24 E34 E35 E38 E39 E40 E43 E44

En este caso, el componente gigante contempla a 12 empresas del total de 45. Así, representamos gráfimacente al componente gigante:

plot(redg_ecom, edge.arrow.size=.001,vertex.label.cex=0.6, vertex.size=25)

Si ahora revisamos la densidad del componente gigante, claramente es mucho mayor que al considerar la red completa. En este caso, el componente tiene una densidad de aproximadamente 43%, es decir, un 43% del total de links posibles son observados en la red.

edge_density(redg_ecom, loops=F)
## [1] 0.4318182

3.1.2 Diametro y distancia media

El diametro es una primera aproximación al tamaño de la red y a su conectividad. Este corresponde la mayor distancia geodésica de la red.

diameter(redg_ecom, directed=F, unconnected=FALSE)
## [1] 2
diam <- get_diameter(redg_ecom, directed=F)
diam
## + 3/12 vertices, named, from 94fc44c:
## [1] E7  E19 E17

Es apreciable que el diametro de la red es de 2 y contempla a 3 vértices, a la empresa 7, 19 y 17. No es de extrañar que el diametro sea tan bajo, ya que la red tiene una alta densidad.

La distancia media, corresponde al promedio de la geodésica entre todos los pares de nodos de la red. En este caso corresponde a 1.3, es decir que la mayoría de los nodos estan a poco más de 1 geodésica de distancia. Resultado en concordancia con los anteriores.

igraph::average.path.length(redg_ecom, directed=F, unconnected = F)
## [1] 1.30303

3.1.3 Análisis de Centralidad

Centralidad analiza la “importancia” de os nodos en la red, se puede medir de varias maneras si teine muchas conexiones (grado/degree), es de fácil acceso (closesness) está bien conectado, es popular (eigenvalue) o está en el camino de varias geodésicas (betweeness). En esta sección revisaremos cada una de esas perspectivas y concluiremos con una tabla resumen.

3.1.3.1 Centralidad de grado (Degree)

Primer elemento describir es el grado de cada nodo y la distribución de estos. El grado del vértice i \((k_i)\) corresponde al número de nodos con los cuales mantiene un vínculo, es decir: \[k_i=\sum_{j \in N}l_i \] La lógica de la centralidad de grado es que se consiedaraá un nodo central en la red, en la medida de que tiene más vínculos.

centralidad_grado <- igraph::degree(redg_ecom)
centralidad_grado
##  E7 E17 E19 E23 E24 E34 E35 E38 E39 E40 E43 E44 
##   5   5  15  15   5   7   5  15  15  15   7   5

Es apreciable que todas las empresas (en este componente) están vinculadas con al menos 5 y con un máximo de 15 grados. ¿Como es posible qie sea 15 si son 12 empresas? Cabe recordar que los vínculos son con pesos, así que 2 empresas pueden estar vinculadas más de una vez si comparten más de un rubro en común.

Usando la información obtenida en el punto anterior, se genera el gráfico de distribución de grado a través de un histograma. En este caso, es histograma solo tiene 3 puntos de masa, en 5, 7 y 15.

deg <- degree(redg_ecom, mode="all")

plot(redg_ecom, edge.arrow.size=.001,vertex.label.cex=0.6, vertex.size=deg*2)

En el grafico podemos apreciar los nodos escalados en relación a su centralidad de grado.

hist(deg, breaks=1:16, main="Histograma de grado, Red empresas de comercio", col="light blue", xlab="Grado nodo", ylab="Freecuencia", xlim=c(0,16))

Como el histograma tiene solo estos 3 puntos de masa,la distribución acumulada es más explicativa.

deg.dist <- degree_distribution(redg_ecom, cumulative=T, mode="all")

plot( x=0:max(deg), y=1-deg.dist, pch=19, cex=1.2, col="light blue", 

      xlab="Grado del nodo", ylab="Frecuencia Acumulada", main="Distribución acumulada de grado, Red empresas de comercio")

3.1.3.2 Centralidad de cercanía (closeness)

La centralidad de cercanía, en relación a la distancia a otras en el grafo. Se refiere a la inversa de la distancia geodésica a otros nodos en la red.

centralidad_cercania <- closeness(redg_ecom,normalized=T)
## Warning in closeness(redg_ecom, normalized = T): At centrality.c:2784 :closeness
## centrality is not well-defined for disconnected graphs
centralidad_cercania
##         E7        E17        E19        E23        E24        E34        E35 
## 0.08333333 0.08333333 1.00000000 1.00000000 0.08333333 0.09090909 0.08333333 
##        E38        E39        E40        E43        E44 
## 1.00000000 1.00000000 1.00000000 0.09090909 0.08333333

En este caso, tenemos algunos nodos que tienen alta centralidad de cercanía: E34, E35, E7, E17 y E19.

3.1.3.3 Centralidad de Valor propio (Eigenvalue)

Esta centralidad se refiere a la ponderación de la centralidad de los nodos que les rodean. Será más central, en la medida de que está conectado a otros nodos centrales.

# centralidad eigenvalue
centralidad_eigen <- eigen_centrality(redg_ecom)
centralidad_eigen$vector
##        E7       E17       E19       E23       E24       E34       E35       E38 
## 0.4428466 0.4428466 1.0000000 1.0000000 0.4428466 0.5381789 0.4428466 1.0000000 
##       E39       E40       E43       E44 
## 1.0000000 1.0000000 0.5381789 0.4428466

En este caso, tenemos algunos nodos que tienen alta centralidad de cercanía: E38, E39, E40 y E19.

3.1.3.4 Centralidad de Intermediación (Betweenness)

Es una medida de centralidad basada en la psoición de Broker o intermediador. Se identifica por el número de geodésicas que pasan por el nodo o vértice. En este caso, ningun nodo tiene un rol especial de intermediación (Un resultado algo extraño, tal vez consecuencia de el bajo diametro y alta densidad de la red).

centralidad_intermediacion <- betweenness(redg_ecom, normalized = T)
centralidad_intermediacion
##  E7 E17 E19 E23 E24 E34 E35 E38 E39 E40 E43 E44 
##   0   0   0   0   0   0   0   0   0   0   0   0

3.1.3.5 Cuadro resumen de centralidades

De los cálculos anteriores, se elabora la siguiente tabla resumen:

centralidades <- cbind(centralidad_grado,
                       centralidad_cercania,
                       centralidad_eigen$vector,
                       centralidad_intermediacion) 
colnames(centralidades) <- c("grado", "cercania", "eigen", "intermediacion")
centralidades
##     grado   cercania     eigen intermediacion
## E7      5 0.08333333 0.4428466              0
## E17     5 0.08333333 0.4428466              0
## E19    15 1.00000000 1.0000000              0
## E23    15 1.00000000 1.0000000              0
## E24     5 0.08333333 0.4428466              0
## E34     7 0.09090909 0.5381789              0
## E35     5 0.08333333 0.4428466              0
## E38    15 1.00000000 1.0000000              0
## E39    15 1.00000000 1.0000000              0
## E40    15 1.00000000 1.0000000              0
## E43     7 0.09090909 0.5381789              0
## E44     5 0.08333333 0.4428466              0

Observamos hay ciertos nodos con alta centralidad: 19, 23, 38, 39 y 40, que es consistente entre centralidad de grado, cercanía y valor propio.

3.1.4 Triadas y transitividad

Podemos revisar de tipo de relacion existe entre todas las posibles triadas del grafo, usando la clasificación https://igraph.org/r/doc/triad_census.html. Cabe destacr que este análisis es valido para grafos direccionados. En nuestri caso, el grafo es no direccionado pero igualmente el censo puede ser informativo, agrupando los resultados.

igraph::triad_census(redg_ecom)
##  [1]  30   0   5 100   0   0   0   0   0   0   0   5  70   0   0  10

Es apreciable que hay 30 triadas en las cuales no hay relación, 5 en los cuales el grafo tiene una conección mutua entre dos vertices, sin incluir un tercero y 185 que la triada está completa.

motifs(redg_ecom, 3)
##  [1]  NA  NA   0  NA   0   0 100   0   5   0   0   0   0  70   0  10
count_motifs(redg_ecom,3)
## [1] 185

Finalmente, podemos revisar el ratio de transitividad. La transitividad global se refiere al ratio de triangulos de triadas. En este caso, corresponde a 72% y podemos ver a nivel local la distrubución.

transitivity(redg_ecom, type="global")
## [1] 0.7183099
transitivity(redg_ecom, type="local")
##  [1] 1.0000000 1.0000000 0.3333333 0.3333333 1.0000000 0.7142857 1.0000000
##  [8] 0.3333333 0.3333333 0.3333333 0.7142857 1.0000000

3.1.5 Centralización

Es posible observar que tan cohesionada está la red en función de sus características globales, en est caso son medidas de centralidad global de la red. En este caso, considera la centralidad del nodo más central con la centralidad de cada uno de los otros, sumando sus diferencias y se normaliza por el resultado teorico de la red estrella, la con mayor centralidad posible.

data.frame(centr_degree = centr_degree(redg_ecom)$centralization, cent_clo = centr_clo(redg_ecom)$centralization, centr_eigen = centr_eigen(redg_ecom)$centralization, centr_betw = centr_betw(redg_ecom)$centralization)
##   centr_degree cent_clo centr_eigen centr_betw
## 1    0.2727273 0.634861   0.3709409          0

Observamos que la centralidad de closeness es la mayor, que tiene sentido ya que los nodos están muy densamente conectados.

3.2 Análisis de formación red empresas.

En esta seccón, se revisará si las red de empresa observada es similar a alguna formada aleatoriamente por alguno de los siguientes procesos de fromación de redes: Erdös-Renyi, Strogatz-Watts o Barabasi-Albert, cosa que pueda ser explicada su formación por alguno de estos procesos.

3.2.1 Medidas de comparación

Preparamos las medidas de comparación relevantes de la red original, seguiremos trabajando con el componente gigante solamente (por consistencia).

# dibujamos la red original 

red.e.degree <- degree(redg_ecom)

plot(redg_ecom, 
     main="Red real empresas (comp gigante)", 
     vertex.color="light blue",
     vertex.label=NA,
     edge.color="grey",
     edge.width=E(redg_ecom)$weight/10,
     edge.arrow.size=0.1,
     vertex.size=red.e.degree/2, # veamos los nodos según centralidad de grado
     vertex.frame.color="blue"
     )

#Agregamos los elementos para la tabla de comparación

red.e.distancia <- round(mean_distance(redg_ecom),3)
red.e.distancia
## [1] 1
red.e.clustering <- round(transitivity(redg_ecom, type="global"),3)
red.e.clustering
## [1] 0.718

3.2.2 Redes empresa simuladas

En esta sección, simulamos la red usando los 3 procesos: Erdös-Renyi, Strogatz-Watts o Barabasi-Albert, para cada una lo graficaremos y extraeremos medidas de distancia promedio y clustering, para compara con la red observada.

3.2.2.1 Red empresas Erdös-Renyi

Obtenemos primero una red generada con un proceso aleatorio de Erdos-Renyi, con atributos similares a nuestra red.

# erdos.renyi.game(n, p.or.m, type = c("gnp", "gnm"), directed = FALSE, loops = FALSE, ...)
# n: The number of vertices in the graph.
# p.or.m: Either the probability for drawing an edge between two arbitrary vertices (G(n,p) graph), or the number of edges in the graph (for G(n,m) graphs).
# type: The type of the random graph to create, either gnp (G(n,p) graph) or gnm (G(n,m) graph).
# directed: Logical, whether the graph will be directed, defaults to FALSE.
# loops: Logical, whether to add loop edges, defaults to FALSE.

size <- length(V(redg_ecom))
dens <- graph.density(redg_ecom) # probabilidad de un link
er <- erdos.renyi.game(size, dens) # gnp
er.grado <- degree(er)

plot(er, 
     main="Red Simulada - Erdos-Renyi", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(er, circular=T),
     edge.color="grey",
     edge.width=E(er)$weight/10,
     edge.arrow.size=0.1,
     vertex.size=er.grado/2, 
     vertex.frame.color="blue", 
     vertex.label=NA)

er.distancia <- round(mean_distance(er),3)
er.clustering <- round(transitivity(er, type="global"),3)

3.2.2.2 Red empresas de Strogatz-Watts

En segundo lugar, obtenemos la red generada por un porceso de Mundos Pequeños, de Strogatz-Watts que simula atributos de la red de comercio.

# sample_smallworld(dim, size, nei, p, loops = FALSE, multiple = FALSE)
# dim: Integer constant, the dimension of the starting lattice.
# size: Integer constant, the size of the lattice along each dimension.
# nei: Integer constant, the neighborhood within which the vertices of the lattice will be connected.
# p: Real constant between zero and one, the rewiring probability.
# loops: Logical scalar, whether loops edges are allowed in the generated graph.
# multiple: Logical scalar, whether multiple edges are allowed int the generated graph.

sm <- watts.strogatz.game(1,size,3,0.1) # estoy asumiendo vecindarios de 3 nodos y rewiring de 0.1 (se puede mejorar la precisión)
sm.grado <- degree(sm)
plot(sm, 
     main="Red Simulada - Strogatz-Watts", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(sm, circular=T),
     edge.color="grey",
     edge.width=E(sm)$weight/10,
     edge.arrow.size=0.1,
     vertex.size=sm.grado/2, 
     vertex.frame.color="blue", 
     vertex.label=NA)

sm.distancia <- round(mean_distance(sm),3)
sm.clustering <- round(transitivity(sm, type="global"),3)

3.2.2.3 Red empresas de Barabasi-Albert

En tercer lugar, simulamos la red con un proceso que sigue Preferential Attachement, propuesta por Barabasi.

# sample_pa(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL,
#      out.pref = FALSE, zero.appeal = 1, directed = TRUE,
#      algorithm = c("psumtree", "psumtree-multiple", "bag"),
#      start.graph = NULL)
# n; Number of vertices.
# power: The power of the preferential attachment, the default is one, ie. linear
# m: Numeric constant, the number of edges to add in each time step.
# out.dist: Numeric vector, the distribution of the number of edges to add in each time step. This argument is only used if the out.seq argument is omitted or NULL.
# out.seq: Numeric vector giving the number of edges to add in each time step. Its first element is ignored as no edges are added in the first time step.
# out.pref: Logical, if true the total degree is used for calculating the citation probability, otherwise the in-degree is used.
# zero.appeal: The 'attractiveness' of the vertices with no adjacent edges. See details below.
# directed: Whether to create a directed graph.
# algorithm: The algorithm to use for the graph generation.
# start.graph: ... If a graph, then the supplied graph is used as a starting graph for the preferential attachment algorithm. 

red.pa <- barabasi.game(size,power=1, m=2, directed=F, algorithm="psumtree") 
degree.red <- degree(red.pa)
l <- layout.reingold.tilford(red.pa, circular=T)
plot(red.pa, 
     main="Red Simulada- Barabasi-Albert", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(red.pa, circular=T),
     edge.color="grey",
     edge.width=E(red.pa)$weight/10,
     edge.arrow.size=0.1,
     vertex.size=degree.red/2, 
     vertex.frame.color="blue", 
     vertex.label=NA)

red.pa.distancia <- round(mean_distance(red.pa),3)
red.pa.clustering <- round(transitivity(red.pa, type="global"),3)

3.2.3 Comparación redes simuladas y real

Para comprarar la red observada y las simuladas, elaboramos la siguiente tabla resumen:

resumen <- matrix(c(red.e.distancia,red.e.clustering, 
  er.distancia, er.clustering,
  sm.distancia,sm.clustering,
  red.pa.distancia,red.pa.clustering),
  nrow=4,ncol=2,byrow=F)
colnames(resumen) <- c("distancia","clustering")
row.names(resumen) <- c("Real","ER","SW","PA")
resumen
##      distancia clustering
## Real     1.000      1.455
## ER       0.718      0.568
## SW       1.591      1.894
## PA       0.391      0.150

Es apreciable, que ninguna de las redes simuladas es tan similar a la red observada. Especialmente se descarta el proceso de Erdös-Renyi y de Preferential Attachement. El caso de mundos peqeños es la unica que predice un alto nivel de clustering (como el observado), pero la distancia predicha es bastante superior.

4 Análisis Red de Rubros

Definiremos la red de rubros en el sector de Comercio como la proyeccion de la red bivariada de empresas y rubros, en la cual los nodos estan compuestos por rubros y los vínculos por las empresas que operan en estos.

G = {Nodos = {rubro 1, rubro 2,… }, Links = {Empresa 1, Empresa 2, …})

4.1 Análisis descriptivo

Partiendo de la matriz de adjacencia elaborada, construimos el grafo correspondiente y como primera aproximacón lo graficamos. Esta corresponde a una red no direccionada con pesos, ya que dos empresas pueden estar vinculadas por más de una empresa.

library(igraph)

# Elaboración red rubros  

red_rcom <- igraph::graph.adjacency(as.matrix(comercio_adj_rubro))
plot(red_rcom, edge.arrow.size=.001,vertex.label.cex=0.5, vertex.size=15)

4.1.1 Conectividad y densidad

Es apreciable (del grafo) que hay un grupo de rubros que conforman un componente gigante, y varios clusters de menor tamaño, triadas, diadas e islas. Esto es consistente con la definición de la red en empresas, obviamente, ya que ambas provienen de la misma red bivariada y por ende, también es una red dispersa.

Esto es más evidente al estudiar la densidad de la red , que indica cual es la proporción de los edges (o vínculos/links) presentes del total posible de vínculos en esta red.

edge_density(red_rcom, loops=F)
## [1] 0.01461039

Es decir, solo un 1.5% de los posibles links, se observan empíricamente. Dada la baja densidad de la red, se extraerá el componente gigante y se trabajará con este a partir de ahora. Probablemente ocurre dada la diversidad de rubros que existe en este sector industruial.

componentes_rcom <- clusters(red_rcom)
componentes_rcom
## $membership
##  R1  R2  R3  R4  R5  R6  R7  R8  R9 R10 R11 R12 R13 R14 R15 R16 R17 R18 R19 R20 
##   1   1   2   2   3   3   3   2   4   4   2   2   5   5   6   6   7   7   8   8 
## R21 R22 R23 R24 R25 R26 R27 R28 R29 R30 R31 R32 R33 R34 R35 R36 R37 R38 R39 R40 
##   3   4   9   9  10  10   2  11  11   1   2   2   2  12  12   1  13  13   1   9 
## R41 R42 R43 R44 R45 R46 R47 R48 R49 R50 R51 R52 R53 R54 R55 R56 
##   2   9  10   2   2   2  14  14  10   2  15  15  16  16   2   6 
## 
## $csize
##  [1]  5 15  4  3  2  3  2  2  4  4  2  2  2  2  2  2
## 
## $no
## [1] 16
g_rcom <- which.max(componentes_rcom$csize) # identificamos el gigante
redg_rcom <- induced.subgraph(red_rcom, which(componentes_rcom$membership == g_rcom)) # nos quedamos con el componente gigante

V(red_rcom)
## + 56/56 vertices, named, from 3fc6040:
##  [1] R1  R2  R3  R4  R5  R6  R7  R8  R9  R10 R11 R12 R13 R14 R15 R16 R17 R18 R19
## [20] R20 R21 R22 R23 R24 R25 R26 R27 R28 R29 R30 R31 R32 R33 R34 R35 R36 R37 R38
## [39] R39 R40 R41 R42 R43 R44 R45 R46 R47 R48 R49 R50 R51 R52 R53 R54 R55 R56
V(redg_rcom)
## + 15/15 vertices, named, from 4af21ca:
##  [1] R3  R4  R8  R11 R12 R27 R31 R32 R33 R41 R44 R45 R46 R50 R55

En este caso, el componente gigante contempla a 16 rubros del total de 55 Así, representamos gráfimacente al componente gigante:

plot(redg_rcom, edge.arrow.size=.001,vertex.label.cex=0.6, vertex.size=25)

Si ahora revisamos la densidad del componente gigante, claramente es mucho mayor que al considerar la red completa. En este caso, el componente tiene una densidad de aproximadamente 8%, es decir, un 8% del total de links posibles son observados en la red. AUn asó, es una red bastante dispersa.

edge_density(redg_rcom, loops=F)
## [1] 0.08095238

4.1.2 Diametro y distancia media

El diametro es una primera aproximación al tamaño de la red y a su conectividad. Este corresponde la mayor distancia geodésica de la red.

diameter(redg_rcom, directed=F, unconnected=FALSE)
## [1] 4
diam <- get_diameter(redg_rcom, directed=F)
diam
## + 5/15 vertices, named, from 4af21ca:
## [1] R11 R12 R4  R31 R44

Es apreciable que el diametro de la red es de 4 y contempla a 5 vértices, los rubros 11, 12, 4, 31 y 44. Es apreciable que el diametro es mucho mayor que en el caso de red de empresas, ya que esta red es mucho menos densa.

La distancia media, corresponde al promedio de la geodésica entre todos los pares de nodos de la red. En este caso corresponde a 2.36, es decir que la mayoría de los nodos estan a poco más de 2 geodésica de distancia. Resultado consistentes con los anteriores.

igraph::average.path.length(redg_rcom, directed=F, unconnected = F)
## [1] 2.361905

4.1.3 Análisis de Centralidad

Centralidad analiza la “importancia” de os nodos en la red, se puede medir de varias maneras si teine muchas conexiones (grado/degree), es de fácil acceso (closesness) está bien conectado, es popular (eigenvalue) o está en el camino de varias geodésicas (betweeness). En esta sección revisaremos cada una de esas perspectivas y concluiremos con una tabla resumen.

4.1.3.1 Centralidad de grado (Degree)

Describimos el grado de cada nodo y su distribución de estos, recordando que el grado corresponde al número de links en cada nodo.

centralidad_grado_r <- igraph::degree(redg_rcom)
centralidad_grado_r
##  R3  R4  R8 R11 R12 R27 R31 R32 R33 R41 R44 R45 R46 R50 R55 
##   1   6   1   1  12   1   2   1   1   1   1   2   1   2   1

Es apreciable que todas los rubros (en este componente) están vinculadas con al menos 1 rubro y con un máximo de 12 grados. Cabe recordar que los vínculos son con pesos, así que 2 rubros pueden estar vinculadas más de una vez si comparten más de una empresa en común.

deg_r <- degree(redg_rcom, mode="all")

plot(redg_rcom, edge.arrow.size=.001,vertex.label.cex=0.6, vertex.size=deg_r*2.5)

En el grafico podemos apreciar los nodos escalados en relación a su centralidad de grado. Entonces, tenemos un rubro con una alta centraidad (R12) y le sigue el R4. Usando la información obtenida en el punto anterior, se genera el gráfico de distribución de grado a través de un histograma.

hist(deg_r, breaks=0:12, main="Histograma de grado, Red rubros de comercio", col="light blue", xlab="Grado nodo", ylab="Freecuencia", xlim=c(-1,12))

Como el histograma tiene pocos puntos de masa,la distribución acumulada es más explicadtiva.

deg.dist.r <- degree_distribution(redg_rcom, cumulative=T, mode="all")

plot( x=0:max(deg_r), y=1-deg.dist.r, pch=19, cex=1.2, col="light blue", 

      xlab="Grado del nodo", ylab="Frecuencia Acumulada", main="Distribución acumulada de grado, Red rubros de comercio")

Es observable que la mayoría de los nodos tiene 4 o menos conexiones. Con unos pocos nodos con más conecciones.

4.1.3.2 Centralidad de cercanía (closeness)

La centralidad de cercanía, en relación a la distancia a otras en el grafo. Se refiere a la inversa de la distancia geodésica a otros nodos en la red.

centralidad_cercania_r <- closeness(redg_rcom,normalized=T)
## Warning in closeness(redg_rcom, normalized = T): At centrality.c:2784 :closeness
## centrality is not well-defined for disconnected graphs
centralidad_cercania_r
##         R3         R4         R8        R11        R12        R27        R31 
## 0.07142857 0.06666667 0.07142857 0.08917197 0.08333333 0.08917197 0.07692308 
##        R32        R33        R41        R44        R45        R46        R50 
## 0.06666667 0.08917197 0.07142857 0.06666667 0.08917197 0.08917197 0.06666667 
##        R55 
## 0.08917197

En este caso, ningun nodo tiene alta cercania en particular y todos están bajo 0.1.

4.1.3.3 Centralidad de Valor propio (Eigenvalue)

Esta centralidad se refiere a la ponderación de la centralidad de los nodos que les rodean. Será más central, en la medida de que está conectado a otros nodos centrales.

# centralidad eigenvalue
centralidad_eigen_r <- eigen_centrality(redg_rcom)
centralidad_eigen_r$vector
##         R3         R4         R8        R11        R12        R27        R31 
## 0.13311722 0.58145965 0.13311722 0.22893629 1.00000000 0.22893629 0.14048003 
##        R32        R33        R41        R44        R45        R46        R50 
## 0.22893629 0.22893629 0.13311722 0.03216098 0.45787259 0.22893629 0.45787259 
##        R55 
## 0.22893629

En este caso, el nodo R12 destaca por un alto valor, seguido por el R50.

4.1.3.4 Centralidad de Intermediación (Betweenness)

Es una medida de centralidad basada en la posición de Broker o intermediario. Se identifica por el número de geodésicas que pasan por el nodo o vértice. Al igual que en el caso anterior, tenemos muchos valores de 0. Sin embargo, el único con un valor positivo es R12.

centralidad_intermediacion_r <- betweenness(redg_rcom, normalized = T)
centralidad_intermediacion_r
##        R3        R4        R8       R11       R12       R27       R31       R32 
## 0.0000000 0.0000000 0.0000000 0.0000000 0.0989011 0.0000000 0.0000000 0.0000000 
##       R33       R41       R44       R45       R46       R50       R55 
## 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000

4.1.3.5 Cuadro resumen de centralidades

De los cálculos anteriores, se elabora la siguiente tabla resumen:

centralidades_r <- cbind(centralidad_grado_r,
                       centralidad_cercania_r,
                       centralidad_eigen_r$vector,
                       centralidad_intermediacion_r) 
colnames(centralidades_r) <- c("grado", "cercania", "eigen", "intermediacion")
centralidades_r
##     grado   cercania      eigen intermediacion
## R3      1 0.07142857 0.13311722      0.0000000
## R4      6 0.06666667 0.58145965      0.0000000
## R8      1 0.07142857 0.13311722      0.0000000
## R11     1 0.08917197 0.22893629      0.0000000
## R12    12 0.08333333 1.00000000      0.0989011
## R27     1 0.08917197 0.22893629      0.0000000
## R31     2 0.07692308 0.14048003      0.0000000
## R32     1 0.06666667 0.22893629      0.0000000
## R33     1 0.08917197 0.22893629      0.0000000
## R41     1 0.07142857 0.13311722      0.0000000
## R44     1 0.06666667 0.03216098      0.0000000
## R45     2 0.08917197 0.45787259      0.0000000
## R46     1 0.08917197 0.22893629      0.0000000
## R50     2 0.06666667 0.45787259      0.0000000
## R55     1 0.08917197 0.22893629      0.0000000

Es apreciable que el nodo con mayor centralidad de esta red es el R12, seguido del R4.

4.1.4 Triadas y transitividad

Podemos revisar de tipo de relacion existe entre todas las posibles triadas del grafo, usando la clasificación https://igraph.org/r/doc/triad_census.html. Cabe destacr que este análisis es valido para grafos direccionados. En nuestro caso, el grafo es no direccionado pero igualmente el censo puede ser informativo, agrupando los resultados que descomponen las triadas que el grafo está completo.

igraph::triad_census(redg_rcom)
##  [1] 320  77  11   4  25  18   0   0   0   0   0   0   0   0   0   0

Es apreciable que hay 320 triadas en las cuales no hay relación, 77 en los cuales el grafo tiene una conección mutua entre dos vertices, sin incluir un tercero y 47 que la triada está completa. En este caso, es consecuencia de la alta dispersion del grafo que muchas triadas están incompletas.

motifs(redg_rcom, 3)
##  [1] NA NA 25 NA 18  0  4  0  0  0  0  0  0  0  0  0
count_motifs(redg_rcom,3)
## [1] 47

Finalmente, podemos revisar el ratio de transitividad. La transitividad global se refiere al ratio de triangulos de triadas. En este caso, corresponde a 0%.

transitivity(redg_rcom, type="global")
## [1] 0

4.1.5 Centralización

Es posible observar que tan cohesionada está la red en función de sus características globales. Mide la cohesión de la red, comparando la centralidad del nodo más central con la de cada uno de los otros.

data.frame(centr_degree = centr_degree(redg_rcom)$centralization, cent_clo = centr_clo(redg_rcom)$centralization, centr_eigen = centr_eigen(redg_rcom)$centralization, centr_betw = centr_betw(redg_rcom)$centralization)
##   centr_degree   cent_clo centr_eigen centr_betw
## 1     0.372449 0.01234737   0.8120911  0.0989011

Es apreciable que es una red con baja cohesion, excepto al considerar el valor propio. Esto porque los don nodos más cetrales de la red (12 y 4) estan conectados.

4.2 Análisis de formación red rubros

En esta seccón, se revisará si las red de rubros observada es similar a alguna formada aleatoriamente por alguno de los siguientes procesos de fromación de redes: Erdös-Renyi, Strogatz-Watts o Barabasi-Albert.

4.2.1 Medidas de comparación

Preparamos las medidas de comparación relevantes de la red original de rubros, seguiremos trabajando con el componente gigante solamente (por consistencia).

# dibujamos la red original 

red.r.degree <- degree(redg_rcom)

plot(redg_rcom, 
     main="Red real de rubros (comp gigante)", 
     vertex.color="light blue",
     vertex.label=NA,
     edge.color="grey",
     edge.width=E(redg_rcom)$weight,
     edge.arrow.size=0.1,
     vertex.size=red.r.degree, # veamos los nodos según centralidad de grado
     vertex.frame.color="blue"
     )

#Agregamos los elementos para la tabla de comparación

red.r.distancia <- round(mean_distance(redg_rcom),3)
red.r.distancia
## [1] 1.562
red.r.clustering <- round(transitivity(redg_rcom, type="global"),3)
red.r.clustering
## [1] 0

4.2.2 Redes rubros simuladas

En esta sección, simulamos la red de rubros usando los 3 procesos: Erdös-Renyi, Strogatz-Watts o Barabasi-Albert, para cada una lo graficaremos y extraeremos medidas de distancia promedio y clustering, para compara con la red real de rubros observada en los datos.

4.2.2.1 Red rubros Erdös-Renyi

Obtenemos primero una red generada con un proceso aleatorio de Erdos-Renyi, con atributos similares a nuestra red.

# erdos.renyi.game(n, p.or.m, type = c("gnp", "gnm"), directed = FALSE, loops = FALSE, ...)
# n: The number of vertices in the graph.
# p.or.m: Either the probability for drawing an edge between two arbitrary vertices (G(n,p) graph), or the number of edges in the graph (for G(n,m) graphs).
# type: The type of the random graph to create, either gnp (G(n,p) graph) or gnm (G(n,m) graph).
# directed: Logical, whether the graph will be directed, defaults to FALSE.
# loops: Logical, whether to add loop edges, defaults to FALSE.

size <- length(V(redg_rcom))
dens <- graph.density(redg_rcom) # probabilidad de un link
er <- erdos.renyi.game(size, dens) # gnp
er.grado <- degree(er)

plot(er, 
     main="Red Simulada - Erdos-Renyi", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(er, circular=T),
     edge.color="grey",
     edge.width=E(er)$weight,
     edge.arrow.size=0.1,
     vertex.size=er.grado, 
     vertex.frame.color="blue", 
     vertex.label=NA)

er.distancia <- round(mean_distance(er),3)
er.clustering <- round(transitivity(er, type="global"),3)

4.2.2.2 Red rubros de Strogatz-Watts

En segundo lugar, obtenemos la red generada por un porceso de Mundos Pequeños, de Strogatz-Watts que simula atributos de la red de rubros de comercio.

# sample_smallworld(dim, size, nei, p, loops = FALSE, multiple = FALSE)
# dim: Integer constant, the dimension of the starting lattice.
# size: Integer constant, the size of the lattice along each dimension.
# nei: Integer constant, the neighborhood within which the vertices of the lattice will be connected.
# p: Real constant between zero and one, the rewiring probability.
# loops: Logical scalar, whether loops edges are allowed in the generated graph.
# multiple: Logical scalar, whether multiple edges are allowed int the generated graph.

sm <- watts.strogatz.game(1,size,3,0.1) # estoy asumiendo vecindarios de 3 nodos y rewiring de 0.1 (se puede mejorar la precisión)
sm.grado <- degree(sm)
plot(sm, 
     main="Red Simulada - Strogatz-Watts", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(sm, circular=T),
     edge.color="grey",
     edge.width=E(sm)$weight,
     edge.arrow.size=0.1,
     vertex.size=sm.grado, 
     vertex.frame.color="blue", 
     vertex.label=NA)

sm.distancia <- round(mean_distance(sm),3)
sm.clustering <- round(transitivity(sm, type="global"),3)

4.2.2.3 Red empresas de Barabasi-Albert

En tercer lugar, simulamos la red con un proceso que sigue Preferential Attachement, propuesta por Barabasi.

# sample_pa(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL,
#      out.pref = FALSE, zero.appeal = 1, directed = TRUE,
#      algorithm = c("psumtree", "psumtree-multiple", "bag"),
#      start.graph = NULL)
# n; Number of vertices.
# power: The power of the preferential attachment, the default is one, ie. linear
# m: Numeric constant, the number of edges to add in each time step.
# out.dist: Numeric vector, the distribution of the number of edges to add in each time step. This argument is only used if the out.seq argument is omitted or NULL.
# out.seq: Numeric vector giving the number of edges to add in each time step. Its first element is ignored as no edges are added in the first time step.
# out.pref: Logical, if true the total degree is used for calculating the citation probability, otherwise the in-degree is used.
# zero.appeal: The 'attractiveness' of the vertices with no adjacent edges. See details below.
# directed: Whether to create a directed graph.
# algorithm: The algorithm to use for the graph generation.
# start.graph: ... If a graph, then the supplied graph is used as a starting graph for the preferential attachment algorithm. 

red.pa <- barabasi.game(size,power=1, m=2, directed=F, algorithm="psumtree") 
degree.red <- degree(red.pa)
l <- layout.reingold.tilford(red.pa, circular=T)
plot(red.pa, 
     main="Red Simulada- Barabasi-Albert", 
     vertex.color="light blue",
     layout=layout.reingold.tilford(red.pa, circular=T),
     edge.color="grey",
     edge.width=E(red.pa)$weight,
     edge.arrow.size=0.1,
     vertex.size=degree.red, 
     vertex.frame.color="blue", 
     vertex.label=NA)

red.pa.distancia <- round(mean_distance(red.pa),3)
red.pa.clustering <- round(transitivity(red.pa, type="global"),3)

4.2.3 Comparación redes simuladas y real de rubros

Para comprarar la red observada y las simuladas, elaboramos la siguiente tabla resumen:

resumen <- matrix(c(red.r.distancia,red.r.clustering, 
  er.distancia, er.clustering,
  sm.distancia,sm.clustering,
  red.pa.distancia,red.pa.clustering),
  nrow=4,ncol=2,byrow=F)
colnames(resumen) <- c("distancia","clustering")
row.names(resumen) <- c("Real","ER","SW","PA")
resumen
##      distancia clustering
## Real     1.562      1.657
## ER       0.000      0.537
## SW       1.200      1.962
## PA       0.000      0.140

Es apreciable, que ninguna de las redes simuladas es tan similar a la red observada. Especialmente se descarta el proceso de Erdös-Renyi y de Preferential Attachement, que al igual que en el caso de las empresas tienen parámetros muy diferentes a los observados. El caso de mundos pequeños es la única que se aproxima, al igual que en el caso de las empresas. De todas maneras, hay diferencias en los coeficientes observados.