Ejercicio Pre_Examen

Se esta preparando un estudio sobre la calidad de los servicios municipales en El Salvador, para ello se ha realizado una encuesta a una muestra de 108 municipios, y se obtuvo información para las siguientes variables:

ID: Identificador corto para el municipio (1~108) Municipio: Nombres de los municipios x1: % de Negocios que consideran que la municipalidad presta servicios de mantenimiento de calles de buena calidad x2: % de Negocios que consideran que la municipalidad presta servicios de recolección de desechos sólidos de buena calidad x3: % de Negocios que consideran que la municipalidad presta servicios de alumbrado público de buena calidad x4: % que consideran que la municipalidad presta servicios de aseo y limpieza de la calle frente a las instalaciones de sus negocios de buena calidad x5: % de Negocios que indican que la lámpara de la calle que está ubicada frente a su local no funciona o no existe x6: % de Negocios que indican que la municipalidad regula de una manera apropiada las actividades del comercio informal

 load("C:/Users/Administrator/Downloads/Ejercicio_Pre_Examen_Final.RData")

Usando la información de las x’s, realice un Análisis de Conglomerados, usando la técnica de K-medias para generar los grupos:

determine el número optimo de grupos

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 4.4.1

## Warning: package 'readr' was built under R version 4.4.1

## Warning: package 'dplyr' was built under R version 4.4.1

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(cluster)
library(factoextra)

## Warning: package 'factoextra' was built under R version 4.4.2

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

library(ggrepel)

## Warning: package 'ggrepel' was built under R version 4.4.2

head(serv_municipales)

## # A tibble: 6 × 8
##      ID Municipio     x1    x2    x3    x4    x5    x6
##   <dbl> <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1     1 ATIQUIZAYA  79.4  80    87.5  67.5  67.5  47.5
## 2     2 EL CARMEN   75    78.1  71.9  68.8  68.8  37.5
## 3     3 ALEGRIA     71.9  78.9  89.5  82.5  82.5  50.9
## 4     4 SAN JULIAN  70.6  68.7  76.2  57.5  57.5  48.8
## 5     5 TEJUTLA     61.8  82.4  76.5  76.5  76.5  41.2
## 6     6 PASAQUINA   64.4  82.7  76.9  80.8  80.8  48.1

summary(serv_municipales)

##        ID          Municipio               x1                x2       
##  Min.   :  1.00   Length:108         Min.   : 0.9804   Min.   :16.25  
##  1st Qu.: 27.75   Class :character   1st Qu.:28.7500   1st Qu.:54.44  
##  Median : 54.50   Mode  :character   Median :42.9000   Median :62.50  
##  Mean   : 54.50                      Mean   :42.0254   Mean   :61.99  
##  3rd Qu.: 81.25                      3rd Qu.:53.9062   3rd Qu.:72.71  
##  Max.   :108.00                      Max.   :79.3750   Max.   :92.50  
##        x3              x4              x5              x6       
##  Min.   :11.76   Min.   : 5.00   Min.   : 5.00   Min.   : 0.00  
##  1st Qu.:48.44   1st Qu.:34.72   1st Qu.:34.72   1st Qu.:17.50  
##  Median :59.05   Median :47.70   Median :47.70   Median :26.88  
##  Mean   :57.71   Mean   :46.93   Mean   :46.93   Mean   :27.83  
##  3rd Qu.:67.81   3rd Qu.:57.83   3rd Qu.:57.83   3rd Qu.:36.24  
##  Max.   :89.47   Max.   :82.46   Max.   :82.46   Max.   :60.00

print(serv_municipales)

