Ejercicio 1:

  1. Aplique lo aprendido sobre Clúster jerárquico a la base de datos denominada Poblacion2010_2022. Esta base de datos contiene la población por municipios en Puerto Rico para los años 2010 y 2022.

Cargar la base de datos

library(readxl)
data <- read_excel("Poblacion2010_2022.xlsx")
nombres <- data$Municipios
data    <- data[,-1]
rownames(data) <- nombres

Paso 1: Escalar los datos

data.scaled <- scale(x = data,
                     center = TRUE,
                     scale = TRUE)
head(data.scaled)
##                Pob_2010    Pob_2022
## Adjuntas     -0.5227021 -0.50868616
## Aguada       -0.1073876 -0.07910698
## Aguadilla     0.2435122  0.27447357
## Aguas Buenas -0.3531467 -0.38623186
## Aibonito     -0.4041279 -0.36412356
## Añasco       -0.3420229 -0.35388462

Paso 2: Calcular la matriz de distancias

dist      <- dist(data.scaled,method = "euclidean")

# matriz de distancias
dist_mat  <- as.matrix(round(dist,3))
as.dist(dist_mat[1:6,1:6])
##              Adjuntas Aguada Aguadilla Aguas Buenas Aibonito
## Aguada          0.598                                       
## Aguadilla       1.096  0.498                                
## Aguas Buenas    0.209  0.393     0.890                      
## Aibonito        0.187  0.411     0.910        0.056         
## Añasco          0.238  0.361     0.859        0.034    0.063

Calculamos la matriz y Visualizamos una submatriz 6x6 con las distancias entre los primeros 6 municipios.

Paso 3: Calcular el número óptimo de clúster. Utilizaré diferentes métodos.

1. Primer método:

library(factoextra)
fviz_nbclust(data.scaled, FUN = hcut, method = "silhouette")

El método silueta nos muestra que el valor óptimo de clusters es k=2.

2. Segundo método

fviz_nbclust(data.scaled, FUN = hcut, method = "wss")

El método de codo nos muestra que k=4 es un buen valor óptimo, ya que después de este el cambio es mínimo.

3. Tercer método

fviz_nbclust(data.scaled, FUN = hcut, method = "gap_stat")

El método de brecha nos indica que k=1 sería nuestro valor óptimo. Sin embargo, este valor es incorrecto ya que no permite una buena ni significativa división de los datos.

Paso 4: Calcular el modelo

modelo2 <- hclust(dist, method = "complete")

Paso 5: Visualizar el denograma

1. Visualizamos en denograma con k=4 como nos sugiere el método de codo:

fviz_dend(modelo2, cex = 0.5, k=4, 
          rect = TRUE,  
          k_colors = "jco",
          rect_border = "jco", 
          rect_fill = TRUE,
          horiz = TRUE,
          ggtheme = theme_bw())

Podemos observar que con esta división de k=4 se logra una agrupación general de los municipios según su cambio poblacional, pero esta división resulta algo limitada para captar diferencias más específicas entre ellos.Por lo cual intentaremos otra agrupación.

2. Visualizamos en denograma con k=6:

fviz_dend(modelo2, cex = 0.5, k=6, 
          rect = TRUE,  
          k_colors = "jco",
          rect_border = "jco", 
          rect_fill = TRUE,
          horiz = TRUE,
          ggtheme = theme_bw())

Podemos observar que con está division k=6 los municipios se agrupan en clústeres más específicos; sin embargo, no se ven diferencias significativas que justifiquen una segmentación más detallada respecto a k = 4.

Aunque se exploraron diferentes cantidades de clústeres (k = 4 y k = 6), no se observaron diferencias significativas en la segmentación de los municipios. Esto sugiere que los patrones de cambio poblacional entre 2010 y 2022 no presentan agrupaciones muy definidas, y que una división más fina no necesariamente aporta mayor claridad al análisis.

Ejercicio 2:

  1. Aplique lo aprendido sobre métodos de particionamiento a la base de datos Kanga, de la librería Faraway. Esta base de datos contiene diferentes medidas de los cráneos de 148 ejemplares de canguros de 3 especies. Considera solo las medidas asociadas a su mandíbula (columnas 17 a 19), y como hay valores NA en estas variables, usa solo las filas que no contengan ningún NA.

Paso 1: Carga y limpieza de datos:

1. Cargar datos

# Cargar datos escalados
library(faraway)
kanga_df <- kanga

2. Explorar datos

