ACP homicidios

library(FactoMineR)
library(FactoClass)
library(FactoClass)
library(factoextra)
library(corrplot)
library(rio)
Delitos <- rio::import("https://github.com/Wilsonsr/Metodos-Estadisticos/raw/main/BASES/Delitos_Colombia.csv", sep=";")

library(DT)
DT::datatable(Delitos)

rownames(Delitos)=Delitos[,1]

str(Delitos)

## 'data.frame':    33 obs. of  7 variables:
##  $ Departamento    : chr  "Antioquia" "Atlantico" "Bogota_D.C." "Bolivar" ...
##  $ Delitos_Sexuales: int  2163 1042 4211 944 517 443 221 420 561 530 ...
##  $ Homicidios      : int  375 85 1463 28 95 65 18 62 44 14 ...
##  $ Transito        : int  5079 1928 725 922 1167 1248 121 861 842 881 ...
##  $ Asalto          : int  11897 59 2725 3812 4084 2243 654 2378 2757 1716 ...
##  $ Intrafamiliar   : int  8205 3659 19811 2085 2707 975 449 1475 1402 647 ...
##  $ Poblacion       : int  6690977 2546138 8181047 2171558 1281979 993870 496262 1416145 1065637 1788648 ...

library(psych)

## 
## Attaching package: 'psych'

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

A=cor(Delitos[,c(2,3,4,5,6,7)])
corrplot(A)

library(raster)
colombia_pais <- getData(name = "GADM", country = "COL", level = 0)

## Warning in getData(name = "GADM", country = "COL", level = 0): getData will be removed in a future version of raster
## . Please use the geodata package instead

class(colombia_pais)

## [1] "SpatialPolygonsDataFrame"
## attr(,"package")
## [1] "sp"

#plot(colombia_pais)

colombia_depto <- getData(name = "GADM", country = "COL", level = 1)

## Warning in getData(name = "GADM", country = "COL", level = 1): getData will be removed in a future version of raster
## . Please use the geodata package instead

#plot(colombia_depto)

colombia_depto2 <- rio::import("https://github.com/Wilsonsr/Metodos-Estadisticos/raw/main/BASES/gadm36_COL_1_sp.rds")
#plot(colombia_depto2)

library(sf)
library(rgeos)
prueba <- st_as_sf(colombia_depto2)
head(prueba, 10)

## Simple feature collection with 10 features and 10 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -78.02388 ymin: -4.228429 xmax: -69.36835 ymax: 11.10792
## CRS:           +proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0
##    GID_0   NAME_0    GID_1    NAME_1 VARNAME_1 NL_NAME_1       TYPE_1
## 1    COL Colombia  COL.1_1  Amazonas      <NA>      <NA>    Comisaría
## 12   COL Colombia  COL.2_1 Antioquia      <NA>      <NA> Departamento
## 23   COL Colombia  COL.3_1    Arauca      <NA>      <NA>  Intendencia
## 27   COL Colombia  COL.4_1 Atlántico      <NA>      <NA> Departamento
## 28   COL Colombia  COL.5_1   Bolívar      <NA>      <NA> Departamento
## 29   COL Colombia  COL.6_1    Boyacá      <NA>      <NA> Departamento
## 30   COL Colombia  COL.7_1    Caldas      <NA>      <NA> Departamento
## 31   COL Colombia  COL.8_1   Caquetá      <NA>      <NA>  Intendencia
## 32   COL Colombia  COL.9_1  Casanare      <NA>      <NA>  Intendencia
## 2    COL Colombia COL.10_1     Cauca      <NA>      <NA> Departamento
##      ENGTYPE_1 CC_1 HASC_1                       geometry
## 1  Commissiary <NA>  CO.AM MULTIPOLYGON (((-70.0579 -4...
## 12  Department <NA>  CO.AN MULTIPOLYGON (((-76.99986 8...
## 23  Intendancy <NA>  CO.AR MULTIPOLYGON (((-69.92316 6...
## 27  Department <NA>  CO.AT MULTIPOLYGON (((-74.8816 10...
## 28  Department <NA>  CO.BL MULTIPOLYGON (((-75.79681 1...
## 29  Department <NA>  CO.BY MULTIPOLYGON (((-74.2158 5....
## 30  Department <NA>  CO.CL MULTIPOLYGON (((-75.3569 4....
## 31  Intendancy <NA>  CO.CQ MULTIPOLYGON (((-73.88365 -...
## 32  Intendancy <NA>  CO.CS MULTIPOLYGON (((-72.6363 4....
## 2   Department <NA>  CO.CA MULTIPOLYGON (((-77.97681 2...

Delitos$Departamento[Delitos$Departamento=="Valle_del_Cauca"]<-"Valle del Cauca"
Delitos$Departamento[Delitos$Departamento=="San_Andres"]<-"San Andrés y Providencia"
Delitos$Departamento[Delitos$Departamento=="La_Guajira"]<-"La Guajira"
Delitos$Departamento[Delitos$Departamento=="narigno"]<-"Nariño"
Delitos$Departamento[Delitos$Departamento=="Norte_de_Santander"]<-"Norte de Santander"
Delitos$Departamento[Delitos$Departamento=="Choco"]<-"Chocó"
Delitos$Departamento[Delitos$Departamento=="Cordoba"]<-"Córdoba"
Delitos$Departamento[Delitos$Departamento=="Vaupes"]<-"Vaupés"
Delitos$Departamento[Delitos$Departamento=="Bolivar"]<-"Bolívar"
Delitos$Departamento[Delitos$Departamento=="Guainia"]<-"Guainía"
Delitos$Departamento[Delitos$Departamento=="Boyaca"]<-"Boyacá"
Delitos$Departamento[Delitos$Departamento=="Atlantico"]<-"Atlántico"
Delitos$Departamento[Delitos$Departamento=="Caqueta"]<-"Caquetá"

