Análisis por componentes principales y Cluster

Instroducción

En Colombia, la medición del Producto Interno Bruto (PIB) es llevada a cabo por el Departamento Administrativo Nacional de Estadística (DANE). Este organismo clasifica la actividad económica en 12 grandes ramas, además de un rubro adicional para la generación de impuestos, conformando un total de 13 agrupaciones.

El archivo PIBpc.xlsx contiene datos sobre el PIB per cápita, expresados en miles de millones de pesos, para los 32 departamentos del país y el Distrito Capital, Bogotá.

En este análisis, se llevará a cabo un Análisis de Componentes Principales (PCA) para reducir la dimensionalidad de los datos y simplificar su interpretación. Posteriormente, se empleará el método de k-means clustering para agrupar los departamentos según la similitud en sus estructuras económicas, identificando patrones comunes entre ellos.

Cargue y limpieza de datos

Se cargan los datos del archivo PIBpc.xlsx como un data frame. La columna Abreviatura se utiliza como identificador para las filas, representando los departamentos, y se eliminan las dos primeras columnas para trabajar únicamente con los valores numéricos. Finalmente, se verifica la estructura del data frame y la calidad de los datos, evidenciando que no hay valores faltantes.

library(readxl)
library("easypackages")

lib_req<-c("MASS","visdat","car","HSAUR2","corrplot","plotrix","cluster","factoextra", "FactoMineR")# Listado de librerias requeridas por el script
easypackages::packages(lib_req)
wd="C:\\Users\\ferna\\Documents\\Maestría\\Métodos Cuantitativos"
PIB <-as.data.frame(read_excel("Laboratorios/Lab3/PIBpc.xlsx"))
row.names(PIB) = PIB$Abreviatura
PIB <- PIB[,-c(1, 2)]
str(PIB)

## 'data.frame':    33 obs. of  13 variables:
##  $ Agricultura  : num  1.06e-03 1.59e-04 1.77e-06 6.49e-04 2.06e-03 ...
##  $ ExptMin      : num  3.45e-04 4.16e-05 4.49e-05 3.49e-04 1.45e-03 ...
##  $ Manufactura  : num  0.00317 0.00236 0.00261 0.00235 0.00237 ...
##  $ Sum_Dist     : num  0.000826 0.00097 0.000564 0.000404 0.00108 ...
##  $ Construccion : num  0.00162 0.00112 0.00148 0.00154 0.00212 ...
##  $ Comercio     : num  0.00316 0.00291 0.00577 0.00256 0.00343 ...
##  $ Info_Com     : num  0.000562 0.0004 0.001321 0.000284 0.000302 ...
##  $ Fin_Seg      : num  0.00097 0.000648 0.002616 0.000348 0.000368 ...
##  $ Inmobiliarias: num  0.0017 0.001061 0.004024 0.000968 0.001067 ...
##  $ Prof_Cien    : num  0.001726 0.001084 0.002642 0.00101 0.000827 ...
##  $ Admin_Pub_Def: num  0.0022 0.00225 0.00448 0.00255 0.00247 ...
##  $ Arte         : num  0.000465 0.000368 0.001219 0.000215 0.000209 ...
##  $ Impuestos    : num  0.00173 0.00146 0.00306 0.00166 0.00132 ...

visdat::vis_miss(PIB)

Visualizción de datos general

Se visualiza la correlación entre las variables mediante un gráfico de dispersión para cada par de variables.

#Se visualizan las correlaciones 
pairs(PIB,pch=20,cex=1.5,lower.panel = NULL)

En los gráficos de dispersión se observa la presencia de valores atípicos que podrían influir en los resultados del Análisis de Componentes Principales (PCA). Para identificar los departamentos más atípicos, se grafican los pares de variables con mayor comportamiento irregular: Comercio vs Manufactura y Arte vs Admin_Pub_Def.

# Crear el gráfico de dispersión
par(mfrow=c(1,2))
plot(PIB$Comercio, PIB$Manufactura, pch = 20, cex = 1.5, xlab = "Comercio", 
     ylab = "Manufactura", main = "PIB por Departamento")
text(PIB$Comercio, PIB$Manufactura, labels = rownames(PIB), pos = 1,
     cex = 0.8, col = "blue")
# Crear el gráfico de dispersión
plot(PIB$Arte, PIB$Admin_Pub_Def, pch = 20, cex = 1.5, xlab = "Arte", 
     ylab = "Admin_Pub_Def", main = "PIB por Departamento")
text(PIB$Arte, PIB$Admin_Pub_Def, labels = rownames(PIB), pos = 1, 
     cex = 0.8, col = "blue")

