Universidad Externado de Colombia

Maestría en Inteligencia de Negocios - Aprendizaje Estadístico

Ejercicio 1

En Colombia hay bastante inquietud por la cantidad de robos que se presentan diariamente. Los celulares, motocicletas y bicicletas han sido los elementos más ansiados por los delincuentes en nuestro país, mientras que los carros y el robo de billeteras vienen a la baja. La cantidad total de robos en el país es una incógnita, ya que no siempre se reporta este delito en los entes de control. Por otro lado, la cantidad de homicidios en cada municipio del país si se reporta diariamente y se reporta ante las autoridades competentes. Se sospecha que estas dos variables, por municipio, están altamente correlacionadas.

* Obtener una base de datos por municipios, que contenga la cantidad de delitos por temática, porcentaje de mujeres víctimas y porcentaje de delitos en zonas rural.

## # A tibble: 6 × 7
## # Groups:   MUNICIPIO [4]
##   MUNICIPIO       TEMATICA CANTIDAD cantidad_mujeres porc_mujeres cantidad_rural
##   <chr>           <chr>       <int>            <int>        <dbl>          <int>
## 1 BOGOTÁ D.C. (C… HURTO A…    53410            18038         33.8             69
## 2 BOGOTÁ D.C. (C… LESIONE…    20123             8228         40.9             35
## 3 CALI (CT)       HURTO A…    19489             7231         37.1            192
## 4 BOGOTÁ D.C. (C… HURTO A…    12178             5827         47.8             24
## 5 BARRANQUILLA (… HURTO A…    11299             3521         31.2              8
## 6 MEDELLÍN (CT)   HURTO A…     9930             3873         39.0             61
## # … with 1 more variable: porc_rural <dbl>
# Top 10 de Municipios con más delitos
top_n(
      delitos %>%
        select(MUNICIPIO, TEMATICA, DEPARTAMENTO, SEXO, ZONA) %>% 
        group_by(MUNICIPIO) %>%
        #filter(ZONA == "RURAL") %>%
        summarise(CANTIDAD = n()) %>% 
        arrange(desc(CANTIDAD)) 
    ,10) -> top10_mun

par(mai = c(0.8, 1.5, 0.5, 0.3) + 0.02) # Tamaño de margenes (abajo,izquierda,arriba,derecha)
mun_plot <- barplot(top10_mun$CANTIDAD, 
        #ylab = "Municipio", 
        #xlab = "Frecuencia", 
        cex.names = 0.6, # Eje de las Y
        cex.axis = 0.6, # Eje de las X
        xlim = c(0,120000), 
        las = 1,
        beside = TRUE,
        names.arg = top10_mun$MUNICIPIO, 
        #angle = 45,
        horiz = TRUE,
        #space = 0.5, # Distancia entre las barras 
        border = "thistle1", col = brewer.pal(10, "Set3"), 
        main = "TOP_10 de Frecuencias por Municipio")

text(mun_plot, 
     adj = 1,
     pos = 4, offset = 0.5, vfont = NULL,
     cex = 0.5,
     labels = format(top10_mun$CANTIDAD, big.mark = ","))

La gráfica permite visualizar la alta representatividad de los delitos concentrados en las ciudades capitales con mayor concentración en las ciudades de Bogotá, Cali, Barranquilla y Medellin.

1. Explique si la cantidad de homicidios tiene una correlación alta con la cantidad de robos.

Identificamos de la base de datos de Delitos los registro asociados a las temáticas “Hurtos” y “Homicidios” para poder efectuar la correlación de las variables solicitadas.

Delitos_por_Tematica %>% 
  select(MUNICIPIO,TEMATICA,CANTIDAD) %>% 
  group_by(MUNICIPIO) %>% 
  summarise(HOMICIDIOS=sum(CANTIDAD[TEMATICA=="HOMICIDIOS"]),
            HURTOS=sum(CANTIDAD[TEMATICA=="HURTO A PERSONAS" | TEMATICA=="HURTO A RESIDENCIAS"])) -> HOMICIDIOS_HURTOS

Efectuamos la Correlación entre las variables de Homicidios y Hurtos.

round(cor(HOMICIDIOS_HURTOS$HURTOS, HOMICIDIOS_HURTOS$HOMICIDIOS),2) -> cor_hh

cor_hh
## [1] 0.84

La correlación entre los Hurtos y los Homicidios es de 0.84 lo que indica que tienen una alta relación.

La siguiente gráfica permite corroborar graficamente lo afirmado al observar la linea de tendencia creciente de homicidios en la medida que crece la cantidad de hurtos.

plot(HOMICIDIOS_HURTOS$HURTOS, HOMICIDIOS_HURTOS$HOMICIDIOS,
     cex.main=0.9, cex.sub=0.8, cex.axis=0.6, cex.lab=0.7,
     main = "Correlación Hurtos sobre Homicidios",
     xlab = "Hurtos", 
     ylab = "Homicidios",
     col = brewer.pal(10, "Set1"),
     lty = 1,
     las = 1
     )

Adicionalmente, verificamos el area de impacto de la relación de las variables.

#install.packages("car", dep=T)
library(car)
car::scatterplot(HOMICIDIOS_HURTOS$HURTOS, HOMICIDIOS_HURTOS$HOMICIDIOS,
                     cex.main=0.9, cex.sub=0.8, cex.axis=0.6, cex.lab=0.7,
     main = "Correlación Hurtos sobre Homicidios",
     xlab = "Hurtos", 
     ylab = "Homicidios",
     col = brewer.pal(10, "Set1"),
     lty = 1,
     las = 1)

2. Realice diagrama de barras de los diez municipios con mayor cantidad de delitos por temática y explique.

