ESTADISTICAS MUNICIPALES EN ARAUCA

SE ELIMINA EL CONTENIDO DE LA MEMORIA.

rm(list=ls())

INSTALAMOS LAS BIBLIOTECAS NECESARIAS PARA EL TRABAJO.

list.of.packages <- c("here", "tidyverse", "rgeos", "maptools", "raster", "sf",  "viridis", "rnaturalearth", "GSODR", "ggrepel", "cowplot")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)

SE LLAMAN LAS BIBLIOTECAS.

library(here)

library(tidyverse)

library(rgeos)

library(maptools)

library(raster)

library(sf)

library(viridis)

library(rnaturalearth)
library(GSODR)
library(ggrepel)
library(cowplot)

SE LEEN LOS DATOS DE LAS EVALUACIONES AGROPECUARIAS EN CSV PARA ARAUCA.

datosARAUCA <- read_csv("C:/Users/Lina Maria Ayala.LinaMariaAyala/Documents/R/TRABAJOS GEOMATICA/ARAUCA/Evaluaciones_Agropecuarias_Municipales_EVA.csv")

SE MIRA QUE CONTIENEN ESTOS DATOS.

head(datosARAUCA)

tail(datosARAUCA)

SE OBTIENE EL RENDIMIENTO DE LOS CULTIVOS POR MUNICIPIO.

datosARAUCA %>%
  group_by(MUNICIPIO, GRUPO) %>%
  summarise(rend_prom = mean(Rendimiento, na.rm = TRUE)) -> rend_resumen
head(rend_resumen)

SE CALCULA RENDIMIENTO PREOMEDIO POR GRUPO EN LOS MUNICIPIOS DE ARAUCA.

datosARAUCA %>%
  group_by(GRUPO) %>%
  summarise(rend_dep = mean(Rendimiento, na.rm = TRUE)) -> rend_ARAUCA

rend_ARAUCA

SE OBSERVA QUE LOS CULTIVOS CON MAYOR RENDIMIENTO SON LOS FRUTALES,TUBERCULOS Y PLATANO, AROMATICAS Y MEDICIONALES. SE CALCULA LOS MUNICIPIOS CON MAYOR RENDIMIENTO POR GRUPO PARA EL AÑO 2018.

datosARAUCA %>%
  filter(YEAR==2018) %>% 
  group_by(GRUPO, MUNICIPIO) %>%
  summarize(max_rend = max(Rendimiento, na.rm = TRUE)) %>%
    slice(which.max(max_rend)) -> Rend_Max_18

Rend_Max_18

SE PUEDE OBSERVAR QUE EL MUNICIPIO CON MAS RENDIMIENTO ES TAME. SE CALCULA EL MUNICIPIO CON MAYOR AREA COSECHADA PARA EL AÑO 2018.

datosARAUCA %>% 
  filter(YEAR==2018) %>% 
  group_by(GRUPO, MUNICIPIO) %>%
  summarize(max_area_cosecha = max(Area_Cosecha, na.rm = TRUE)) %>%
    slice(which.max(max_area_cosecha)) -> Area_Cosecha_Max

Area_Cosecha_Max

SE PUEDE EVIDENCIAR QUE EL MUNICIPIO CON MAYOR AREA COSECHADA ES TAME CON EL CULTIVO DE TUBERCULOS Y PLATANOS. SE PUEDE ENTONCES DEDUCIR QUE ESTE MUNICIPIO TINE SU ECONOMIA A BASE DEL PLATANO, TAME ES CONCIDERADO COMO EL MUNICIPIO QUE MAS PLATANO PRODUCE EN EL PAIS.

SE CALCULA LA PRODUCCION DE PLATANO DEL MUNICIPIO EN TONELADAS PARA CADA AÑO.

datosARAUCA %>% 
  filter(MUNICIPIO=="TAME" & SUBGRUPO=="PLATANO") %>% 
  group_by(YEAR, CULTIVO) ->  TAM_PLATANO

TAM_PLATANO

SE GRAFICAN LOS DATOS.

g <- ggplot(aes(x=YEAR, y=Produccion/1000), data = TAM_PLATANO) + geom_bar(stat='identity') + labs(y='PRODUCCION DE PLATANO [Ton x 1000]')