En los gráficos de dispersión se observa que el Distrito Capital, Bogotá, presenta valores extremos debido a sus elevados aportes al PIB en diversas variables, destacándose significativamente frente a los demás departamentos. De manera similar, San Andrés, Providencia y Santa Catalina exhiben un comportamiento inusual por su alta dependencia del comercio. Dado que estos valores extremos podrían distorsionar los resultados del Análisis de Componentes Principales (PCA), se decide excluir ambos departamentos del conjunto de datos antes de proceder con el análisis.

PIB_Ajs = PIB[c(-3,-28),]

Correlaciones

A continuación, se construye una matriz de correlaciones utilizando el método de Pearson, dado que las variables son continuas y se asume una relación lineal entre ellas. Para facilitar la interpretación y evitar duplicidad, se grafica únicamente la parte superior de la matriz, sobre la diagonal principal. Además, se considera un nivel de significancia menor o igual a 0.01, de modo que solo se muestran las correlaciones estadísticamente significativas. Las correlaciones no significativas se omiten del gráfico para mayor claridad.

#Analsis correlacion
PIB.mcor = cor(PIB_Ajs, method = "pearson")

PIB.pcor=corrplot::cor.mtest(PIB.mcor)$p

corrplot::corrplot(PIB.mcor, method = "ellipse",addCoef.col = "black",type="upper",
                   col=c("blue","red"),diag=FALSE,order="hclust",
                   p.mat = PIB.pcor, sig.level = 0.01, insig = "blank"
)

Análisis de Componentes Principales

Se identifican correlaciones tanto positivas como negativas entre las variables del conjunto de datos. Con base en esto, se realiza un Análisis de Componentes Principales (PCA) para reducir la dimensionalidad del conjunto de datos.

Se calculan los valores propios y se grafica la varianza explicada y acumulada, lo que permite determinar cuántos componentes son necesarios para retener la mayor parte de la información del conjunto de datos.

X = PIB_Ajs
PCA=prcomp(X,center=TRUE,scale=TRUE)

# Cuantas componentes retener? 
PCA$sdev      # Raiz cuadrad de los valores propios

##  [1] 2.7223814 1.4530067 1.0448593 0.8862195 0.6915674 0.5956192 0.5176743
##  [8] 0.3882133 0.3689517 0.3059705 0.2669939 0.1935562 0.1003896

Var_exp=cumsum(PCA$sdev^2)*100/sum(PCA$sdev^2)
Var_exp

##  [1]  57.01047  73.25069  81.64861  87.69004  91.36900  94.09794  96.15938
##  [8]  97.31868  98.36580  99.08594  99.63429  99.92248 100.00000