Se efectua un cruce entre las tablas generadas de los municipios con mayor numero de delitos frente a la base dedatos agrupada por Temática del delito y Municipio asociado para extraer la data pertinente para el análisis.

merge(delitos, top10_mun, by = c("MUNICIPIO")) -> delitos_top10

table(delitos_top10$TEMATICA, delitos_top10$MUNICIPIO) -> cuenta_top10

#View(cuenta_top10)

margin.table(cuenta_top10,2) # Total por Municipio
## 
##  BARRANQUILLA (CT)   BOGOTÁ D.C. (CT)   BUCARAMANGA (CT)          CALI (CT) 
##              22124             104465              15719              42396 
##        IBAGUÉ (CT)      MEDELLÍN (CT)         NEIVA (CT)         PASTO (CT) 
##              12111              21896              10967               9873 
##       PEREIRA (CT) VILLAVICENCIO (CT) 
##              10525              16162
(dataRD <- matrix(numeric(10*12), ncol = 10))
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
##  [1,]    0    0    0    0    0    0    0    0    0     0
##  [2,]    0    0    0    0    0    0    0    0    0     0
##  [3,]    0    0    0    0    0    0    0    0    0     0
##  [4,]    0    0    0    0    0    0    0    0    0     0
##  [5,]    0    0    0    0    0    0    0    0    0     0
##  [6,]    0    0    0    0    0    0    0    0    0     0
##  [7,]    0    0    0    0    0    0    0    0    0     0
##  [8,]    0    0    0    0    0    0    0    0    0     0
##  [9,]    0    0    0    0    0    0    0    0    0     0
## [10,]    0    0    0    0    0    0    0    0    0     0
## [11,]    0    0    0    0    0    0    0    0    0     0
## [12,]    0    0    0    0    0    0    0    0    0     0
for (i in 1:12) {
  dataRD[i, ] = round(100*cuenta_top10[i, ]/margin.table(cuenta_top10, 2)[ ], 2)
}

dataRD[,2]
##  [1]  0.03  2.95  0.06  4.40  0.58  2.64 51.13 11.66 19.26  0.07  0.05  7.17
dataRD[1, ] = round(100*cuenta_top10[1, ]/margin.table(cuenta_top10, 2)[ ], 2)

#windows()
par(mar = c(5, 8, 4, 2) + 0.5)  
barplot(cuenta_top10, main = "Tipo de Delito por Municipio", border = "thistle1",
        xlab = "Municipio", 
        col = brewer.pal(10, "Set3"),
        cex.names = 0.6,
        cex.axis = 0.6, 
        xlim = c(0,120000), 
        las = 1,
        horiz = TRUE,
        legend = rownames(cuenta_top10),
        args.legend = list(x = "topright", cex=0.6))

# Hurtos
legend(5000, 1.0, paste(dataRD[7,1], "%"), cex = 0.4, bty = "n")
legend(20000, 2.0, paste(dataRD[7,2], "%"), cex = 0.4, bty = "n")
legend(3000, 3.3, paste(dataRD[7,3], "%"), cex = 0.4, bty = "n")
legend(13000, 4.60, paste(dataRD[7,4], "%"), cex = 0.4, bty = "n")
legend(5000, 6.80, paste(dataRD[7,6], "%"), cex = 0.4, bty = "n")
legend(1000, 12.00, paste(dataRD[7,10], "%"), cex = 0.4, bty = "n")

# Homicidios
legend(6000, 2.0, paste(dataRD[6,2], "%"), cex = 0.4, bty = "n")
legend(1200, 4.60, paste(dataRD[6,4], "%"), cex = 0.4, bty = "n")
legend(200, 6.80, paste(dataRD[6,6], "%"), cex = 0.4, bty = "n")

# Lesiones Personales
legend(85000, 2.0, paste(dataRD[9,2], "%"), cex = 0.4, bty = "n")
legend(27000, 4.60, paste(dataRD[9,4], "%"), cex = 0.4, bty = "n")
legend(2550, 9.50, paste(dataRD[9,8], "%"), cex = 0.4, bty = "n")

Se presenta una alta proporción del delito “Hurto a Personas” generalizada en las principales ciudades que representan en promedios cercanos al 50% de los delitos cometidos; se destacan las ciudades de Bogotá con un 51.13%, Barranquilla con un 51.07%, Cali y Medellín cercanos a un 46% y Villavicencia con un 40%.

Contrasta con la proporción de homicidios que asciende a 2.64% en Bogotá, que es el municipio con mayor participación en delitos frente a la perticiáción de los homicidios en ciudades como Medellin con una participación de homicidios del 9.45% y Cali con un 6.45% de prticipación de homicidios.

El delito “Lesiones Personales” representa un 19.26% para Bogotá, un 22.5% para Cali y se aumenta relativamente en la ciudad de Pasto al representar el 28.57%.

3. Realice histogramas de la razón de homicidios de hombres sobre homicidios de mujeres.

Delitos_por_Tematica %>% 
  select(MUNICIPIO,TEMATICA,CANTIDAD, cantidad_mujeres) %>% 
  group_by(MUNICIPIO) %>% 
  summarise(total_homicidios=sum(CANTIDAD[TEMATICA=="HOMICIDIOS"]),
            homicidios_mujeres=sum(cantidad_mujeres[TEMATICA=="HOMICIDIOS"]),
            razon_hombre_mujer=(total_homicidios-homicidios_mujeres)/homicidios_mujeres ) -> razon_homicidios

hist(razon_homicidios$razon_hombre_mujer,
     main = "Histograma Razón de Homicidios", border = "thistle1",
     xlab = "Razón homicidios hombre / homicidios mujer", 
     ylab = "Cantidad Municipios",
     col = brewer.pal(10, "Set2"),
     cex.main=0.7, cex.sub=0.6, cex.axis=0.6, cex.lab=0.6, cex.names = 0.5,
     xlim = c(0,35),
     ylim = c(0,300),
     las = 1
     )