g + ggtitle("EVOLUCION DE LA PRODUCCION DE PLATANO ENTRE EL AÑO 2007 Y 2018 EN TAME") + labs(caption= "Basado en datos de EMA (DANE, 2018)")

CULTIVOS CON MAYOR AREA COSECHADA PARA EL 2018.

datosARAUCA %>% 
  filter(YEAR==2018) %>% 
  group_by(GRUPO) %>%
  summarize(sum_area_cosecha = sum(Area_Cosecha, na.rm = TRUE)) %>%
     arrange(desc(sum_area_cosecha)) -> Total_Area_Cosecha

Total_Area_Cosecha

SE PUEDE EVIDENCIAR QUE EL GRUPO DE TUBERCULOS Y PLATANOS TIENE EL MAYOR AREA COSECHADA EN ARAUCA EN EL 2018. MIREMOS QUE CULTIVOS PERTENECEN A ESTE GRUPO.

datosARAUCA %>%
  filter(GRUPO=="TUBERCULOS Y PLATANOS" & YEAR==2018) %>%
  group_by(CULTIVO) %>%
  summarize(sum_cosecha = sum(Area_Cosecha, na.rm = TRUE)) %>%
     arrange(desc(sum_cosecha)) -> Total_Cosecha


Total_Cosecha

PODEMOS DENOTAR DE NUEVO QUE EL CULTIVO DEL PLATANO ES LA BASE DE LA ECONOMIA ARAUCANA. SE BUSCA LOS MUNICIPIOS QUE MAYOR AREA CPSECHADA TIENEN DE LOS CULTIVOS DE ESTE GRUPO EN 2018.

datosARAUCA %>% 
  filter(YEAR==2018 & GRUPO=="TUBERCULOS Y PLATANOS") %>% 
  group_by(CULTIVO, MUNICIPIO) %>%
  summarize(max_area2 = max(Area_Cosecha, na.rm = TRUE)) %>%
    slice(which.max(max_area2)) -> Area_Cosecha2

Area_Cosecha2

NA

SE AGREGA UNA ABREVIATURA PARA CADA AGRUPO DE CULTIVOS PARA TENER UN MEJOR ORDEN.

Total_Area_Cosecha$CROP <- abbreviate(Total_Area_Cosecha$GRUPO, 3)

SE GRAFICA

g <- ggplot(aes(x=CROP, y=sum_area_cosecha), data = Total_Area_Cosecha) + geom_bar(stat='identity') + labs(y='AREA TOTAL COSECHADA [Ha]')

g+ ggtitle("Superficie total cosechada por grupos de cultivos en 2018 para Antioquia") + theme(plot.title = element_text(hjust = 0.5)) +
   labs(caption= "Basado en datos de EMA (DANE, 2018)")

EMPALME DATOS ESTADISTICOS Y ADMINISTRATIVOS.

SE LEEEN LOS DATOS EN PRIMER LUGAR.

ARA_munic <- sf::st_read("C:/Users/Lina Maria Ayala.LinaMariaAyala/Documents/R/TRABAJOS GEOMATICA/ARAUCA/ADMINISTRATIVO/MGN_MPIO_POLITICO.shp")

Reading layer `MGN_MPIO_POLITICO' from data source `C:\Users\Lina Maria Ayala.LinaMariaAyala\Documents\R\TRABAJOS GEOMATICA\ARAUCA\ADMINISTRATIVO\MGN_MPIO_POLITICO.shp' using driver `ESRI Shapefile'
Simple feature collection with 7 features and 9 fields
geometry type:  POLYGON
dimension:      XY
bbox:           xmin: -72.36662 ymin: 6.036228 xmax: -69.42756 ymax: 7.104381
CRS:            4326

SE QUIERE SABER QUE ES ARA_munic.

ARA_munic

Simple feature collection with 7 features and 9 fields
geometry type:  POLYGON
dimension:      XY
bbox:           xmin: -72.36662 ymin: 6.036228 xmax: -69.42756 ymax: 7.104381
CRS:            4326
  DPTO_CCDGO MPIO_CCDGO    MPIO_CNMBR                           MPIO_CRSLC MPIO_NAREA