par(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 decide conservar los primeros dos componentes principales, ya que juntos explican el 73.25% de la varianza total del conjunto de datos. Esto indica que una cantidad significativa de la información original puede ser capturada con solo estos dos componentes, lo que facilita el análisis sin una pérdida considerable de información.

print(PCA$rotation[,1:2],3)

##                    PC1      PC2
## Agricultura    0.06237 -0.57677
## ExptMin        0.00812 -0.60134
## Manufactura    0.33275  0.08362
## Sum_Dist       0.29066 -0.00971
## Construccion   0.28237 -0.13034
## Comercio       0.26641 -0.38658
## Info_Com       0.35047  0.06256
## Fin_Seg        0.33226  0.01881
## Inmobiliarias  0.33135  0.02061
## Prof_Cien      0.33708  0.15371
## Admin_Pub_Def -0.05925 -0.19400
## Arte           0.29765  0.25146
## Impuestos      0.31839 -0.05497

par(mfrow=c(2,1))
barplot(PCA$rotation[,1],ylim=c(-0.7,0.7),col=ifelse(PCA$rotation[,1]>0,"green","red"),
        main="Coeficientes estimados PC1")
barplot(PCA$rotation[,2],ylim=c(-0.7,0.7),col=ifelse(PCA$rotation[,2]>0,"green","red"),
        main="Coeficientes estimados PC2")

Se observa que el primer componente principal asigna pesos similares a la mayoría de las actividades económicas, lo que permite interpretarlo como una medida del desempeño general de cada departamento en la generación de PIB, reflejando su contribución económica global. Por otro lado, el segundo componente presenta pesos negativos altos en actividades extractivistas como Agricultura, Ganadería y Explotación Minera, y pesos positivos altos en actividades relacionadas con Arte, Ciencia y Tecnología. Por lo tanto, este componente se interpreta como un indicador de que tan tradicionales y no tradicionales es economía de cada departamento.

Para mejorar la interpretación del segundo componente, se invierte su sentido. De esta manera, los valores positivos representarán economías con mayor dependencia de actividades extractivistas y tradicionales, como Agricultura, Ganadería, Explotación Minera y comercio, mientras que los valores negativos reflejarán economías más orientadas hacia actividades como Arte, Ciencia y Tecnología.

PCA$rotation[,2] = - PCA$rotation[,2]
PCA$x[, 2] = -PCA$x[, 2]

Ya con la construcción del PCA, se reincorporan los departamentos previamente excluidos y se grafican los valores resultantes de cada departamento en las dos componentes seleccionadas. y se guarda dentro de la variable Desempeno el valor resultante del primer factor y dentro de Extrac el segundo factor

F_PCA=predict(PCA)[,1:2]

# Proyección de un nuevo individuo Bogota
Bog=predict(PCA,newdata=PIB[3,])[1:2]
Bog

## [1] 14.030189 -1.573419

# Proyección de un nuevo individuo San Andres
San=predict(PCA,newdata=PIB[28,])[1:2]
San

## [1] 3.193216 3.789935

F_PCA=rbind(F_PCA,Bog,San)

Desempeno = F_PCA[,1]
Extrac =F_PCA[,2]

Primer factor

Se grafica el primer componente, donde se observa al Distrito Capital como el departamento con el mayor puntaje en desempeño general, con una gran diferencia respecto a los demás. En contraste, Chocó, Vichada y Vaupés se encuentran entre los departamentos con los peores puntajes en este componente.

Segundo factor

Se grafica el segundo componente, donde se evidencia a Casanare como el departamento con una economía más orientada al extractivismo, con menor presencia de actividades tecnológicas y tecnificadas. Algo a destacar es que San Andrés, Providencia y Santa Catalina ocupan el segundo lugar en este componente, debido a que el comercio, que predomina en estas regiones, se asocia con actividades menos tecnificadas.

También se observa que los tres primeros valores en este segundo componente están relativamente alejados de los demás departamentos. Esto provoca que algunos departamentos, cuya economía depende de actividades tradicionales pero cuyo desempeño general no es tan alto, obtengan un valor por debajo de cero en este componente.

par(mfrow=c(1,2))
# Ordenar los datos por el vector Desempeno
orden_desempeno <- order(Desempeno) # Orden ascendente
Desempeno_ordenado <- Desempeno[orden_desempeno]
rownames_ordenado <- rownames(F_PCA)[orden_desempeno]

# Crear el primer gráfico ordenado
dotchart(Desempeno_ordenado, labels=rownames_ordenado, pch=20, cex.lab=0.5, 
         main= "PC1 : Desempeño general", cex.lab=0.8)
abline(v=0, col="red", lty=2)

# Ordenar los datos por el vector Extrac
orden_extrac <- order(Extrac) # Orden ascendente
Extrac_ordenado <- Extrac[orden_extrac]
rownames_extrac_ordenado <- rownames(F_PCA)[orden_extrac]

# Crear el segundo gráfico ordenado
dotchart(Extrac_ordenado, labels=rownames_extrac_ordenado, pch=20, 
         main= "PC2 : Economía Tradicional", cex.lab=0.8)
abline(v=0, col="red", lty=2)

Carcaterización de Departamentos

-Casanare: Este departamento se posiciona en la parte más alta del eje Y, indicando una economía fuertemente orientada a actividades tradicionales como la agricultura, ganadería y explotación minera. Sin embargo, en términos de desempeño general (eje X), se encuentra en un punto neutro, lo que refleja una contribución moderada al PIB total.

-Arauca: Con una economía también orientada hacia actividades tradicionales, Arauca muestra un desempeño general bajo, lo que podría limitar su desarrollo económico en comparación con otros departamentos.

-Bogotá: Destaca significativamente por su alto desempeño general, alejándose de los demás departamentos. Su economía está altamente diversificada y centrada en actividades no tradicionales como el arte, manufactura, ciencia, información y comunicaciones, consolidándose como el motor económico del país.

-San Andrés: Este departamento tiene un buen desempeño general, aunque con una economía inclinada hacia las actividades tradicionales. Este comportamiento está impulsado principalmente por el comercio, que tiene un peso considerable en su estructura económica.

-Valle del Cauca: Presenta un buen desempeño general, enfocado en el desarrollo de una economía no tradicional. Su diversificación y orientación hacia sectores como la manufactura y el comercio lo posicionan como una región estratégica en la economía nacional.

-Antioquia: Similar al Valle del Cauca, Antioquia mantiene un buen desempeño general, con una economía diversificada y orientada hacia actividades no tradicionales. Su fortaleza en sectores como la industria y la tecnología lo ubica como uno de los departamentos líderes en desarrollo económico.

-Chocó: Este departamento tiene un desempeño general bajo, siendo una de las regiones con mayores niveles de pobreza. Su economía no presenta un enfoque claro en actividades tradicionales ni no tradicionales, lo que refleja un rezago estructural.

-Vaupés: Similar al Chocó, Vaupés no se destaca en ninguna actividad económica específica. Su desempeño general es bajo, reflejando las dificultades de desarrollo económico en regiones apartadas con menor infraestructura y oportunidades.

Observaciones Generales

Los departamentos como Bogotá, Antioquia y Valle del Cauca lideran en términos de desempeño general y diversificación económica, mientras que regiones como Chocó y Vaupés enfrentan retos significativos para desarrollar economías más dinámicas. Casanare y Arauca, aunque dependientes de actividades tradicionales, muestran diferencias en su desempeño general, destacando la necesidad de estrategias específicas para cada región.

# Representación simultánea de individuos y variables
biplot(PCA,col=c("grey","blue"),cex=0.8,xlim=c(-0.4,1.3), ylim=c(-0.2,0.65))
# Agregar nuevos puntos (Bogotá y San Andrés)
text(Bog[1], Bog[2], labels="Bogota", pos=4, cex=0.8, col="gray")
text(San[1], San[2], labels="San Andres", pos=4, cex=0.8, col="gray")

Cluestering

Con el objetivo de agrupar los departamentos según estructuras económicas similares, se utiliza el método de clustering k-means. Este método permite identificar grupos con características homogéneas en función de las componentes principales obtenidas del PCA.

Para determinar el número óptimo de clústeres, se aplica el método del codo, que evalúa la variación interna dentro de los grupos a medida que aumenta el número de clústeres. Se calcula el error cuadrático total para diferentes números de clústeres (de 2 a 10) y se visualiza la relación entre el número de clústeres y el SSE en una gráfica.

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")

Eval_k

## [1] 249.95529 130.49677  76.25743  44.89810  33.04478  26.70560  20.56547
## [8]  15.97189  13.17165

Se determina la formación de cinco clústeres por el método del codo, los cuales el modelo determina con los tamaños siguientes: 1, 3, 17, 3 y 9. El indicador de calidad del modelo, SSE (Suma de los Errores Cuadráticos Internos), arroja un valor que explica el 91% de la variación total, lo cual sugiere que la variabilidad entre los grupos es alta y, al mismo tiempo, la variabilidad dentro de los grupos es baja. Además el silhouette nos muestra que no hay puntos con puntajes negativos que puedan indicar puntos sobrepuestos en la agrupación

Estos resultados indican que los clústeres son representativos y que el modelo logra identificar agrupaciones bien diferenciadas.

K=5                    

set.seed(101)                    # Semilla aleatoria
km_clusters5 <- kmeans(x = F_PCA, centers = K, nstart = 50,iter.max=1000) # ejecución algortimo Kmeans
km_clusters5                      # Resumen resultados de la agrupación 

## K-means clustering with 5 clusters of sizes 1, 3, 17, 3, 9
## 
## Cluster means:
##         PC1        PC2
## 1 14.030189 -1.5734190
## 2  5.599867 -0.6229855
## 3 -2.089883 -0.2560971
## 4  1.750012  4.2369975
## 5  1.852399 -0.2998278
## 
## Clustering vector:
## Anti Atla Boli Boya Cald Caqu Cauc Cesa Cord Cund Choc Huil La G Magd Meta Nari 
##    2    5    5    5    5    3    3    3    3    5    3    5    3    3    4    3 
## Nort Quin Risa Sant Sucr Toli Vall Arau Casa Putu Amaz Guai Guav Vaup Vich  Bog 
##    3    5    5    2    3    5    2    3    4    3    3    3    3    3    3    1 
##  San 
##    4 
## 
## Within cluster sum of squares by cluster:
## [1]  0.000000  3.170371 23.639444  4.981752 13.106530
##  (between_SS / total_SS =  91.0 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Grupos5=km_clusters5$cluster

s5 = silhouette(Grupos5, dist(F_PCA))     # Silhoutte plot
plot(s5)

Por último, se presentan los grupos propuestos por el análisis de clustering en el gráfico a continuación. Estos clústeres permiten identificar departamentos con estructuras económicas similares, lo que brinda una base para adoptar medidas específicas adaptadas a las necesidades y características de cada grupo.

# 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))