## # A tibble: 108 × 8
##       ID Municipio              x1    x2    x3    x4    x5    x6
##    <dbl> <chr>               <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1     1 ATIQUIZAYA           79.4  80    87.5  67.5  67.5  47.5
##  2     2 EL CARMEN            75    78.1  71.9  68.8  68.8  37.5
##  3     3 ALEGRIA              71.9  78.9  89.5  82.5  82.5  50.9
##  4     4 SAN JULIAN           70.6  68.7  76.2  57.5  57.5  48.8
##  5     5 TEJUTLA              61.8  82.4  76.5  76.5  76.5  41.2
##  6     6 PASAQUINA            64.4  82.7  76.9  80.8  80.8  48.1
##  7     7 JUAYUA               65.6  82.5  75    67.5  67.5  58.8
##  8     8 SAN SALVADOR         42.1  67.3  56.6  56.3  56.3  25.7
##  9     9 SAN PABLO TACACHICO  64.4  76.3  77.5  53.7  53.7  30  
## 10    10 TEPECOYO             64.5  79.7  73.9  73.9  73.9  29.0
## # ℹ 98 more rows

# Seleccionar las variables para clustering y escalarlas
A_scaled <- serv_municipales %>% select(x1, x2, x3, x4, x5, x6) %>% scale()

# Método de la silueta
fviz_nbclust(A_scaled, kmeans, method = "silhouette") + 
  labs(title = "Método de la Silueta")

# Método del codo
fviz_nbclust(A_scaled, kmeans, method = "wss") + 
  labs(title = "Método del Codo")

Método del Codo: Busca el “codo” en el gráfico WSS, que muestra dónde la reducción de la variación dentro de los grupos disminuye drásticamente. Ese es el número óptimo de clústeres.

Método de la Silueta: El número óptimo de clústeres será aquel que maximice la anchura de la silueta.

** Clustering con la tecnica de K-Medias

# Fijar número óptimo de clústeres
set.seed(123)  # Para reproducibilidad
kmeans_result <- kmeans(A_scaled, centers = 3, nstart = 25)

# Agregar los grupos al dataset original
serv_municipales$cluster <- kmeans_result$cluster

# Ver el dataset con los grupos asignados
head(serv_municipales)

## # A tibble: 6 × 9
##      ID Municipio     x1    x2    x3    x4    x5    x6 cluster
##   <dbl> <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>   <int>
## 1     1 ATIQUIZAYA  79.4  80    87.5  67.5  67.5  47.5       2
## 2     2 EL CARMEN   75    78.1  71.9  68.8  68.8  37.5       2
## 3     3 ALEGRIA     71.9  78.9  89.5  82.5  82.5  50.9       2
## 4     4 SAN JULIAN  70.6  68.7  76.2  57.5  57.5  48.8       2
## 5     5 TEJUTLA     61.8  82.4  76.5  76.5  76.5  41.2       2
## 6     6 PASAQUINA   64.4  82.7  76.9  80.8  80.8  48.1       2

represente en un grafico bidimensional los grupos (mostrando los nombres de los municipios), use componentes principales para reducir las x’s a 2 componentes.

** Grafico bidimensional de los Municipios.

# Realizar PCA y guardar las dos primeras componentes principales
pca_result <- prcomp(A_scaled, center = TRUE, scale. = TRUE)

# Crear un dataframe con las dos primeras componentes y los grupos
pca_data <- data.frame(
  PC1 = pca_result$x[, 1],
  PC2 = pca_result$x[, 2],
  Municipio = serv_municipales$Municipio,
  Cluster = as.factor(serv_municipales$cluster)
)

# Graficar los clústeres en el espacio PCA
library(ggplot2)

ggplot(pca_data, aes(x = PC1, y = PC2, color = Cluster, label = Municipio)) +
  geom_point(size = 3, alpha = 0.8) +
  geom_text_repel(size = 3) +
  labs(title = "Grupos en espacio PCA",
       x = "Componente Principal 1",
       y = "Componente Principal 2") +
  theme_minimal()

## Warning: ggrepel: 44 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

Ejercicio Pre_Examen_Final

CESIA YASMIN LEON REYES

2025-01-10