El histograma general de la razón de homicidios de hombres sobre mujeres permite evidenciar que se presentan entre 0 y 5 homicidios de hombres por cada homicidio de mujeres en mas de 230 municipios. En cerca de 500 municipios se presentan entre 0 y 20 homicidios de hombres por cada homicidio de una mujer.

Los municipios con Razón de homicidios (hombre/mujer) mas alta se presentan a continuación:

razon_homicidios[order(razon_homicidios$razon_hombre_mujer,decreasing = TRUE),]
## # A tibble: 1,022 × 4
##    MUNICIPIO         total_homicidios homicidios_mujeres razon_hombre_mujer
##    <chr>                        <int>              <int>              <dbl>
##  1 ABEJORRAL                        8                  0                Inf
##  2 ACHÍ                             3                  0                Inf
##  3 AGRADO                           1                  0                Inf
##  4 AGUA DE DIOS                     2                  0                Inf
##  5 ALDANA                           6                  0                Inf
##  6 ALEJANDRÍA                       1                  0                Inf
##  7 ALGARROBO                        6                  0                Inf
##  8 ALMAGUER                         7                  0                Inf
##  9 ALMEIDA                          2                  0                Inf
## 10 ALTOS DEL ROSARIO                2                  0                Inf
## # … with 1,012 more rows
razon_homicidios[razon_homicidios$homicidios_mujeres > 0,] %>% 
  arrange(desc(razon_hombre_mujer)) %>%
  top_n(10) -> top10_razon_homicidios

hist(top10_razon_homicidios$razon_hombre_mujer,
     main = "Histograma Municipios con MAYOR Razón de Homicidios", border = "thistle1",
     xlab = "Razón homicidios hombre / homicidios mujer", 
     ylab = "Cantidad Municipios",
     col = brewer.pal(10, "Set1"),
     cex.main=0.7, cex.sub=0.6, cex.axis=0.6, cex.lab=0.6, cex.names = 0.5,
     xlim = c(30,80),
     ylim = c(0,10),
     las = 1
    )

Entre 1 y 5 municipios tienen la razon de homicidios que oscila entre 30 y 45 hombres por cada homicidio de mujer.

4. * Ahora debemos obtener una base de datos para Bogotá, para lograr el proposito:

delitos %>% 
  filter(delitos$MUNICIPIO=="BOGOTÁ D.C. (CT)") -> DELITOS_BOGOTA

tail(DELITOS_BOGOTA)
##         TEMATICA      FECHA DEPARTAMENTO        MUNICIPIO       DIA  HORA
## 104460 EXTORCIÓN 08/01/2014 CUNDINAMARCA BOGOTÁ D.C. (CT) Miércoles  9:30
## 104461 EXTORCIÓN 07/01/2014 CUNDINAMARCA BOGOTÁ D.C. (CT)    Martes 10:00
## 104462 EXTORCIÓN 07/01/2014 CUNDINAMARCA BOGOTÁ D.C. (CT)    Martes 11:00
## 104463 EXTORCIÓN 07/01/2014 CUNDINAMARCA BOGOTÁ D.C. (CT)    Martes 12:00
## 104464 EXTORCIÓN 05/01/2014 CUNDINAMARCA BOGOTÁ D.C. (CT)   Domingo 17:00
## 104465 EXTORCIÓN 02/01/2014 CUNDINAMARCA BOGOTÁ D.C. (CT)    Jueves 10:00
##                                         BARRIO   ZONA         CLASE_SITIO
## 104460                      CIUDAD JARDIN E-11 URBANA CASAS DE HABITACION
## 104461                             JAKELIN E-8 URBANA     LOCAL COMERCIAL
## 104462                SANTA ANA OCCIDENTAL E-1 URBANA        RESTAURANTES
## 104463                           RESTREPO E-15 URBANA     LOCAL COMERCIAL
## 104464 URB. CIUDAD KENNEDY ORIENTAL SPMZ 3 E-8 URBANA CASAS DE HABITACION
## 104465                   CASTILLA LA NUEVA E-8 URBANA CASAS DE HABITACION
##             ARMA_EMPLEADA MOVIL_AGRESOR MOVIL_VICTIMA EDAD      SEXO
## 104460 LLAMADA TELEFONICA  NO REPORTADA  NO REPORTADA   57 MASCULINO
## 104461 LLAMADA TELEFONICA         A PIE         A PIE   37 MASCULINO
## 104462 LLAMADA TELEFONICA         A PIE  NO REPORTADA   38 MASCULINO
## 104463 LLAMADA TELEFONICA         A PIE         A PIE   46 MASCULINO
## 104464              MIXTA  NO REPORTADA  NO REPORTADA   24  FEMENINO
## 104465 LLAMADA TELEFONICA         A PIE         A PIE   46 MASCULINO
##        ESTADO_CIVIL PAIS_NACE CLASE_EMPLEADO    PROFESION  ESCOLARIDAD
## 104460       CASADO  COLOMBIA       GANADERO NO REPORTADA      TECNICO
## 104461       CASADO  COLOMBIA    COMERCIANTE NO REPORTADA   SECUNDARIA
## 104462       CASADO  COLOMBIA    COMERCIANTE NO REPORTADA   SECUNDARIA
## 104463       CASADO  COLOMBIA    COMERCIANTE NO REPORTADA   SECUNDARIA
## 104464      SOLTERO  COLOMBIA    COMERCIANTE NO REPORTADA NO REPORTADO
## 104465       CASADO  COLOMBIA    COMERCIANTE NO REPORTADA     PRIMARIA
##        CODIGO_DANE
## 104460    11001000
## 104461    11001000
## 104462    11001000
## 104463    11001000
## 104464    11001000
## 104465    11001000