1         81      81001        ARAUCA                                 1959  5787.9421
2         81      81591 PUERTO RONDÓN Decreto Nal 677 de Abril 13 de  1987  2281.4291
3         81      81220   CRAVO NORTE Decreto Nal 677 de Abril 13 de  1987  5212.6908
4         81      81065     ARAUQUITA Decreto 1447 del 28 de Julio de 1971  3046.8789
5         81      81300        FORTUL                 Decreto 2926 de 1989  1158.6276
6         81      81736      SARAVENA     Decreto Nal 204 de Feb 3 de 1976   945.1354
7         81      81794          TAME                                 1959  5418.7040
  MPIO_NANO DPTO_CNMBR Shape_Leng Shape_Area                       geometry
1      2017     ARAUCA   4.668016 0.47162612 POLYGON ((-70.68038 7.09393...
2      2017     ARAUCA   2.932376 0.18593602 POLYGON ((-70.87879 6.62133...
3      2017     ARAUCA   3.963937 0.42393331 POLYGON ((-70.40276 6.64639...
4      2017     ARAUCA   3.258765 0.24864660 POLYGON ((-71.58441 7.04298...
5      2017     ARAUCA   2.056433 0.09461063 POLYGON ((-71.54473 6.75924...
6      2017     ARAUCA   1.294126 0.07721413 POLYGON ((-71.76224 7.06602...
7      2017     ARAUCA   3.938087 0.44219010 POLYGON ((-71.73216 6.70303...

SE HACE EL EMPALME DE LOS DATOS ESTADISTICOS Y ADMINISTRATIVOS. SE NECESITA UNA CARACTERISTICA EN COMUN, EN ESTE CASO EL CODIGO DEL MUNICIPIO DE SARAVENA.

datosARAUCA %>% filter (MUNICIPIO =="SARAVENA") ->  SAR_datos

SAR_datos

class(SAR_datos$COD_MUN)

[1] "numeric"

CREAMOS UNA COPIA DE LOS DATOS ORIGINALES PARA EVITAR DAÑARLOS EN CASO DE QUE ALGO SALGA MAL EN EL EMPALME.

datos2ARAUCA <- datosARAUCA

datos2ARAUCA$TEMP <-  as.character(datos2ARAUCA$COD_MUN)

SE CREA UNA COLUMNA NUEVA QUE SE ADAPTE CON LOS DATOS ADMINISTRATIVOS DEL DEPARTAMENTO Y HACER QUE LA UNION SEA POSIBLE SIN AGREGAR NINGUN ATRIBUTO NI NUMERO, PUES LOS CODIGOS DE LOS MONICIPIOS COINCIDEN EN AMBAS BASES DE DATOS.

datos2ARAUCA$MPIO_CCDGO <- as.factor(datos2ARAUCA$TEMP)

head(datos2ARAUCA)

SE VERIFICA QUE SON LOS MISMOS ATRIBUTOS.

AHORA FILTREMOS POR AÑO Y EL CULTIVO MAS REPRESENTATIVO DEL DEPARTAMENTO.

datos2ARAUCA %>% filter(CULTIVO == "PLATANO")  -> datos3ARAUCA

head(datos3ARAUCA)

class(datos3ARAUCA)

[1] "spec_tbl_df" "tbl_df"      "tbl"         "data.frame" 

datos4ARAUCA <- datos3ARAUCA %>% dplyr::select(MUNICIPIO, MPIO_CCDGO, YEAR, Produccion, Rendimiento) 

datos4ARAUCA

datos4ARAUCA %>% 
  gather("YEAR", "Produccion", "Rendimiento" , key = variable, value = number)

head(datos4ARAUCA)

datos4ARAUCA %>% 
  group_by(MPIO_CCDGO) %>% 
  mutate(Visit = 1:n()) %>% 
  gather("YEAR", "Produccion", "Rendimiento", key = variable, value = number) %>% 
  unite(combi, variable, Visit) %>%
  spread(combi, number) -> datos5ARAUCA

head(datos5ARAUCA)

tail(datos5ARAUCA)

TAMBIEN SE HARA UNA COPUA DE LA COLECCION DE CARACTERISTICAS SIMPRES, EN CASO DE COMETER UN ERROR.

ARA_munic2 <- ARA_munic

SE HARA LA UNION AHORA.

ARA_munic_stat = left_join(ARA_munic2, datos5ARAUCA, by="MPIO_CCDGO")

summary(ARA_munic_stat)

 DPTO_CCDGO MPIO_CCDGO         MPIO_CNMBR                                MPIO_CRSLC
 81:7       81001:1    ARAUCA       :1    1959                                :2   
            81065:1    ARAUQUITA    :1    Decreto 1447 del 28 de Julio de 1971:1   
            81220:1    CRAVO NORTE  :1    Decreto 2926 de 1989                :1   
            81300:1    FORTUL       :1    Decreto Nal 204 de Feb 3 de 1976    :1   
            81591:1    PUERTO RONDÓN:1    Decreto Nal 677 de Abril 13 de  1987:2   
            81736:1    SARAVENA     :1                                             
            81794:1    TAME         :1                                             
   MPIO_NAREA       MPIO_NANO     DPTO_CNMBR   Shape_Leng      Shape_Area     
 Min.   : 945.1   Min.   :2017   ARAUCA:7    Min.   :1.294   Min.   :0.07721  
 1st Qu.:1720.0   1st Qu.:2017               1st Qu.:2.494   1st Qu.:0.14027  
 Median :3046.9   Median :2017               Median :3.259   Median :0.24865  
 Mean   :3407.3   Mean   :2017               Mean   :3.159   Mean   :0.27774  
 3rd Qu.:5315.7   3rd Qu.:2017               3rd Qu.:3.951   3rd Qu.:0.43306  
 Max.   :5787.9   Max.   :2017               Max.   :4.668   Max.   :0.47163  
                                                                              
  MUNICIPIO          Produccion_1   Produccion_10    Produccion_11    Produccion_12   
 Length:7           Min.   :  390   Min.   :   780   Min.   :  1512   Min.   :  2052  
 Class :character   1st Qu.: 2250   1st Qu.:  6750   1st Qu.:  3998   1st Qu.:  5545  
 Mode  :character   Median : 6680   Median : 36486   Median : 36894   Median : 58540  
                    Mean   :13467   Mean   : 77439   Mean   : 95359   Mean   :103462  
                    3rd Qu.:13850   3rd Qu.: 67654   3rd Qu.: 75361   3rd Qu.: 78315  
                    Max.   :55000   Max.   :356000   Max.   :470391   Max.   :495925  
                                                                                      
  Produccion_2    Produccion_3     Produccion_4     Produccion_5     Produccion_6   
 Min.   :  442   Min.   :   507   Min.   :   520   Min.   :   225   Min.   :   300  
 1st Qu.: 2949   1st Qu.:  3780   1st Qu.:  4036   1st Qu.:  6120   1st Qu.:  8230  
 Median :16402   Median : 21970   Median : 22400   Median : 21250   Median : 32500  
 Mean   :19660   Mean   : 31034   Mean   : 42710   Mean   : 47745   Mean   : 54923  
 3rd Qu.:17190   3rd Qu.: 26750   3rd Qu.: 28988   3rd Qu.: 31250   3rd Qu.: 40200  
 Max.   :80500   Max.   :133704   Max.   :210000   Max.   :238000   Max.   :254800  
                                                                                    
  Produccion_7     Produccion_8     Produccion_9    Rendimiento_1   Rendimiento_10 
 Min.   :   338   Min.   :   540   Min.   :   560   Min.   :6.000   Min.   :10.00  
 1st Qu.:  8985   1st Qu.:  7600   1st Qu.:  7030   1st Qu.:6.750   1st Qu.:14.00  
 Median : 30940   Median : 33600   Median : 48080   Median :7.900   Median :18.00  
 Mean   : 55028   Mean   : 58386   Mean   : 61150   Mean   :7.483   Mean   :16.29  
 3rd Qu.: 36530   3rd Qu.: 53680   3rd Qu.: 58032   3rd Qu.:8.240   3rd Qu.:19.00  
 Max.   :262885   Max.   :252000   Max.   :249284   Max.   :8.500   Max.   :20.00  
                                                                                   
 Rendimiento_11  Rendimiento_12  Rendimiento_2    Rendimiento_3   Rendimiento_4  
 Min.   :13.00   Min.   :13.00   Min.   : 6.000   Min.   : 6.50   Min.   : 6.50  
 1st Qu.:19.00   1st Qu.:19.00   1st Qu.: 6.900   1st Qu.: 9.50   1st Qu.: 9.50  
 Median :22.00   Median :20.00   Median : 9.130   Median :12.00   Median :12.50  
 Mean   :20.59   Mean   :20.29   Mean   : 8.384   Mean   :10.86   Mean   :11.29  
 3rd Qu.:22.00   3rd Qu.:22.00   3rd Qu.: 9.550   3rd Qu.:12.75   3rd Qu.:13.50  
 Max.   :27.10   Max.   :27.00   Max.   :10.660   Max.   :13.00   Max.   :14.00  
                                                                                 
 Rendimiento_5   Rendimiento_6   Rendimiento_7   Rendimiento_8   Rendimiento_9  
 Min.   : 7.50   Min.   : 7.50   Min.   : 7.50   Min.   :10.00   Min.   :10.00  
 1st Qu.:10.00   1st Qu.:10.25   1st Qu.:11.00   1st Qu.:12.00   1st Qu.:12.00  
 Median :12.50   Median :12.50   Median :13.00   Median :15.00   Median :15.00  
 Mean   :11.36   Mean   :11.79   Mean   :12.14   Mean   :13.86   Mean   :13.86  
 3rd Qu.:12.75   3rd Qu.:13.50   3rd Qu.:13.75   3rd Qu.:16.00   3rd Qu.:16.00  
 Max.   :14.00   Max.   :15.00   Max.   :15.00   Max.   :16.00   Max.   :16.00  
                                                                                
     YEAR_1        YEAR_10        YEAR_11        YEAR_12         YEAR_2    
 Min.   :2007   Min.   :2016   Min.   :2017   Min.   :2018   Min.   :2008  
 1st Qu.:2007   1st Qu.:2016   1st Qu.:2017   1st Qu.:2018   1st Qu.:2008  
 Median :2007   Median :2016   Median :2017   Median :2018   Median :2008  
 Mean   :2007   Mean   :2016   Mean   :2017   Mean   :2018   Mean   :2008  
 3rd Qu.:2007   3rd Qu.:2016   3rd Qu.:2017   3rd Qu.:2018   3rd Qu.:2008  
 Max.   :2007   Max.   :2016   Max.   :2017   Max.   :2018   Max.   :2008  
                                                                           
     YEAR_3         YEAR_4         YEAR_5         YEAR_6         YEAR_7    
 Min.   :2009   Min.   :2010   Min.   :2011   Min.   :2012   Min.   :2013  
 1st Qu.:2009   1st Qu.:2010   1st Qu.:2011   1st Qu.:2012   1st Qu.:2013  
 Median :2009   Median :2010   Median :2011   Median :2012   Median :2013  
 Mean   :2009   Mean   :2010   Mean   :2011   Mean   :2012   Mean   :2013  
 3rd Qu.:2009   3rd Qu.:2010   3rd Qu.:2011   3rd Qu.:2012   3rd Qu.:2013  
 Max.   :2009   Max.   :2010   Max.   :2011   Max.   :2012   Max.   :2013  
                                                                           
     YEAR_8         YEAR_9              geometry
 Min.   :2014   Min.   :2015   POLYGON      :7  
 1st Qu.:2014   1st Qu.:2015   epsg:4326    :0  
 Median :2014   Median :2015   +proj=long...:0  
 Mean   :2014   Mean   :2015                    
 3rd Qu.:2014   3rd Qu.:2015                    
 Max.   :2014   Max.   :2015                    
                                                

GRAFICO.

INSTALAMOS PAQUETES NECESARIOS.

install.packages("RColorBrewer")
install.packages("leaflet")

SE LLAMAN LAS LIBRERIAS INSTALADAS.

library(RColorBrewer)
library(leaflet)

SE TRAZAN LOS MUNICIPIOS CON SU PRODUCCION DE PLATANO CORRESPONDIENTE PARA UN SOLO AÑO.

SE APLICAN UNOS RANGOS APTOS PARA LA PRODUCCION DEL CULTIVO PUES LAS PRODUCCIONES SON DE UN GRAN VALOR EN CUESTION DE TONELADAS, EN ESPECIAL EN EL MUNICIPIO DE TAME

bins <- c(1000, 5000, 10000, 30000, 60000, 100000, 250000, 500000)
pal <- colorBin("YlOrRd", domain = ARA_munic_stat$Produccion_12, bins = bins)

  mapa <- leaflet(data = ARA_munic_stat) %>%
  addTiles() %>%
  addPolygons(label = ~Produccion_12,
              popup = ~MPIO_CNMBR,
              fillColor = ~pal(Produccion_12),
              color = "#444444",
              weight = 1,
              smoothFactor = 0.5,
              opacity = 1.0,
              fillOpacity = 0.5,
              highlightOptions = highlightOptions(color = "white", weight = 2, bringToFront = TRUE)
              ) %>%
  addProviderTiles(providers$OpenStreetMap) %>%
  addLegend("bottomright", pal = pal, values = ~Produccion_12,
    title = "PRODUCCION DE PLATANO EN ARAUCA [Ton] (2018)",
    opacity = 1
  )

mapa

sessionInfo()

R version 3.6.3 (2020-02-29)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
[1] LC_COLLATE=Spanish_Colombia.1252  LC_CTYPE=Spanish_Colombia.1252   
[3] LC_MONETARY=Spanish_Colombia.1252 LC_NUMERIC=C                     
[5] LC_TIME=Spanish_Colombia.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] leaflet_2.0.3       RColorBrewer_1.1-2  cowplot_1.0.0       ggrepel_0.8.2      
 [5] GSODR_2.0.1         rnaturalearth_0.1.0 viridis_0.5.1       viridisLite_0.3.0  
 [9] sf_0.9-0            raster_3.0-12       maptools_0.9-9      rgeos_0.5-2        
[13] sp_1.4-1            forcats_0.5.0       stringr_1.4.0       dplyr_0.8.5        
[17] purrr_0.3.3         readr_1.3.1         tidyr_1.0.2         tibble_3.0.0       
[21] ggplot2_3.3.0       tidyverse_1.3.0     here_0.1           

loaded via a namespace (and not attached):
 [1] httr_1.4.1              jsonlite_1.6.1          modelr_0.1.6           
 [4] assertthat_0.2.1        cellranger_1.1.0        yaml_2.2.1             
 [7] pillar_1.4.3            backports_1.1.5         lattice_0.20-38        
[10] glue_1.3.2              digest_0.6.25           rvest_0.3.5            
[13] leaflet.providers_1.9.0 colorspace_1.4-1        htmltools_0.4.0        
[16] pkgconfig_2.0.3         broom_0.5.5             haven_2.2.0            
[19] scales_1.1.0            generics_0.0.2          farver_2.0.3           
[22] ellipsis_0.3.0          withr_2.1.2             cli_2.0.2              
[25] magrittr_1.5            crayon_1.3.4            readxl_1.3.1           
[28] evaluate_0.14           fs_1.4.1                fansi_0.4.1            
[31] nlme_3.1-144            xml2_1.3.1              foreign_0.8-75         
[34] class_7.3-15            tools_3.6.3             data.table_1.12.8      
[37] hms_0.5.3               lifecycle_0.2.0         munsell_0.5.0          
[40] reprex_0.3.0            compiler_3.6.3          e1071_1.7-3            
[43] rlang_0.4.5             classInt_0.4-2          units_0.6-6            
[46] grid_3.6.3              rstudioapi_0.11         htmlwidgets_1.5.1      
[49] crosstalk_1.1.0.1       base64enc_0.1-3         labeling_0.3           
[52] rmarkdown_2.1           gtable_0.3.0            codetools_0.2-16       
[55] DBI_1.1.0               R6_2.4.1                gridExtra_2.3          
[58] lubridate_1.7.8         knitr_1.28              rprojroot_1.3-2        
[61] KernSmooth_2.23-16      stringi_1.4.6           Rcpp_1.0.4             
[64] vctrs_0.2.4             dbplyr_1.4.2            tidyselect_1.0.0       
[67] xfun_0.12