# Observar características de variables
str(kanga_df)
## 'data.frame':    148 obs. of  20 variables:
##  $ species             : Factor w/ 3 levels "fuliginosus",..: 2 2 2 2 2 2 2 2 2 2 ...
##  $ sex                 : Factor w/ 2 levels "Female","Male": 2 2 2 2 2 2 2 2 2 2 ...
##  $ basilar.length      : int  1312 1439 1378 1315 1413 1090 1294 1377 1296 1470 ...
##  $ occipitonasal.length: int  1445 1503 1464 1367 1500 1195 1421 1504 1439 1563 ...
##  $ palate.length       : int  882 985 934 895 969 740 872 954 878 987 ...
##  $ palate.width        : int  NA 230 NA 230 NA NA 239 248 208 236 ...
##  $ nasal.length        : int  609 629 620 564 645 493 606 660 630 672 ...
##  $ nasal.width         : int  241 222 233 207 247 189 226 240 215 231 ...
##  $ squamosal.depth     : int  180 150 135 158 161 122 155 159 NA 185 ...
##  $ lacrymal.width      : int  394 416 403 394 426 350 396 417 387 429 ...
##  $ zygomatic.width     : int  782 824 778 801 823 673 780 812 759 856 ...
##  $ orbital.width       : int  249 233 244 224 241 234 237 240 248 227 ...
##  $ rostral.width       : int  227 248 240 242 252 185 238 245 219 268 ...
##  $ occipital.depth     : int  531 632 575 568 607 462 577 614 584 659 ...
##  $ crest.width         : int  153 141 144 116 120 188 149 128 151 103 ...
##  $ foramina.length     : int  88 100 107 79 99 90 101 91 117 94 ...
##  $ mandible.length     : int  1086 1158 1131 1090 1175 901 1084 1149 1069 1240 ...
##  $ mandible.width      : int  131 148 116 132 131 101 124 129 121 132 ...
##  $ mandible.depth      : int  179 181 169 189 197 138 168 175 159 196 ...
##  $ ramus.height        : int  591 643 610 594 654 476 578 628 578 683 ...
# Revisar los datos detalladamente
library(skimr)
skimr::skim(kanga_df)
Data summary
Name kanga_df
Number of rows 148
Number of columns 20
_______________________
Column type frequency:
factor 2
numeric 18
________________________
Group variables None

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
species 0 1 FALSE 3 ful: 50, gig: 50, mel: 48
sex 0 1 FALSE 2 Fem: 75, Mal: 73

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
basilar.length 1 0.99 1490.05 165.03 1030 1380.50 1486.0 1592.00 1893 ▁▃▇▆▂
occipitonasal.length 2 0.99 1557.83 153.63 1121 1464.75 1566.5 1661.00 1945 ▁▃▇▅▂
palate.length 1 0.99 1020.72 124.32 665 942.00 1016.0 1105.50 1315 ▁▃▇▅▂
palate.width 24 0.84 256.91 32.16 172 233.75 256.0 282.00 332 ▁▆▇▆▂
nasal.length 1 0.99 662.92 88.82 434 602.50 669.0 716.50 893 ▁▅▇▃▂
nasal.width 0 1.00 232.78 29.57 141 214.75 233.5 251.50 308 ▁▃▇▅▂
squamosal.depth 1 0.99 179.65 27.33 121 161.50 179.0 192.00 299 ▂▇▂▁▁
lacrymal.width 0 1.00 441.37 42.68 303 411.00 440.0 470.25 547 ▁▃▇▇▂
zygomatic.width 1 0.99 876.63 76.46 640 824.50 879.0 926.00 1090 ▁▃▇▅▁
orbital.width 0 1.00 239.36 16.87 190 230.00 239.0 249.00 290 ▁▃▇▂▁
rostral.width 3 0.98 271.79 36.54 173 247.00 268.0 294.00 371 ▁▆▇▅▁
occipital.depth 11 0.93 650.95 67.85 435 611.00 650.0 698.00 798 ▁▂▇▆▃
crest.width 0 1.00 123.49 41.44 13 100.75 125.0 151.00 216 ▁▅▇▇▂
foramina.length 0 1.00 94.51 14.55 60 84.75 94.5 104.00 137 ▂▆▇▃▁
mandible.length 12 0.92 1247.10 145.16 856 1155.00 1241.5 1347.25 1568 ▁▅▇▆▂
mandible.width 0 1.00 138.97 13.82 101 130.00 138.0 148.00 169 ▁▂▇▅▃
mandible.depth 0 1.00 195.95 22.75 132 181.75 194.5 210.25 271 ▁▅▇▃▁
ramus.height 0 1.00 698.79 77.54 473 648.75 700.0 751.50 880 ▁▃▇▅▂

3. Limpieza de datos

Podemos observar que la base de datos tiene valores faltantes en varias de sus columnas. Para propósitos de este estudio, solo utilizaremos las medidas asociadas con las columnas de la mandíbula del canguro. Además, eliminaremos filas con datos nulos.