4.1. Reclasifique el tipo de arma empleada en las siguientes categorías: Sin empleo de armas, arma de fuego, arma blanca y otra.

names(DELITOS_BOGOTA)
##  [1] "TEMATICA"       "FECHA"          "DEPARTAMENTO"   "MUNICIPIO"     
##  [5] "DIA"            "HORA"           "BARRIO"         "ZONA"          
##  [9] "CLASE_SITIO"    "ARMA_EMPLEADA"  "MOVIL_AGRESOR"  "MOVIL_VICTIMA" 
## [13] "EDAD"           "SEXO"           "ESTADO_CIVIL"   "PAIS_NACE"     
## [17] "CLASE_EMPLEADO" "PROFESION"      "ESCOLARIDAD"    "CODIGO_DANE"
DELITOS_BOGOTA %>% 
  select(ARMA_EMPLEADA, MUNICIPIO, TEMATICA) %>% 
  group_by(ARMA_EMPLEADA) %>%
  summarise(CANTIDAD = n()) %>% 
  mutate(ARMA = ifelse(ARMA_EMPLEADA %in% c("ARMA BLANCA", "ARMA BLANCA / CORTOPUNZANTE","CORTANTES","PUNZANTES","CORTOPUNZANTES","ARMAS BLANCAS","CUCHILLA"), "Arma Blanca", ifelse(ARMA_EMPLEADA=="ARMA DE FUEGO","Arma de Fuego",ifelse(ARMA_EMPLEADA=="SIN EMPLEO DE ARMAS","Sin Empleo de Armas","Otra") )) ) %>% 
  arrange(desc(CANTIDAD)) -> Delitos_por_Arma

head(Delitos_por_Arma)
## # A tibble: 6 × 3
##   ARMA_EMPLEADA               CANTIDAD ARMA               
##   <chr>                          <int> <chr>              
## 1 CONTUNDENTES                   35924 Otra               
## 2 SIN EMPLEO DE ARMAS            35322 Sin Empleo de Armas
## 3 ARMA DE FUEGO                  11840 Arma de Fuego      
## 4 ARMA BLANCA                    10571 Arma Blanca        
## 5 ARMA BLANCA / CORTOPUNZANTE     5354 Arma Blanca        
## 6 NO REPORTADO                    1869 Otra

4.2. Calcule la proporción de delitos cometidos en Bogotá, por cada tipo de arma empleada. Para eso, utilice la clasificación obtenida en el punto anterior.

#attach(DELITOS_BOGOTA)

DELITOS_BOGOTA <- mutate(DELITOS_BOGOTA, ARMA = ifelse(ARMA_EMPLEADA %in% c("ARMA BLANCA", "ARMA BLANCA / CORTOPUNZANTE","CORTANTES","PUNZANTES","CORTOPUNZANTES","ARMAS BLANCAS","CUCHILLA"), "Arma Blanca", ifelse(ARMA_EMPLEADA=="ARMA DE FUEGO","Arma de Fuego",ifelse(ARMA_EMPLEADA=="SIN EMPLEO DE ARMAS","Sin Empleo de Armas","Otra") )) )

xtabs(~ ARMA , data = DELITOS_BOGOTA) -> tabla1; tabla1
## ARMA
##         Arma Blanca       Arma de Fuego                Otra Sin Empleo de Armas 
##               17179               11840               40124               35322
round(100*prop.table(tabla1),2) -> tabla2

etiquetas <- rownames(tabla2)

install.packages("plotrix", DEP=T)
library(plotrix)

etiquetas <- paste(rownames(tabla2), " (", tabla2, "%)", sep = "")

pie3D(tabla2, labels = etiquetas, border = "grey", explode = 0.1,
      main = "BOGOTA - Proporción Delitos por Tipo de Arma Empleada", shade = 0.8, labelcex = 0.9,
      labelcol = "black", col = colorRampPalette(c("white", "blue"))(4))

4.3. Realice una tabla cruzada que contemple las variables sexo y el tipo de delito. ¿Cuál es la proporción de víctimas por tipo para cada sexo?

DELITOS_BOGOTA %>% 
  filter(SEXO %in% c("MASCULINO","FEMENINO")) %>%
  group_by(TEMATICA) %>% 
  summarise(Cantidad = n(),
            hombres=sum(SEXO=="MASCULINO"),
            mujeres=sum(SEXO=="FEMENINO"),
            porcentaje_hombres=round(hombres/Cantidad*100,2),
            porcentaje_mujeres=round(mujeres/Cantidad*100,2)) -> tema_sexo_bogota 
tema_sexo_bogota
## # A tibble: 12 × 6
##    TEMATICA           Cantidad hombres mujeres porcentaje_homb… porcentaje_muje…
##    <chr>                 <int>   <int>   <int>            <dbl>            <dbl>
##  1 ABIGEATO                 30      27       3             90               10  
##  2 AMENAZA                3080    1494    1586             48.5             51.5
##  3 CABEZA DE GANADO         58      40      18             69.0             31.0
##  4 DELITOS SEXUALES       4583     611    3972             13.3             86.7
##  5 EXTORCIÓN               573     387     186             67.5             32.5
##  6 HOMICIDIOS             2754    2454     300             89.1             10.9
##  7 HURTO A PERSONAS      53408   35370   18038             66.2             33.8
##  8 HURTO A RESIDENCI…    12178    6351    5827             52.2             47.8
##  9 LESIONES PERSONAL…    20123   11895    8228             59.1             40.9
## 10 PIRATERIA TERREST…       52      52       0            100                0  
## 11 SECUESTRO                53      32      21             60.4             39.6
## 12 VIOLENCIA INTRAFA…     7490    1273    6217             17               83