library(scales)
library(ggplot2)
library(dplyr)
prueba %>% 
  rename(Departamento = NAME_1) %>% 
  left_join(y = Delitos, by = "Departamento") %>% 
  ggplot(mapping = aes(fill =Delitos_Sexuales)) +
  geom_sf(color = "white") +
  scale_fill_viridis_c(
    trans = "log10",
    breaks = trans_breaks(trans = "log10",
                          inv = function(x) round(10 ^ x, digits = 1))
  ) +
  theme_void()

## Warning: Transformation introduced infinite values in discrete y-axis

library(scales)
library(ggplot2)
library(dplyr)
prueba %>% 
  rename(Departamento = NAME_1) %>% 
  left_join(y = Delitos, by = "Departamento") %>% 
  ggplot(mapping = aes(fill =Homicidios)) +
  geom_sf(color = "white") +
  scale_fill_viridis_c(
    trans = "log10",
    breaks = trans_breaks(trans = "log10",
                          inv = function(x) round(10 ^ x, digits = 1))
  ) +
  theme_void()

## Warning: Transformation introduced infinite values in discrete y-axis

Construimos el PCA

pca_delitos=PCA(Delitos[,2:7], graph = F)

get_eigenvalue(pca_delitos)

##       eigenvalue variance.percent cumulative.variance.percent
## Dim.1 4.38368951       73.0614919                    73.06149
## Dim.2 1.35526220       22.5877034                    95.64920
## Dim.3 0.14589244        2.4315406                    98.08074
## Dim.4 0.06198625        1.0331041                    99.11384
## Dim.5 0.03443305        0.5738841                    99.68772
## Dim.6 0.01873655        0.3122759                   100.00000

fviz_eig(pca_delitos, addlabels = T)

get_eigenvalue(pca_delitos)

##       eigenvalue variance.percent cumulative.variance.percent
## Dim.1 4.38368951       73.0614919                    73.06149
## Dim.2 1.35526220       22.5877034                    95.64920
## Dim.3 0.14589244        2.4315406                    98.08074
## Dim.4 0.06198625        1.0331041                    99.11384
## Dim.5 0.03443305        0.5738841                    99.68772
## Dim.6 0.01873655        0.3122759                   100.00000

fviz_eig(pca_delitos, addlabels=T)

Podemos observar que los componentes $1$ y $2$ son las más significativas. Capturan casi el 96% de las varianzas de las variables.

fviz_pca_var(pca_delitos,repel = T, colvar="cos2", col.var = "contrib", alpha.var = "contrib", gradient.cols=c("#FF0000","#FFFF00","#00FF00"))

Interpretación

library(corrplot)
corrplot(get_pca_var(pca_delitos)$cos2)

La anterior gráfica

get_pca_var(pca_delitos)

## Principal Component Analysis Results for variables
##  ===================================================
##   Name       Description                                    
## 1 "$coord"   "Coordinates for the variables"                
## 2 "$cor"     "Correlations between variables and dimensions"
## 3 "$cos2"    "Cos2 for the variables"                       
## 4 "$contrib" "contributions of the variables"

get_pca_var(pca_delitos)$coord[,1:5]

##                      Dim.1       Dim.2       Dim.3       Dim.4       Dim.5
## Delitos_Sexuales 0.9755444 -0.16108927  0.03340476  0.05195581 -0.10677532
## Homicidios       0.8781393 -0.43257834  0.13037034  0.13958449  0.03263703
## Transito         0.6610276  0.70949820 -0.21823153  0.10721782  0.02175602
## Asalto           0.6889494  0.67626493  0.24893414 -0.06246614  0.04435699
## Intrafamiliar    0.8862159 -0.42545925 -0.10951673 -0.07525155  0.11778285
## Poblacion        0.9817773 -0.02123462 -0.07869572 -0.13690339 -0.07518801

get_pca_var(pca_delitos)$contrib[,1:5]

##                      Dim.1     Dim.2      Dim.3     Dim.4     Dim.5
## Delitos_Sexuales 21.709724  1.914740  0.7648636  4.354847 33.110541
## Homicidios       17.590860 13.807219 11.6499693 31.432503  3.093470
## Transito          9.967801 37.143196 32.6439119 18.545501  1.374622
## Asalto           10.827667 33.745075 42.4752700  6.294974  5.714111
## Intrafamiliar    17.915926 13.356498  8.2210657  9.135568 40.289201
## Poblacion        21.988022  0.033271  4.2449195 30.236606 16.418056

corrplot(get_pca_ind(pca_delitos)$cos2)

Contribuciónn de cada variable a las componentes principales (cada película) en cada concepto(en cada componente principal)

Prueba que cada variable aporta un porcentaje en cada componente. La suma es $100

colSums(get_pca_var(pca_delitos)$contrib)

## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 
##   100   100   100   100   100

gráfica para mirar la contibucion de las variables al pca

fviz_contrib(pca_delitos, choice = "var", axes=1)

fviz_contrib(pca_delitos, choice = "var", axes=2)

fviz_pca_biplot(pca_delitos)

library(ggplot2)
library(GGally)

ggpairs(Delitos[,2:7])

ACP homicidios

wilson

2023-02-17

gráfica para mirar la contibucion de las variables al pca