Análisis de Componentes Principales y Clusterización del PIB per cápita de Departamentos en Colombia
Cesar Millán 2301768 - Andrés Vargas - 2301750
29 de November, 2023
Cargar el Dataset
# Instala e carga las librerías necesarias
#install.packages(c("dplyr", "summarytools", "tidyr", "ggplot2", "cluster", "factoextra", "FactoMineR"))
library(dplyr)## Warning: package 'dplyr' was built under R version 4.3.2##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(summarytools)## Warning: package 'summarytools' was built under R version 4.3.2library(tidyr)## Warning: package 'tidyr' was built under R version 4.3.2library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.2library(cluster)## Warning: package 'cluster' was built under R version 4.3.2library(factoextra)## Warning: package 'factoextra' was built under R version 4.3.2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(FactoMineR)## Warning: package 'FactoMineR' was built under R version 4.3.2#Cargar el Dataset
library(readxl)## Warning: package 'readxl' was built under R version 4.3.2PIBpc <- read_excel("C:/Users/Usuario/Desktop/Maestría/Metodos Cuantitativos/PIBpc.xlsx")
View(PIBpc)Punto 1. Análisis Exploratorio de Datos
# Nuevo nombre para las columnas
nuevo_nombre <- c("Dept", "Abre", "Agri", "Explo", "Manuf", "Sumin", "Const", "Comer", "Infor",
"Finan", "Inmob", "Profe", "Publi", "Artis", "Impu")
# Cambiar el nombre a las columnas
colnames(PIBpc)[1:15] <- nuevo_nombre
str(PIBpc)## tibble [33 × 15] (S3: tbl_df/tbl/data.frame)
## $ Dept : chr [1:33] "Antioquia" "Atlantico" "Bogota D.C." "Bolivar" ...
## $ Abre : chr [1:33] "Anti" "Atla" "Bogo" "Boli" ...
## $ Agri : num [1:33] 1.06e-03 1.59e-04 1.77e-06 6.49e-04 2.06e-03 ...
## $ Explo: num [1:33] 3.45e-04 4.16e-05 4.49e-05 3.49e-04 1.45e-03 ...
## $ Manuf: num [1:33] 0.00317 0.00236 0.00261 0.00235 0.00237 ...
## $ Sumin: num [1:33] 0.000826 0.00097 0.000564 0.000404 0.00108 ...
## $ Const: num [1:33] 0.00162 0.00112 0.00148 0.00154 0.00212 ...
## $ Comer: num [1:33] 0.00316 0.00291 0.00577 0.00256 0.00343 ...
## $ Infor: num [1:33] 0.000562 0.0004 0.001321 0.000284 0.000302 ...
## $ Finan: num [1:33] 0.00097 0.000648 0.002616 0.000348 0.000368 ...
## $ Inmob: num [1:33] 0.0017 0.001061 0.004024 0.000968 0.001067 ...
## $ Profe: num [1:33] 0.001726 0.001084 0.002642 0.00101 0.000827 ...
## $ Publi: num [1:33] 0.0022 0.00225 0.00448 0.00255 0.00247 ...
## $ Artis: num [1:33] 0.000465 0.000368 0.001219 0.000215 0.000209 ...
## $ Impu : num [1:33] 0.00173 0.00146 0.00306 0.00166 0.00132 ...summary(PIBpc)## Dept Abre Agri Explo
## Length:33 Length:33 Min. :1.765e-06 Min. :1.473e-05
## Class :character Class :character 1st Qu.:7.835e-04 1st Qu.:4.160e-05
## Mode :character Mode :character Median :1.226e-03 Median :1.454e-04
## Mean :1.347e-03 Mean :1.594e-03
## 3rd Qu.:1.923e-03 3rd Qu.:7.585e-04
## Max. :3.666e-03 Max. :1.469e-02
## Manuf Sumin Const
## Min. :9.823e-06 Min. :1.427e-05 Min. :0.0003409
## 1st Qu.:2.221e-04 1st Qu.:1.256e-04 1st Qu.:0.0006911
## Median :6.365e-04 Median :2.926e-04 Median :0.0009486
## Mean :1.171e-03 Mean :3.580e-04 Mean :0.0009957
## 3rd Qu.:1.974e-03 3rd Qu.:5.256e-04 3rd Qu.:0.0011514
## Max. :4.516e-03 Max. :1.080e-03 Max. :0.0022547
## Comer Infor Finan
## Min. :0.0005394 Min. :5.420e-06 Min. :6.479e-05
## 1st Qu.:0.0014976 1st Qu.:1.191e-04 1st Qu.:1.842e-04
## Median :0.0021030 Median :2.068e-04 Median :2.381e-04
## Mean :0.0025949 Mean :2.703e-04 Mean :3.996e-04
## 3rd Qu.:0.0029135 3rd Qu.:3.552e-04 3rd Qu.:4.321e-04
## Max. :0.0130943 Max. :1.321e-03 Max. :2.616e-03
## Inmob Profe Publi Artis
## Min. :0.0001378 Min. :6.620e-06 Min. :0.001793 Min. :4.282e-05
## 1st Qu.:0.0004307 1st Qu.:1.384e-04 1st Qu.:0.002152 1st Qu.:1.209e-04
## Median :0.0007258 Median :5.452e-04 Median :0.002332 Median :1.881e-04
## Mean :0.0008818 Mean :6.272e-04 Mean :0.002433 Mean :2.373e-04
## 3rd Qu.:0.0010445 3rd Qu.:9.783e-04 3rd Qu.:0.002547 3rd Qu.:3.111e-04
## Max. :0.0040235 Max. :2.642e-03 Max. :0.004482 Max. :1.219e-03
## Impu
## Min. :0.0001378
## 1st Qu.:0.0003962
## Median :0.0006899
## Mean :0.0009852
## 3rd Qu.:0.0013203
## Max. :0.0044431Realiza un resumen descriptivo de las variables numéricas
desc_num <- PIBpc %>%
select(starts_with("Agri"):starts_with("Impu")) %>%
summarytools::descr()
print(desc_num)## Descriptive Statistics
## PIBpc
## N: 33
##
## Agri Artis Comer Const Explo Finan Impu Infor Inmob
## ----------------- -------- -------- -------- -------- -------- -------- -------- -------- --------
## Mean 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## Std.Dev 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## Min 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## Q1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## Median 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## Q3 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## Max 0.00 0.00 0.01 0.00 0.01 0.00 0.00 0.00 0.00
## MAD 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## IQR 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## CV 0.66 0.89 0.85 0.44 2.22 1.12 0.92 0.93 0.86
## Skewness 0.83 2.98 3.30 1.13 2.71 3.70 1.96 2.25 2.38
## SE.Skewness 0.41 0.41 0.41 0.41 0.41 0.41 0.41 0.41 0.41
## Kurtosis 0.14 11.14 12.64 0.95 6.61 15.37 4.45 6.88 6.73
## N.Valid 33.00 33.00 33.00 33.00 33.00 33.00 33.00 33.00 33.00
## Pct.Valid 100.00 100.00 100.00 100.00 100.00 100.00 100.00 100.00 100.00
##
## Table: Table continues below
##
##
##
## Manuf Profe Publi Sumin
## ----------------- -------- -------- -------- --------
## Mean 0.00 0.00 0.00 0.00
## Std.Dev 0.00 0.00 0.00 0.00
## Min 0.00 0.00 0.00 0.00
## Q1 0.00 0.00 0.00 0.00
## Median 0.00 0.00 0.00 0.00
## Q3 0.00 0.00 0.00 0.00
## Max 0.00 0.00 0.00 0.00
## MAD 0.00 0.00 0.00 0.00
## IQR 0.00 0.00 0.00 0.00
## CV 1.06 0.96 0.19 0.82
## Skewness 1.03 1.30 2.56 0.85
## SE.Skewness 0.41 0.41 0.41 0.41
## Kurtosis -0.07 1.76 8.45 -0.19
## N.Valid 33.00 33.00 33.00 33.00
## Pct.Valid 100.00 100.00 100.00 100.00# Obtener los nombres de las columnas numéricas
col_num <- colnames(PIBpc)[3:14]
par(mfrow=c(3,4))
lapply(col_num,function(y){
boxplot(PIBpc[,y],ylab=y,cex=1.5,pch=20,col="blue")
})
## [[1]]
## [[1]]$stats
## [,1]
## [1,] 0.0000017651
## [2,] 0.0007834526
## [3,] 0.0012259332
## [4,] 0.0019234639
## [5,] 0.0032969458
##
## [[1]]$n
## [1] 33
##
## [[1]]$conf
## [,1]
## [1,] 0.0009123814
## [2,] 0.0015394850
##
## [[1]]$out
## [1] 0.003666048
##
## [[1]]$group
## [1] 1
##
## [[1]]$names
## [1] "Agri"
##
##
## [[2]]
## [[2]]$stats
## [,1]
## [1,] 0.0000147256
## [2,] 0.0000416027
## [3,] 0.0001453865
## [4,] 0.0007584899
## [5,] 0.0014533347
##
## [[2]]$n
## [1] 33
##
## [[2]]$conf
## [,1]
## [1,] -5.178809e-05
## [2,] 3.425611e-04
##
## [[2]]$out
## [1] 0.005066300 0.003765644 0.013433047 0.005758367 0.014689725 0.003152308
##
## [[2]]$group
## [1] 1 1 1 1 1 1
##
## [[2]]$names
## [1] "Explo"
##
##
## [[3]]
## [[3]]$stats
## [,1]
## [1,] 0.0000098234
## [2,] 0.0002221225
## [3,] 0.0006364525
## [4,] 0.0019744641
## [5,] 0.0045157631
##
## [[3]]$n
## [1] 33
##
## [[3]]$conf
## [,1]
## [1,] 0.0001544837
## [2,] 0.0011184213
##
## [[3]]$out
## numeric(0)
##
## [[3]]$group
## numeric(0)
##
## [[3]]$names
## [1] "Manuf"
##
##
## [[4]]
## [[4]]$stats
## [,1]
## [1,] 0.0000142744
## [2,] 0.0001256419
## [3,] 0.0002925538
## [4,] 0.0005256133
## [5,] 0.0010801120
##
## [[4]]$n
## [1] 33
##
## [[4]]$conf
## [,1]
## [1,] 0.0001825446
## [2,] 0.0004025630
##
## [[4]]$out
## numeric(0)
##
## [[4]]$group
## numeric(0)
##
## [[4]]$names
## [1] "Sumin"
##
##
## [[5]]
## [[5]]$stats
## [,1]
## [1,] 0.0003409184
## [2,] 0.0006911470
## [3,] 0.0009486054
## [4,] 0.0011514308
## [5,] 0.0016201181
##
## [[5]]$n
## [1] 33
##
## [[5]]$conf
## [,1]
## [1,] 0.0008220077
## [2,] 0.0010752031
##
## [[5]]$out
## [1] 0.002120891 0.002254678
##
## [[5]]$group
## [1] 1 1
##
## [[5]]$names
## [1] "Const"
##
##
## [[6]]
## [[6]]$stats
## [,1]
## [1,] 0.0005394066
## [2,] 0.0014976081
## [3,] 0.0021030158
## [4,] 0.0029135101
## [5,] 0.0034254262
##
## [[6]]$n
## [1] 33
##
## [[6]]$conf
## [,1]
## [1,] 0.001713582
## [2,] 0.002492449
##
## [[6]]$out
## [1] 0.005765305 0.005508334 0.013094263
##
## [[6]]$group
## [1] 1 1 1
##
## [[6]]$names
## [1] "Comer"
##
##
## [[7]]
## [[7]]$stats
## [,1]
## [1,] 0.0000054203
## [2,] 0.0001191128
## [3,] 0.0002068047
## [4,] 0.0003552118
## [5,] 0.0006654954
##
## [[7]]$n
## [1] 33
##
## [[7]]$conf
## [,1]
## [1,] 0.0001418674
## [2,] 0.0002717420
##
## [[7]]$out
## [1] 0.001321444
##
## [[7]]$group
## [1] 1
##
## [[7]]$names
## [1] "Infor"
##
##
## [[8]]
## [[8]]$stats
## [,1]
## [1,] 0.0000647886
## [2,] 0.0001842099
## [3,] 0.0002381115
## [4,] 0.0004321295
## [5,] 0.0007210548
##
## [[8]]$n
## [1] 33
##
## [[8]]$conf
## [,1]
## [1,] 0.000169923
## [2,] 0.000306300
##
## [[8]]$out
## [1] 0.0009697706 0.0026159909
##
## [[8]]$group
## [1] 1 1
##
## [[8]]$names
## [1] "Finan"
##
##
## [[9]]
## [[9]]$stats
## [,1]
## [1,] 0.0001378162
## [2,] 0.0004306560
## [3,] 0.0007258326
## [4,] 0.0010444960
## [5,] 0.0019387810
##
## [[9]]$n
## [1] 33
##
## [[9]]$conf
## [,1]
## [1,] 0.0005570004
## [2,] 0.0008946648
##
## [[9]]$out
## [1] 0.004023524 0.002423239
##
## [[9]]$group
## [1] 1 1
##
## [[9]]$names
## [1] "Inmob"
##
##
## [[10]]
## [[10]]$stats
## [,1]
## [1,] 0.0000066204
## [2,] 0.0001383614
## [3,] 0.0005452353
## [4,] 0.0009782647
## [5,] 0.0017403809
##
## [[10]]$n
## [1] 33
##
## [[10]]$conf
## [,1]
## [1,] 0.0003142260
## [2,] 0.0007762446
##
## [[10]]$out
## [1] 0.002641694
##
## [[10]]$group
## [1] 1
##
## [[10]]$names
## [1] "Profe"
##
##
## [[11]]
## [[11]]$stats
## [,1]
## [1,] 0.001792587
## [2,] 0.002152163
## [3,] 0.002331543
## [4,] 0.002546605
## [5,] 0.003116327
##
## [[11]]$n
## [1] 33
##
## [[11]]$conf
## [,1]
## [1,] 0.002223054
## [2,] 0.002440031
##
## [[11]]$out
## [1] 0.004481686 0.003160621
##
## [[11]]$group
## [1] 1 1
##
## [[11]]$names
## [1] "Publi"
##
##
## [[12]]
## [[12]]$stats
## [,1]
## [1,] 0.0000428233
## [2,] 0.0001209356
## [3,] 0.0001880561
## [4,] 0.0003111150
## [5,] 0.0004650461
##
## [[12]]$n
## [1] 33
##
## [[12]]$conf
## [,1]
## [1,] 0.0001357486
## [2,] 0.0002403636
##
## [[12]]$out
## [1] 0.001218857
##
## [[12]]$group
## [1] 1
##
## [[12]]$names
## [1] "Artis"# Excluir las filas
dep_excluir <- c("3", "28")
PIBpc2 <- PIBpc[!(rownames(PIBpc) %in% dep_excluir), ]
# Ver el nuevo dataset PIBpc2
View(PIBpc2)Calcular la matriz de correlación
pairs(PIBpc2[, 3:14],pch=20,cex=1.5,lower.panel = NULL)
M.cor = cor(PIBpc2[, 3:14],method="pearson")
print(M.cor,2)## Agri Explo Manuf Sumin Const Comer Infor Finan Inmob Profe
## Agri 1.000 0.62048 0.087 0.14 0.245 0.50 0.15 0.078 0.12680 -0.024
## Explo 0.620 1.00000 -0.160 0.02 0.080 0.52 -0.06 0.074 0.00057 -0.120
## Manuf 0.087 -0.15956 1.000 0.75 0.728 0.53 0.87 0.707 0.76185 0.853
## Sumin 0.139 0.02041 0.751 1.00 0.625 0.62 0.71 0.643 0.56667 0.710
## Const 0.245 0.07983 0.728 0.63 1.000 0.58 0.68 0.584 0.62610 0.573
## Comer 0.498 0.51732 0.532 0.62 0.580 1.00 0.59 0.684 0.64085 0.552
## Infor 0.149 -0.06024 0.872 0.71 0.684 0.59 1.00 0.856 0.84030 0.894
## Finan 0.078 0.07354 0.707 0.64 0.584 0.68 0.86 1.000 0.87308 0.867
## Inmob 0.127 0.00057 0.762 0.57 0.626 0.64 0.84 0.873 1.00000 0.838
## Profe -0.024 -0.12017 0.853 0.71 0.573 0.55 0.89 0.867 0.83783 1.000
## Publi 0.046 0.02755 -0.159 -0.27 0.067 0.10 -0.21 -0.096 -0.07545 -0.240
## Artis -0.157 -0.23377 0.632 0.57 0.456 0.44 0.82 0.842 0.78541 0.837
## Publi Artis
## Agri 0.046 -0.16
## Explo 0.028 -0.23
## Manuf -0.159 0.63
## Sumin -0.271 0.57
## Const 0.067 0.46
## Comer 0.102 0.44
## Infor -0.208 0.82
## Finan -0.096 0.84
## Inmob -0.075 0.79
## Profe -0.240 0.84
## Publi 1.000 -0.25
## Artis -0.248 1.00p.cor=corrplot::cor.mtest(PIBpc2[, 3:14])$p
print(p.cor,4)## Agri Explo Manuf Sumin Const Comer Infor
## Agri 0.0000000 0.0001962 6.422e-01 4.570e-01 1.849e-01 4.392e-03 4.228e-01
## Explo 0.0001962 0.0000000 3.912e-01 9.132e-01 6.695e-01 2.880e-03 7.475e-01
## Manuf 0.6422199 0.3912198 0.000e+00 1.152e-06 3.532e-06 2.058e-03 1.741e-10
## Sumin 0.4569527 0.9132263 1.152e-06 0.000e+00 1.682e-04 1.866e-04 6.903e-06
## Const 0.1848871 0.6694686 3.532e-06 1.682e-04 0.000e+00 6.340e-04 2.202e-05
## Comer 0.0043921 0.0028804 2.058e-03 1.866e-04 6.340e-04 0.000e+00 4.312e-04
## Infor 0.4228331 0.7475220 1.741e-10 6.903e-06 2.202e-05 4.312e-04 0.000e+00
## Finan 0.6772158 0.6941830 8.767e-06 9.535e-05 5.682e-04 2.186e-05 8.253e-10
## Inmob 0.4966666 0.9975866 6.404e-07 8.887e-04 1.649e-04 1.028e-04 3.356e-09
## Profe 0.8963116 0.5196276 1.139e-09 7.675e-06 7.523e-04 1.276e-03 1.233e-11
## Publi 0.8043795 0.8830582 3.920e-01 1.409e-01 7.221e-01 5.848e-01 2.608e-01
## Artis 0.3986088 0.2056061 1.383e-04 8.459e-04 9.846e-03 1.334e-02 1.278e-08
## Finan Inmob Profe Publi Artis
## Agri 6.772e-01 4.967e-01 8.963e-01 0.8044 3.986e-01
## Explo 6.942e-01 9.976e-01 5.196e-01 0.8831 2.056e-01
## Manuf 8.767e-06 6.404e-07 1.139e-09 0.3920 1.383e-04
## Sumin 9.535e-05 8.887e-04 7.675e-06 0.1409 8.459e-04
## Const 5.682e-04 1.649e-04 7.523e-04 0.7221 9.846e-03
## Comer 2.186e-05 1.028e-04 1.276e-03 0.5848 1.334e-02
## Infor 8.253e-10 3.356e-09 1.233e-11 0.2608 1.278e-08
## Finan 0.000e+00 1.496e-10 2.829e-10 0.6067 2.792e-09
## Inmob 1.496e-10 0.000e+00 4.123e-09 0.6867 1.668e-07
## Profe 2.829e-10 4.123e-09 0.000e+00 0.1927 4.421e-09
## Publi 6.067e-01 6.867e-01 1.927e-01 0.0000 1.792e-01
## Artis 2.792e-09 1.668e-07 4.421e-09 0.1792 0.000e+00corrplot::corrplot(M.cor, method = "ellipse",addCoef.col = "black",type="upper",
col=c("blue","red"),diag=FALSE,order="hclust",
p.mat = p.cor, sig.level = 0.01, insig = "blank"
)
Punto 2. Análisis de Componentes Principales - PCA
Sección b.
# Datos para el ACP sin considerar "impuesto" ni el departamento
X=PIBpc2[, -c(1, 15)]
View(X)
rownames(X) <- X$Abre## Warning: Setting row names on a tibble is deprecated.rownames_old <- rownames(X)
X <- X[, -which(names(X) == "Abre")]
rownames(X) <- rownames_old## Warning: Setting row names on a tibble is deprecated.PCA=prcomp(X,center=TRUE,scale=TRUE)
PCA## Standard deviations (1, .., p=12):
## [1] 2.5864618 1.4508656 1.0312230 0.8480734 0.6662802 0.5627325 0.4787275
## [8] 0.3858110 0.3224188 0.2723961 0.2624985 0.1920120
##
## Rotation (n x k) = (12 x 12):
## PC1 PC2 PC3 PC4 PC5
## Agri 0.061842661 -0.579615508 0.15901549 0.16788603 0.602948267
## Explo 0.007363398 -0.605793742 0.22815745 -0.28678877 -0.262137780
## Manuf 0.343408781 0.080759327 -0.04502623 0.37199119 0.108496636
## Sumin 0.310363786 -0.020237283 0.17759530 0.38242360 -0.557482509
## Const 0.289439218 -0.131813384 -0.23188754 0.49380791 0.009313748
## Comer 0.280347021 -0.396081393 -0.06792943 -0.15209958 -0.323073639
## Infor 0.367430129 0.054864317 0.02472736 0.02091729 0.235194816
## Finan 0.354423677 0.006872858 -0.05572141 -0.36290345 -0.053064072
## Inmob 0.348583119 0.012360661 -0.11290885 -0.24479880 0.272280821
## Profe 0.359431962 0.142788159 0.04205596 -0.10097689 0.011834597
## Publi -0.068673128 -0.187112858 -0.90102693 -0.06288683 -0.075740659
## Artis 0.321648744 0.239297210 0.02493216 -0.36296930 0.050691558
## PC6 PC7 PC8 PC9 PC10 PC11
## Agri -0.3617807619 -0.23718287 -0.04422644 -0.120875736 -0.1585621 -0.06431250
## Explo 0.3717991177 0.27190673 -0.28754592 -0.094258936 0.2323108 -0.21588535
## Manuf -0.0794716027 0.54736484 -0.02499897 0.214555771 0.1123866 0.15362509
## Sumin -0.3842559780 -0.21020406 0.02312249 -0.398181689 0.2005086 -0.15299930
## Const 0.6778389565 -0.30589616 0.01592897 0.013916414 -0.2049277 -0.04374225
## Comer -0.1931391652 -0.04404682 0.37586436 0.597983626 -0.1485997 0.20482466
## Infor -0.0272572414 0.00982063 -0.44578653 0.172424320 0.5037590 0.20438611
## Finan 0.0391521019 -0.06839814 -0.15373767 -0.436128530 -0.3060207 0.63428580
## Inmob 0.1249189931 0.16491818 0.65862273 -0.328193762 0.3058911 -0.20682791
## Profe -0.1074532217 0.34777114 -0.22783828 -0.009996734 -0.5806963 -0.49146493
## Publi -0.2252030296 0.02575881 -0.20721512 -0.103090093 0.0994909 -0.14777187
## Artis -0.0003427602 -0.52623510 -0.14724412 0.275257156 0.1260170 -0.32884218
## PC12
## Agri -0.10107967
## Explo -0.16009317
## Manuf -0.57840943
## Sumin 0.01248757
## Const 0.06124624
## Comer 0.17396410
## Infor 0.52988436
## Finan -0.14385866
## Inmob 0.10430914
## Profe 0.27398530
## Publi -0.04529126
## Artis -0.45382009summary(PCA)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.5865 1.4509 1.03122 0.84807 0.66628 0.56273 0.4787
## Proportion of Variance 0.5575 0.1754 0.08862 0.05994 0.03699 0.02639 0.0191
## Cumulative Proportion 0.5575 0.7329 0.82152 0.88145 0.91845 0.94484 0.9639
## PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.3858 0.32242 0.27240 0.26250 0.19201
## Proportion of Variance 0.0124 0.00866 0.00618 0.00574 0.00307
## Cumulative Proportion 0.9763 0.98500 0.99119 0.99693 1.00000Cuantas componentes retener?
# Raiz cuadrad de los valores propios
PCA$sdev ## [1] 2.5864618 1.4508656 1.0312230 0.8480734 0.6662802 0.5627325 0.4787275
## [8] 0.3858110 0.3224188 0.2723961 0.2624985 0.1920120Var_exp=cumsum(PCA$sdev^2)*100/sum(PCA$sdev^2)
Var_exp## [1] 55.74820 73.28996 82.15180 88.14537 91.84479 94.48368 96.39352
## [8] 97.63394 98.50022 99.11855 99.69276 100.00000par(mfrow=c(1,2))
coord=barplot(PCA$sdev^2, xlab="Componente",ylab="Valor Propio")
lines(coord,PCA$sdev^2,col="blue",lwd=2)
abline(h=1,col="red", lty=2)
coord=barplot(Var_exp, xlab="Componente",ylab="Varianza Acumulada")
lines(coord,Var_exp,col="blue",lwd=2)
text(coord,Var_exp,round(Var_exp,2), pos=3,cex=0.6)
# Se seleccionan 3 componentes, recogen el 82.15% de la Varianza Explicada
print(PCA$rotation[,1:3],3)## PC1 PC2 PC3
## Agri 0.06184 -0.57962 0.1590
## Explo 0.00736 -0.60579 0.2282
## Manuf 0.34341 0.08076 -0.0450
## Sumin 0.31036 -0.02024 0.1776
## Const 0.28944 -0.13181 -0.2319
## Comer 0.28035 -0.39608 -0.0679
## Infor 0.36743 0.05486 0.0247
## Finan 0.35442 0.00687 -0.0557
## Inmob 0.34858 0.01236 -0.1129
## Profe 0.35943 0.14279 0.0421
## Publi -0.06867 -0.18711 -0.9010
## Artis 0.32165 0.23930 0.0249par(mfrow=c(3,1))
barplot(PCA$rotation[,1],ylim=c(-0.6,0.6),col=ifelse(PCA$rotation[,1]>0,"green","red"),
main="Coeficientes estimados PC1")
barplot(PCA$rotation[,2],ylim=c(-0.6,0.6),col=ifelse(PCA$rotation[,2]>0,"green","red"),
main="Coeficientes estimados PC2")
barplot(PCA$rotation[,3],ylim=c(-0.6,0.6),col=ifelse(PCA$rotation[,3]>0,"green","red"),
main="Coeficientes estimados PC3")
Interpretación las componentes
Comp 1 = La magnitud de los coeficientes demuestran que se puede explicar la representación de los sectores económicos secundario y terciario
Comp 2 = La magnitud de los coeficientes demuestran que se puede explicar la representación de las unidades de Agricultura y Explotación, seguidas por el comercio.
Comp 3 = La magnitud del coeficiente de administración pública y defensa evidencia la fortaleza en la destinación, seguido de la construcción y actividades de agricultura y explotación.
F_PCA=predict(PCA)[,1:3]
Industrializacion = predict(PCA)[,1]
Agroindustria = predict(PCA)[,2]
Gobierno = predict(PCA)[,3]c. Generar un ranking para cada componente principal
# Crear un dataframe con las componentes principales
df_pca <- data.frame(Industrializacion = F_PCA[, 1],
Agroindustria = F_PCA[, 2],
Gobierno = F_PCA[, 3])
# Ordenar el dataframe por la columna "Industrializacion"
df_pca_ord <- df_pca[order(df_pca$Industrializacion, decreasing = FALSE), ]
# Gráfico de puntos
dotchart(df_pca_ord$Industrializacion, labels = rownames(df_pca_ord),
pch = 20, cex.lab = 0.5, main = "PC1 : Industrializacion",
cex.lab = 0.8)
abline(v = 0, col = "red", lty = 2)
# Ordenar el dataframe por la columna "Agroindustria"
df_pca_ord <- df_pca[order(df_pca$Agroindustria, decreasing = FALSE), ]
# Gráfico de puntos
dotchart(df_pca_ord$Agroindustria, labels = rownames(df_pca_ord),
pch = 20, cex.lab = 0.5, main = "PC2 : Agroindustria",
cex.lab = 0.8)
abline(v = 0, col = "red", lty = 2)
# Ordenar el dataframe por la columna "Gobierno"
df_pca_ord <- df_pca[order(df_pca$Gobierno, decreasing = FALSE), ]
# Gráfico de puntos
dotchart(df_pca_ord$Gobierno, labels = rownames(df_pca_ord),
pch = 20, cex.lab = 0.5, main = "PC3 : Gobierno",
cex.lab = 0.8)
abline(v = 0, col = "red", lty = 2)
Sección d
Representación simultánea de departamentos y variables
biplot(PCA, choices = c(1, 2), col = c("gray", "blue"), cex = 0.8, xlim = c(-0.9, 0.4), ylim = c(-0.4, 0.4))
abline(h=0,v=0,lty=2, col="red")
Casanare: Explotación y comercio
Arauca: Agricultura y Explotación
Bogota: Comercio, Administración pública y defensa, Actividades inmobiliarias y financieras
San Andrés: Comercio y Administración pública y defensa
Valle del cauca: Industrias manufactureras, Comercio, Administración pública y defensa
Antioquia: Industrias manufactureras, Comercio, Administración pública y defensa
Choco: Administración pública y defensa, Agricultura, comercio
Vaupes: Administración pública y defensa, Comercio
Punto 3. Cluster
# Evaluación del Número adecuado de cluster
Evaluar_k=function(n_clust,data,iter.max,nstart){
km <- kmeans(x = data, centers = n_clust, nstart = nstart,iter.max=iter.max)
return(km$tot.withinss)
}
k.opt=2:10
Eval_k=sapply(k.opt,Evaluar_k,data=F_PCA,iter.max=1000,nstart=50)
plot(k.opt,Eval_k,type="l",xlab="Número Cluster",ylab="SSE")
Reagrupación considerando el número de cluster seleccionado k=5 grupos seleccionados
K=5
# Semilla aleatoria
set.seed(101)
# ejecución algortimo Kmeans
km_clusters5 <- kmeans(x = F_PCA, centers = K, nstart = 50,iter.max=1000)
# Resumen resultados de la agrupación
km_clusters5 ## K-means clustering with 5 clusters of sizes 10, 2, 7, 3, 9
##
## Cluster means:
## PC1 PC2 PC3
## 1 -1.6854310 0.6893554 0.79242668
## 2 0.9681301 -4.4898934 0.72586019
## 3 -2.4523573 -0.3157589 -1.17728056
## 4 5.1982054 0.6111327 -0.61081637
## 5 1.8322150 0.2736830 0.07749177
##
## Clustering vector:
## Anti Atla Boli Boya Cald Caqu Cauc Cesa Cord Cund Choc Huil La G Magd Meta Nari
## 4 5 5 5 5 3 1 1 1 5 1 5 1 1 2 1
## Nort Quin Risa Sant Sucr Toli Vall Arau Casa Putu Amaz Guai Guav Vaup Vich
## 1 5 5 4 1 5 4 3 2 3 3 3 3 3 1
##
## Within cluster sum of squares by cluster:
## [1] 12.470155 1.569586 12.322714 2.939080 17.016810
## (between_SS / total_SS = 84.3 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"Grupos5=km_clusters5$cluster
# Evaluación de la adecuación de los grupos conformados
# Silhoutte plot
s5 = silhouette(Grupos5, dist(F_PCA))
plot(s5, cex.names = 0.5)
# Visualizacion de grupos
PIBpc2=cbind(PIBpc2,F_PCA,Grupos5)
# Representación grafica univariante de los cluster
par(mfrow=c(3,4))
lapply(colnames(X)[1:12], function(y) {
boxplot(unlist(X[, y]) ~ Grupos5, ylab = y, cex = 1.5, pch = 20, col = "blue")
})
## [[1]]
## [[1]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0004369059 0.002991226 0.0004535819 0.001017989 0.0001587348
## [2,] 0.0008519076 0.002991226 0.0005755026 0.001036834 0.0009038395
## [3,] 0.0011070754 0.003328637 0.0012720275 0.001055678 0.0019234639
## [4,] 0.0012504572 0.003666048 0.0015495956 0.001510498 0.0020867408
## [5,] 0.0016450932 0.003666048 0.0017684415 0.001965317 0.0025271171
##
## [[1]]$n
## [1] 10 2 7 3 9
##
## [[1]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0009079441 0.002574707 0.0006903149 0.000623595 0.001300469
## [2,] 0.0013062067 0.004082568 0.0018537401 0.001487760 0.002546459
##
## [[1]]$out
## Agri24
## 0.003296946
##
## [[1]]$group
## [1] 3
##
## [[1]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[2]]
## [[2]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0000160003 0.01343305 1.472560e-05 0.0000295760 0.0000416027
## [2,] 0.0000514997 0.01343305 2.480065e-05 0.0001872093 0.0000490754
## [3,] 0.0001240858 0.01406139 3.284950e-05 0.0003448425 0.0001655389
## [4,] 0.0006266079 0.01468972 1.774301e-03 0.0007089298 0.0004486117
## [5,] 0.0006266079 0.01468972 3.152308e-03 0.0010730172 0.0007584899
##
## [[2]]$n
## [1] 10 2 7 3 9
##
## [[2]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.0001632612 0.01265739 -0.001011924 -0.000131078 -4.488355e-05
## [2,] 0.0004114328 0.01546538 0.001077623 0.000820763 3.759614e-04
##
## [[2]]$out
## Explo8 Explo13 Explo24 Explo4
## 0.005066300 0.003765644 0.005758367 0.001453335
##
## [[2]]$group
## [1] 1 1 3 5
##
## [[2]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[3]]
## [[3]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0000390350 0.0006568109 0.0000098234 0.003103624 0.0004498614
## [2,] 0.0000623403 0.0006568109 0.0001150004 0.003134489 0.0014314046
## [3,] 0.0004121576 0.0007174098 0.0001582229 0.003165354 0.0019744641
## [4,] 0.0006364525 0.0007780087 0.0002111121 0.003840558 0.0023646072
## [5,] 0.0008254999 0.0007780087 0.0002523638 0.004515763 0.0023741538
##
## [[3]]$n
## [1] 10 2 7 3 9
##
## [[3]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0001253083 0.0005820041 0.0001008266 0.002521268 0.001482977
## [2,] 0.0006990069 0.0008528155 0.0002156192 0.003809440 0.002465951
##
## [[3]]$out
## Manuf7 Manuf24 Manuf10
## 0.0018125238 0.0005151221 0.0037716507
##
## [[3]]$group
## [1] 1 3 5
##
## [[3]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[4]]
## [[4]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0000290684 0.0002925538 1.427440e-05 0.0005291822 0.0002780758
## [2,] 0.0000976228 0.0002925538 3.192860e-05 0.0005572520 0.0003302015
## [3,] 0.0001749194 0.0004018374 5.521190e-05 0.0005853217 0.0005256133
## [4,] 0.0002839910 0.0005111211 9.356185e-05 0.0007054842 0.0009544590
## [5,] 0.0004640391 0.0005111211 1.256419e-04 0.0008256467 0.0010801120
##
## [[4]]$n
## [1] 10 2 7 3 9
##
## [[4]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 8.180242e-05 0.0001576478 1.840552e-05 0.0004501023 0.0001968377
## [2,] 2.680364e-04 0.0006460271 9.201828e-05 0.0007205411 0.0008543889
##
## [[4]]$out
## Sumin27
## 0.0002368799
##
## [[4]]$group
## [1] 3
##
## [[4]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[5]]
## [[5]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0003409184 0.000970637 0.0004914506 0.0008743343 0.0009534762
## [2,] 0.0005464881 0.000970637 0.0006893686 0.0012472262 0.0010662084
## [3,] 0.0006604275 0.001216924 0.0007485981 0.0016201181 0.0011514308
## [4,] 0.0007881880 0.001463212 0.0008747495 0.0019373979 0.0013147662
## [5,] 0.0009486054 0.001463212 0.0010390417 0.0022546777 0.0015355502
##
## [[5]]$n
## [1] 10 2 7 3 9
##
## [[5]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0005396646 0.0006666059 0.0006378916 0.0009905342 0.001020524
## [2,] 0.0007811905 0.0017672426 0.0008593046 0.0022497020 0.001282338
##
## [[5]]$out
## Const4
## 0.002120891
##
## [[5]]$group
## [1] 5
##
## [[5]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[6]]
## [[6]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0009317065 0.003302927 0.001449873 0.003156181 0.002103016
## [2,] 0.0012063154 0.003302927 0.001473740 0.003168687 0.002411335
## [3,] 0.0014000632 0.004405630 0.001503748 0.003181194 0.002568629
## [4,] 0.0015982783 0.005508334 0.001666120 0.003241253 0.002833436
## [5,] 0.0017978929 0.005508334 0.001714991 0.003301312 0.003425426
##
## [[6]]$n
## [1] 10 2 7 3 9
##
## [[6]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.001204223 0.001941686 0.001388861 0.003114999 0.002346322
## [2,] 0.001595903 0.006869575 0.001618634 0.003247389 0.002790935
##
## [[6]]$out
## Comer31 Comer27 Comer28
## 0.0005394066 0.0025108749 0.0010625946
##
## [[6]]$group
## [1] 1 3 3
##
## [[6]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[7]]
## [[7]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0000324812 0.0001721613 0.0000054203 0.0004906455 0.0002810492
## [2,] 0.0000977094 0.0001721613 0.0000234316 0.0005260870 0.0003022044
## [3,] 0.0001422380 0.0002493130 0.0000588501 0.0005615286 0.0003552118
## [4,] 0.0001961179 0.0003264646 0.0000952687 0.0006135120 0.0003995714
## [5,] 0.0002484711 0.0003264646 0.0001659787 0.0006654954 0.0004231014
##
## [[7]]$n
## [1] 10 2 7 3 9
##
## [[7]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 9.306919e-05 7.692087e-05 1.595014e-05 0.0004817784 0.0003039318
## [2,] 1.914068e-04 4.217050e-04 1.017501e-04 0.0006412788 0.0004064918
##
## [[7]]$out
## numeric(0)
##
## [[7]]$group
## numeric(0)
##
## [[7]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[8]]
## [[8]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0000877132 0.0004232748 0.0000647886 0.0006205723 0.0003477704
## [2,] 0.0001630816 0.0004232748 0.0001495969 0.0006708136 0.0003591831
## [3,] 0.0001906939 0.0004367936 0.0001683586 0.0007210548 0.0003757563
## [4,] 0.0002356965 0.0004503124 0.0002129547 0.0008454127 0.0004321295
## [5,] 0.0002756488 0.0004503124 0.0002309072 0.0009697706 0.0005234311
##
## [[8]]$n
## [1] 10 2 7 3 9
##
## [[8]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0001544127 0.0004065864 0.0001305223 0.0005617831 0.0003373379
## [2,] 0.0002269752 0.0004670008 0.0002061949 0.0008803265 0.0004141747
##
## [[8]]$out
## Finan2 Finan10
## 0.0006483660 0.0002232528
##
## [[8]]$group
## [1] 5 5
##
## [[8]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[9]]
## [[9]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0001378162 0.0008597378 0.0001923118 0.001699610 0.0007258326
## [2,] 0.0002801031 0.0008597378 0.0002791587 0.001819195 0.0008183408
## [3,] 0.0004694939 0.0008741438 0.0003848520 0.001938781 0.0009681869
## [4,] 0.0006429157 0.0008885498 0.0005126795 0.002181010 0.0010613234
## [5,] 0.0008416749 0.0008885498 0.0006529967 0.002423239 0.0013932555
##
## [[9]]$n
## [1] 10 2 7 3 9
##
## [[9]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0002882183 0.0008419542 0.0002453971 0.001608729 0.0008402161
## [2,] 0.0006507695 0.0009063334 0.0005243069 0.002268833 0.0010961577
##
## [[9]]$out
## numeric(0)
##
## [[9]]$group
## numeric(0)
##
## [[9]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[10]]
## [[10]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0000066204 0.0003513972 2.402810e-05 0.001061651 0.0005452353
## [2,] 0.0000315279 0.0003513972 2.806905e-05 0.001393771 0.0006909829
## [3,] 0.0002877574 0.0005193064 3.023050e-05 0.001725889 0.0009782647
## [4,] 0.0005112250 0.0006872156 1.074390e-04 0.001733135 0.0010231173
## [5,] 0.0007705283 0.0006872156 1.383614e-04 0.001740381 0.0012953447
##
## [[10]]$n
## [1] 10 2 7 3 9
##
## [[10]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 4.808165e-05 0.0001441204 -1.716792e-05 0.001416316 0.0008033406
## [2,] 5.274332e-04 0.0008944924 7.762892e-05 0.002035463 0.0011531888
##
## [[10]]$out
## Profe6
## 0.0002797758
##
## [[10]]$group
## [1] 3
##
## [[10]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[11]]
## [[11]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.001792587 0.002331543 0.002597886 0.002204370 0.002142705
## [2,] 0.002062007 0.002331543 0.002608943 0.002284519 0.002231409
## [3,] 0.002129502 0.002377010 0.002642129 0.002364667 0.002288803
## [4,] 0.002256355 0.002422477 0.002725756 0.002412585 0.002334468
## [5,] 0.002435320 0.002422477 0.002806212 0.002460502 0.002470960
##
## [[11]]$n
## [1] 10 2 7 3 9
##
## [[11]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.002032398 0.002275416 0.002572371 0.002247843 0.002234525
## [2,] 0.002226607 0.002478604 0.002711888 0.002481491 0.002343080
##
## [[11]]$out
## Publi26 Publi29 Publi3 Publi10
## 0.002430582 0.003116327 0.002546605 0.002000415
##
## [[11]]$group
## [1] 3 3 5 5
##
## [[11]]$names
## [1] "1" "2" "3" "4" "5"
##
##
## [[12]]
## [[12]]$stats
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0000428233 0.0001127464 0.0000531813 0.0003189568 0.0001921759
## [2,] 0.0001233169 0.0001127464 0.0000684578 0.0003712113 0.0002145850
## [3,] 0.0001595545 0.0001486862 0.0000899130 0.0004234658 0.0003000954
## [4,] 0.0002028191 0.0001846260 0.0001212306 0.0004442560 0.0003524100
## [5,] 0.0003147982 0.0001846260 0.0001615345 0.0004650461 0.0004530472
##
## [[12]]$n
## [1] 10 2 7 3 9
##
## [[12]]$conf
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.000119832 6.838025e-05 5.839797e-05 0.0003568335 0.0002275076
## [2,] 0.000199277 2.289922e-04 1.214280e-04 0.0004900981 0.0003726832
##
## [[12]]$out
## numeric(0)
##
## [[12]]$group
## numeric(0)
##
## [[12]]$names
## [1] "1" "2" "3" "4" "5"# Representación grafica multivariante de los cluster
fviz_cluster(object=km_clusters5, data = F_PCA, show.clust.cent = TRUE,
ellipse.type = "euclid", star.plot = TRUE, repel = TRUE,
axes=c(1,2))## Too few points to calculate an ellipse
## Too few points to calculate an ellipse
# Conclusiones