4.4.Realice diagramas de caja donde se evidencie la comparación de la distribución de las edades y el tipo de arma empleada en los delitos.

DELITOS_BOGOTA %>% 
  filter(EDAD != "NO REPORTADO" & EDAD != "-" & EDAD != "NO REPORTADA" & EDAD != "NO REPORTADO1" & EDAD != "" ) -> Bogota_Edad

table(Bogota_Edad$EDAD)
## 
##    0    1   10   11   12   13   14   15   16   17   18   19    2   20   21   22 
##   14   48  227  271  413  586  725  867 1051 1361 1822 2205  125 2481 2614 2875 
##   23   24   25   26   27   28   29    3   30   31   32   33   34   35   36   37 
## 3134 3198 3807 3454 3261 3449 3475  171 3596 2897 3376 2906 2816 3097 2702 2318 
##   38   39    4   40   41   42   43   44   45   46   47   48   49    5   50   51 
## 2112 1993  167 2224 1894 1757 1646 1701 1908 1527 1446 1425 1361  175 1321 1179 
##   52   53   54   55   56   57   58   59    6   60   61   62   63   64   65   66 
## 1170 1046 1032  963  867  743  693  657  170  599  586  497  457  453  361  332 
##   67   68   69    7   70   71   72   73   74   75   76   77   78   79    8   80 
##  275  289  270  182  226  190  184  145  148  153  120  110   93   85  209   78 
##   81   82   83   84   85   86   87   88   89    9   90   91   93   94   95 
##   57   57   47   26   30   24   20   13   10  219    4    6    2    1    4
boxplot(as.numeric(Bogota_Edad$EDAD) ~ Bogota_Edad$ARMA, 
        horizontal = FALSE,
        main=" Diagrama de Cajas de Edad de la víctima frente al arma empleada "
        ,xlab = "Tipo de Arma ", ylab = "Edad "
        #, col = c("darkslategray4","darkslategray3","darkslategray2", "darkslategray1")
        ,col = brewer.pal(10, "Set3")
        )

La edad de las victimas se concentra entre los los 20 y los 45 años con una media promedio cercana a los 30 años de edad.

Los delitos cometidos “Sin empleo de Arma” tienen una mayor concentración en edades superiores a los 30 años con un mayor rango intercuartilico que los demas delitos, alcanzando los 75 años.

Se presenta una serie de datos atipicos en la edad de las victimas que es constante en cualquier tipo de arma empleada.

Ejercicio 2

La generación y consolidación de ventajas competitivas al interior de una empresa guarda una estrecha relación con las condiciones de su entorno. Tales condiciones resultan importantes no sólo para la generación de valor en el nivel individual de la firma, sino también inciden en los procesos de generación de riqueza de sociedades enteras. El concepto de cadena productiva ofrece un marco conceptual útil para la articulación de diferentes unidades empresariales de cara al proceso de generación de valor y el papel que cumple cada una de las empresas que intervienen en el mismo. Para este estudio, trabajaremos con la cadena productiva rural.

Tome las bases de Cadena Productiva y Cultivos ilícitos, reestructure estos conjuntos de datos para:

install.packages("tidyverse")
library(tidyverse)
library(readxl)

#setwd(choose.dir())

ilicitos_1 <- read.csv2("Cultivos Ilícitos.csv", encoding="UTF-8")
summary(ilicitos_1)
##  Departamento        Municipio            Cod.DANE         X2001        
##  Length:257         Length:257         Min.   : 5031   Min.   :    0.0  
##  Class :character   Class :character   1st Qu.:15531   1st Qu.:    0.0  
##  Mode  :character   Mode  :character   Median :27600   Median :   17.0  
##                                        Mean   :40355   Mean   :  563.5  
##                                        3rd Qu.:68020   3rd Qu.:  222.0  
##                                        Max.   :99773   Max.   :12677.0  
##      X2002             X2003            X2004            X2005       
##  Min.   :    0.0   Min.   :   0.0   Min.   :   0.0   Min.   :   0.0  
##  1st Qu.:    0.0   1st Qu.:   0.0   1st Qu.:   0.0   1st Qu.:   0.0  
##  Median :   17.0   Median :  32.0   Median :  40.0   Median :  38.0  
##  Mean   :  397.2   Mean   : 335.9   Mean   : 312.6   Mean   : 333.7  
##  3rd Qu.:  195.0   3rd Qu.: 230.0   3rd Qu.: 260.0   3rd Qu.: 253.0  
##  Max.   :14606.0   Max.   :6673.0   Max.   :6393.0   Max.   :7599.0  
##      X2006     
##  Min.   :   0  
##  1st Qu.:   2  
##  Median :  34  
##  Mean   : 303  
##  3rd Qu.: 237  
##  Max.   :7045
head(ilicitos_1,10)
##    Departamento        Municipio Cod.DANE X2001 X2002 X2003 X2004 X2005 X2006
## 1      AMAZONAS       El Encanto    91263   206   264   164   270   382   233
## 2      AMAZONAS      La Chorrera    91405    65   236   209   271   257   223
## 3      AMAZONAS    Mirití Paraná    91460     6    43    36    30    12     4
## 4      AMAZONAS   Puerto Alegría    91530   222   195   173   174   210   202
## 5      AMAZONAS     Puerto Arica    91536     0     1     6     0     0     0
## 6      AMAZONAS Puerto Santander    91669    33    44    37    38    36    30
## 7     ANTIOQUIA           Amalfi     5031    31   110    74   173   210   342
## 8     ANTIOQUIA            Anorí     5040   188   369   614   753   759   836
## 9     ANTIOQUIA          Argelia     5055     0     0     4    21    21    15
## 10    ANTIOQUIA          Briceño     5107    20    17    20    54   115    44
names(ilicitos_1)
## [1] "Departamento" "Municipio"    "Cod.DANE"     "X2001"        "X2002"       
## [6] "X2003"        "X2004"        "X2005"        "X2006"
colnames(ilicitos_1) = c("Departamento","Municipio","Cod_DANE","X2001","X2002"       
                         ,"X2003","X2004","X2005","X2006")