library(dplyr)
kanga_man <- kanga_df %>%
  select("mandible.length", "mandible.width", "mandible.depth") %>% 
  na.omit(kanga_man) # Eliminar filas con NA"

En este caso no pudimos guardar los nombres de la especie con la función de rownames porque muchas observaciones pertenecen a la misma especie. Por lo tanto, los nombres no son únicos y no pueden utilizarse como nombres de filas. Sin embargo, en un análisis como k-means, no necesitamos nombres de filas ya que el algortimo trabaja con los valores númericos.

4. Escalar datos

Finalmente, terminamos la preparación de la base de datos escalando los valores.

kanga_scaled <- data.frame(scale(kanga_man,
                      scale = TRUE,
                      center = TRUE))

Paso 2: Buscar el número óptimo de particiones

En el siguiente paso, buscamos el número óptimo de clústeres. Si no tuviesemos el conocimiento anterior de la cantidad de especies, los siguientes métodos nos pueden ayudar a elegir la cantidad de grupos.

1. Método de silueta

library(factoextra)
fviz_nbclust(kanga_scaled,kmeans, method = "silhouette",k.max = 10)+
  labs(title= "Número óptimo de cluster") + 
  xlab("Valor de k ") +
  ylab("Promedio de silueta")

El método de silueta nos dice que el k óptimo es 2.

2. Método del codo

fviz_nbclust(kanga_scaled, hcut, method = "wss",k.max = 10)+
  labs(title= "Número óptimo de cluster") + 
  xlab("Valor de k ") +
  ylab("Suma de cuadrados entre grupos")

El método del codo muestra que el valor óptimo k = 4, ya que después de este valor, el cambio es mínimo.

3. Método de brecha

fviz_nbclust(kanga_scaled,hcut, method = "gap_stat",k.max = 10)+
  labs(title= "Número óptimo de cluster") + 
  xlab("Valor de k ") +
  ylab("Suma de cuadrados entre grupos")

Este método nos dió un valor de k = 1, lo que sugiere que no hay evidencia significativa de clústeres.

Por lo tanto, a simple vista las medidas de las mandíbulas no parecen formar grupos claramente distintos, lo cual pudiera decir que los datos son bastante similares. Aún así, podemos optar por utilizar un k entre 3 y 4 para visualizar los grupos.

Paso 3: Método de particionamiento k-means

1 . Modelo con k = 4

Aplicamos el método de particionamiento de k-means con k = 4.

# Crear el modelo
library(stats)
set.seed(1234)
modelo_km4 <- kmeans(kanga_scaled, centers = 4)

# Extraer vector con las asignacions del cluster y añadirlos al dataframe
kanga_scaled$cluster <- as.factor(modelo_km4$cluster)

# Crear data frame para los centroides
centros_df <- as.data.frame(modelo_km4$centers)

# Visualización
ggplot(kanga_scaled, aes(x = mandible.length, y = mandible.width, color = cluster, size = mandible.depth)) +
  geom_point(alpha = 0.80) +
  geom_point(data = centros_df, aes(x = mandible.length, y = mandible.width), color = 'black', size = 2) +
  scale_colour_manual(values = rainbow(4)) +
  labs(title = "Clasificación óptima con k = 4 (3 variables)")

2. Modelo con k = 3

Esta vez, aplicaremos el modelo de particionamiento de k-means con k = 3

# Crear el modelo
library(stats)
set.seed(1234)
modelo_km3 <- kmeans(kanga_scaled, centers = 3)

# Extraer vector con las asignacions del cluster y añadirlos al data frame
kanga_scaled$cluster <- as.factor(modelo_km3$cluster)

# Crear data frame para los centroides
centros_df <- as.data.frame(modelo_km3$centers)

# Visualización
ggplot(kanga_scaled, aes(x = mandible.length, y = mandible.width, color = cluster, size = mandible.depth)) +
  geom_point(alpha = 0.80) +
  geom_point(data = centros_df, aes(x = mandible.length, y = mandible.width), color = 'black', size = 2) +
  scale_colour_manual(values = rainbow(3)) +
  labs(title = "Clasificación óptima con k = 3 (3 variables)")

Interpretación:

1. Creación del data frame con asignación de clústeres

head(kanga_scaled)
##   mandible.length mandible.width mandible.depth cluster
## 1      -1.1098270     -0.5272720    -0.70851097       2
## 2      -0.6138240      0.7320802    -0.62039255       1
## 3      -0.7998251     -1.6384652    -1.14910307       2
## 4      -1.0822713     -0.4531925    -0.26791887       2
## 5      -0.4967122     -0.5272720     0.08455481       2
## 6      -2.3842792     -2.7496583    -2.51493859       2

2. Visualización

3. Observaciones