Maestría en Inteligencia de Negocios - Aprendizaje Estadístico
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.
## # 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.
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)
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%.
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.
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
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
#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))
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
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.
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" )
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.
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
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.