library(tidyverse)
library(readxl)
ilicitos_2 <- read_excel("Cultivos Ilicitos 2015-2019.xlsx" ) #, encoding="UTF-8")
summary(ilicitos_2)
##    CODDEPTO         DEPARTAMENTO         CODMPIO           MUNICIPIO        
##  Length:210         Length:210         Length:210         Length:210        
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##                                                                             
##       2015               2016               2017               2018         
##  Min.   :    1.04   Min.   :    1.76   Min.   :    1.16   Min.   :    1.51  
##  1st Qu.:   12.36   1st Qu.:   17.45   1st Qu.:   24.28   1st Qu.:   19.58  
##  Median :   69.30   Median :  140.03   Median :  199.69   Median :  227.25  
##  Mean   :  500.44   Mean   :  798.58   Mean   :  922.02   Mean   :  903.84  
##  3rd Qu.:  346.28   3rd Qu.:  716.23   3rd Qu.:  958.22   3rd Qu.:  869.77  
##  Max.   :16960.24   Max.   :23147.95   Max.   :19516.93   Max.   :16096.74  
##  NA's   :18         NA's   :27         NA's   :24         NA's   :23        
##       2019         
##  Min.   :    1.07  
##  1st Qu.:   20.93  
##  Median :  179.37  
##  Mean   :  877.70  
##  3rd Qu.:  760.43  
##  Max.   :19892.71  
##  NA's   :34
tail(ilicitos_2,10)
## # A tibble: 10 × 9
##    CODDEPTO DEPARTAMENTO   CODMPIO MUNICIPIO `2015` `2016`  `2017` `2018` `2019`
##    <chr>    <chr>          <chr>   <chr>      <dbl>  <dbl>   <dbl>  <dbl>  <dbl>
##  1 68       SANTANDER      68861   VÉLEZ       2.03  NA      NA     NA      NA  
##  2 76       VALLE DEL CAU… 76100   BOLÍVAR    16.2   31.2    75.4   80.8    17.4
##  3 76       VALLE DEL CAU… 76109   BUENAVEN… 628.   680.   1030.   987.    918. 
##  4 76       VALLE DEL CAU… 76126   CALIMA (…  24.4   33.6    43.6   44.9    14.5
##  5 76       VALLE DEL CAU… 76233   DAGUA       3.14   3.03   45.8   36.6    58.6
##  6 76       VALLE DEL CAU… 76364   JAMUNDÍ    18.4    3.64   61.6  117.   1320. 
##  7 76       VALLE DEL CAU… 76834   TULUÁ      NA     NA       4.75   4.02   NA  
##  8 97       VAUPÉS         97161   CARURÚ     31.0   96.7   105.    64.7    26.0
##  9 97       VAUPÉS         97001   MITÚ        1.61  NA      NA     NA      NA  
## 10 99       VICHADA        99773   CUMARIBO  683.   699.    653.   550.    245.
library(dplyr)      # manipulaci?n de datos
library(magrittr)

# Verifica datos incompletos
ilicitos_1[!complete.cases(ilicitos_1), ] 
## [1] Departamento Municipio    Cod_DANE     X2001        X2002       
## [6] X2003        X2004        X2005        X2006       
## <0 rows> (or 0-length row.names)
sum( !complete.cases(ilicitos_1) )
## [1] 0
# Datos completos

# Verifica datos incompletos
ilicitos_2[!complete.cases(ilicitos_2), ] 
## # A tibble: 50 × 9
##    CODDEPTO DEPARTAMENTO CODMPIO MUNICIPIO    `2015` `2016` `2017` `2018` `2019`
##    <chr>    <chr>        <chr>   <chr>         <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
##  1 05       ANTIOQUIA    05154   CAUCASIA      NA      5.89  NA      2.25  NA   
##  2 05       ANTIOQUIA    05172   CHIGORODÓ     NA     10.4    6.94   5.31   6.37
##  3 05       ANTIOQUIA    05475   MURINDÓ       NA     NA     NA     NA      1.52
##  4 05       ANTIOQUIA    05480   MUTATÁ         1.18  NA      6.65   3.49   1.21
##  5 05       ANTIOQUIA    05649   SAN CARLOS     1.44   1.76  NA     NA     NA   
##  6 05       ANTIOQUIA    05756   SONSÓN         2.7    2.32  NA     NA     NA   
##  7 05       ANTIOQUIA    05819   TOLEDO        NA     NA     NA      3.44  NA   
##  8 05       ANTIOQUIA    05858   VEGACHÍ       NA     NA     36.4   42.3   31.6 
##  9 05       ANTIOQUIA    05893   YONDÓ (Casa…   3.08  NA      4.58   6.5   14.7 
## 10 81       ARAUCA       81065   ARAUQUITA      9.12   6.34 117.     7.44  NA   
## # … with 40 more rows
sum( !complete.cases(ilicitos_2) )
## [1] 50
# Datos INcompletos
# imputamos? como?
#

# Cargar DATOS de CADENA PRODUCTIVA
cadena_productiva <- read_excel("Cadena_Productiva.xlsx" , sheet = "in") 
summary(cadena_productiva)
##  Codigo Departamento DEPARTAMENTO       Codigo de Municipio  MUNICIPIO        
##  Min.   : 5.00       Length:58384       Min.   : 5001       Length:58384      
##  1st Qu.:17.00       Class :character   1st Qu.:17524       Class :character  
##  Median :41.00       Mode  :character   Median :41206       Mode  :character  
##  Mean   :40.13                          Mean   :40553                         
##  3rd Qu.:68.00                          3rd Qu.:68162                         
##  Max.   :99.00                          Max.   :99773                         
##                                                                               
##  GRUPO DE CULTIVO   SUBGRUPO DE CULTIVO   CULTIVO         
##  Length:58384       Length:58384        Length:58384      
##  Class :character   Class :character    Class :character  
##  Mode  :character   Mode  :character    Mode  :character  
##                                                           
##                                                           
##                                                           
##                                                           
##  DESAGREGACION REGIONAL Y/O SISTEMA PRODUCTIVO CODIGO CULTIVO     
##  Length:58384                                  Min.   :1.110e+11  
##  Class :character                              1st Qu.:1.110e+11  
##  Mode  :character                              Median :1.110e+11  
##                                                Mean   :1.115e+11  
##                                                3rd Qu.:1.120e+11  
##                                                Max.   :1.121e+11  
##                                                                   
##  NOMBRE CIENTIFICO     PERIODO2    Area Sembrada(ha) Area Cosechada(ha)
##  Length:58384       Min.   :2006   Min.   :    0     Min.   :    0.0   
##  Class :character   1st Qu.:2009   1st Qu.:   34     1st Qu.:   27.0   
##  Mode  :character   Median :2011   Median :  120     Median :  100.0   
##                     Mean   :2011   Mean   :  493     Mean   :  433.5   
##                     3rd Qu.:2013   3rd Qu.:  426     3rd Qu.:  370.0   
##                     Max.   :2015   Max.   :21743     Max.   :21092.0   
##                                                                        
##    Produccion     Rendimiento(t/ha) ESTADO FISICO PRODUCCION
##  Min.   :     0   Min.   : 0.000    Length:58384            
##  1st Qu.:    65   1st Qu.: 1.200    Class :character        
##  Median :   302   Median : 3.000    Mode  :character        
##  Mean   :  2316   Mean   : 5.363                            
##  3rd Qu.:  1320   3rd Qu.: 7.900                            
##  Max.   :472833   Max.   :95.000                            
##                   NA's   :728
names(cadena_productiva)
##  [1] "Codigo Departamento"                          
##  [2] "DEPARTAMENTO"                                 
##  [3] "Codigo de Municipio"                          
##  [4] "MUNICIPIO"                                    
##  [5] "GRUPO DE CULTIVO"                             
##  [6] "SUBGRUPO DE CULTIVO"                          
##  [7] "CULTIVO"                                      
##  [8] "DESAGREGACION REGIONAL Y/O SISTEMA PRODUCTIVO"
##  [9] "CODIGO CULTIVO"                               
## [10] "NOMBRE CIENTIFICO"                            
## [11] "PERIODO2"                                     
## [12] "Area Sembrada(ha)"                            
## [13] "Area Cosechada(ha)"                           
## [14] "Produccion"                                   
## [15] "Rendimiento(t/ha)"                            
## [16] "ESTADO FISICO PRODUCCION"
colnames(cadena_productiva) = c("Codigo_Departamento"                          
                      ,"DEPARTAMENTO"                                 
                      ,"Codigo_Municipio"                          
                      ,"MUNICIPIO"                                    
                      ,"GRUPO_CULTIVO"                             
                      ,"SUBGRUPO_CULTIVO"                          
                      ,"CULTIVO"
                      ,"DESAGREGACION_REGIONAL_o_SISTEMA_PRODUCTIVO"
                      ,"CODIGO_CULTIVO"                               
                      ,"NOMBRE_CIENTIFICO"                            
                      ,"PERIODO2"                                     
                      ,"Area_Sembrada"                            
                      ,"Area_Cosechada"                           
                      ,"Produccion"                                   
                      ,"Rendimiento(t/ha)"                            
                      ,"ESTADO_FISICO_PRODUCCION"     )

* Obtener una base de datos por municipios que discrimine la producción, en términos de área sembrada y cosechada, por grupos de cultivos para los años 2007-2015. Plantee gráficos de línea para evaluar el crecimiento o decrecimiento de cada uno de los grupos.

cadena_productiva %>% 
  filter(PERIODO2 %in% list("2007","2008","2009","2010","2011","2012","2013","2014","2015")) %>% 
  group_by (MUNICIPIO, GRUPO_CULTIVO, PERIODO2) %>% 
  summarise(cantidad = n(), 
            Sembrada = sum(Area_Sembrada), 
            Cosechada = sum(Area_Cosechada)
            #,na.rm = TRUE
             ) -> produccion_cultivos_2007_2015 
head(produccion_cultivos_2007_2015,10)
## # A tibble: 10 × 6
## # Groups:   MUNICIPIO, GRUPO_CULTIVO [2]
##    MUNICIPIO GRUPO_CULTIVO PERIODO2 cantidad Sembrada Cosechada
##    <chr>     <chr>            <dbl>    <int>    <dbl>     <dbl>
##  1 ABEJORRAL CEREALES          2007        2     1283      1240
##  2 ABEJORRAL CEREALES          2008        2     1213      1160
##  3 ABEJORRAL CEREALES          2009        2     1170      1130
##  4 ABEJORRAL CEREALES          2010        2      350       350
##  5 ABEJORRAL CEREALES          2011        2      449       435
##  6 ABEJORRAL CEREALES          2012        2      300       300
##  7 ABEJORRAL CEREALES          2013        2      450       450
##  8 ABEJORRAL CEREALES          2014        2      600       600
##  9 ABEJORRAL CEREALES          2015        1      200       200
## 10 ABEJORRAL FRUTALES          2007        1       96        83

Se presentan las series de tiempo de los cultivos sembrados y cosechados:

# Resumen por grupo de cultivos 
produccion_cultivos_2007_2015 %>% 
  group_by (GRUPO_CULTIVO, PERIODO2) %>% 
  summarise(SEM=sum(Sembrada), COS=sum(Cosechada)) -> grupo_cultivo_periodo

library(RColorBrewer)

# Grafica para SEMBRADAS

ggplot(grupo_cultivo_periodo, aes(x=grupo_cultivo_periodo$PERIODO2, y=grupo_cultivo_periodo$SEM, color = GRUPO_CULTIVO)) +
  geom_line()+ geom_point( size=2, shape=21, fill="white")+ theme(axis.text.x = element_text(angle = 90,size=8))+
  labs(title="Area SEMBRADA por Grupo de Cultivo",
       x="Año", 
       y="Area Sembrada")

# Grafica para COSECHADAS
ggplot(grupo_cultivo_periodo, aes(x=grupo_cultivo_periodo$PERIODO2, y=grupo_cultivo_periodo$COS, color = GRUPO_CULTIVO)) +
  geom_line()+ geom_point( size=2, shape=21, fill="white")+ theme(axis.text.x = element_text(angle = 90,size=8))+
  labs(title="Area COSECHADA por Grupo de Cultivo",
       x="Año", 
       y="Area Cosechada")

Se evidencia una disminución importante en las áreas sembradas y cosechadas de cereales a partir del año 2013 que contrasta frente a los demás grupos de cultivos que mantienen su proporción de sembrados y cosechados en el tiempo.

* Haga un cruce de las bases de datos (join o merge). Una de ellas es la asociada a los Cultivos ilícitos y otra que fue obtenida en el punto anterior y calcule el porcentaje de cultivos ilícitos para cada municipio en 2015 Total Cultivos ilícitos.

ilicitos_2 %>% 
  select(CODMPIO,MUNICIPIO, ilicitos_2_2015="2015")-> Ilicitos_2015

# Ajustamos codigos de municipio en BD de cadena_productiva

#View(cadena_productiva)
cadena_productiva %>% 
  mutate(Codigo_Municipio = ifelse(nchar(cadena_productiva$Codigo_Municipio)==4,
                                       paste0("0",(cadena_productiva$Codigo_Municipio)),
                                   cadena_productiva$Codigo_Municipio))-> cadena_productiva

# Asigna 0 a los codigos que tienen 4 digitos para asegurar el cruce por codigo de municipio  

cadena_productiva%>% 
  select(Codigo_Municipio,PERIODO2,Area_Sembrada)%>%
  filter(PERIODO2 %in% c("2015")) %>%
  group_by(Codigo_Municipio) %>%
  summarise(Cultivos_Licitos_2015 = sum(Area_Sembrada[PERIODO2==2015])) -> Cultivos_Licitos_2015


names (Cultivos_Licitos_2015) = c("CODMPIO", "Cultivos_Licitos_2015")

### Cruce de bases de datos de cultivos ilicitos_2015 y Cultivos_Licitos_2015

cruce_cultivos <- merge(x = Ilicitos_2015, y = Cultivos_Licitos_2015, by = c("CODMPIO"))

cruce_cultivos[is.na(cruce_cultivos)] <- 0

cruce_cultivos  %>%
  mutate(proporcion_ilicitos_2015 = ilicitos_2_2015/( ilicitos_2_2015 + Cultivos_Licitos_2015 )) -> cruce_cultivos

tail(cruce_cultivos,10)
##     CODMPIO                          MUNICIPIO ilicitos_2_2015
## 196   86865     VALLE DEL GUAMUEZ (La Hormiga)         3660.05
## 197   86885                        VILLAGARZÓN         1131.39
## 198   94343 BARRANCO MINA (Cor. Departamental)            4.34
## 199   95001              SAN JOSÉ DEL GUAVIARE         1501.04
## 200   95015                            CALAMAR          455.19
## 201   95025                         EL RETORNO         1615.35
## 202   95200                         MIRAFLORES         1851.54
## 203   97001                               MITÚ            1.61
## 204   97161                             CARURÚ           31.03
## 205   99773                           CUMARIBO          683.14
##     Cultivos_Licitos_2015 proporcion_ilicitos_2015
## 196                  1484              0.711511358
## 197                   473              0.705183902
## 198                   790              0.005463655
## 199                  6619              0.184856232
## 200                  2521              0.152943864
## 201                  4245              0.275640533
## 202                  2024              0.477750197
## 203                   517              0.003104452
## 204                   404              0.071328414
## 205                  4639              0.128358142

* Después haga un gráfico de barras con los 20 municipios con mayor porcentaje de cultivos ilícitos y saque conclusiones.

top_n(cruce_cultivos, 20, cruce_cultivos$proporcion_ilicitos_2015) %>%
  arrange(desc(proporcion_ilicitos_2015)) -> municipios_top_20  

par(mar = c(5, 4, 4, 2) + 0.1)
barplot(municipios_top_20$proporcion_ilicitos_2015, 
        #xlab = "Municipio", 
        ylab = "%", 
        cex.names = 0.4,
        cex.axis = 0.4, # Eje de las X
        ylim = c(0,1), 
        las = 2,
        names.arg = municipios_top_20$MUNICIPIO, 
        #angle = 45,
        horiz = FALSE,
        border = "thistle1", col = brewer.pal(10, "Set3"), main = "Top 20 de Municipios con mayor Proporción de cultivos ilícitos en 2015")

Estos 20 municipios tienen una proporción superior al 40% de cultivos ilicitos en sus areas sembradas. Es evidente que son municipios enterritorios alejados que han sido impulsados a favorecer la siembra de cultivos ilicitos frente a los cultivos que seguramente no tienen un incentivo economico equivalente.

El 60% (12) de estos municipios están por encima del 60% de particpación en cultivos ilicitos.