Ejercicio K-Medias

El propósito de esta actividad es poner en práctica lo estudiado hasta ahora en el Análisis de Clusters mediante el Algoritmo de K-Medias.

Primeramente aquí se proporcionan las librerías principales que deberás considerar. De todas maneras si deseas agregar cualquier otra librería lo puedes hacer y recomendaría hacerlo de una vez dentro del siguiente chunk de código:

library(tibble)
library(dplyr)
library(factoextra)
library(plotly)
library(caret)
library(randomForest)
library(tree)
library(knitr)
library(randomForest)
library(factoextra) 
library(cluster)
library(hopkins)
library(ggplot2)

A continuación se carga la base de datos a ser analizada: ‘USArrests’ de la librería ‘spData’

data("USArrests")
head(USArrests)
##            Murder Assault UrbanPop Rape
## Alabama      13.2     236       58 21.2
## Alaska       10.0     263       48 44.5
## Arizona       8.1     294       80 31.0
## Arkansas      8.8     190       50 19.5
## California    9.0     276       91 40.6
## Colorado      7.9     204       78 38.7
glimpse(USArrests)
## Rows: 50
## Columns: 4
## $ Murder   <dbl> 13.2, 10.0, 8.1, 8.8, 9.0, 7.9, 3.3, 5.9, 15.4, 17.4, 5.3, 2.…
## $ Assault  <int> 236, 263, 294, 190, 276, 204, 110, 238, 335, 211, 46, 120, 24…
## $ UrbanPop <int> 58, 48, 80, 50, 91, 78, 77, 72, 80, 60, 83, 54, 83, 65, 57, 6…
## $ Rape     <dbl> 21.2, 44.5, 31.0, 19.5, 40.6, 38.7, 11.1, 15.8, 31.9, 25.8, 2…
#?USArrests

La meta esencial del análisis que llevarás a cabo será replicar lo estudiado en el código ‘ClusterAnalysis’.

Para dar un poco de variedad a las presentaciones, cada equipo deberá utilizar la función de distancia aquí especificada y una metodología específica para determinar el número óptimo de Clusters. - Equipo 1: Distancia - Canberra y Gap_Stat - Equipo 2: Distancia - Maximum y Silhouette - Equipo 3: Distancia - Manhattan y WSS - Equipo 4: Distancia - Pearson y Gap_Stat - Eqiupo 5: Distancia - Spearman y Silhouette

Las instrucciones específicas a seguir son las siguientes: - Escala las variables

df_scaled <- log(USArrests)
head(df_scaled)
##              Murder  Assault UrbanPop     Rape
## Alabama    2.580217 5.463832 4.060443 3.054001
## Alaska     2.302585 5.572154 3.871201 3.795489
## Arizona    2.091864 5.683580 4.382027 3.433987
## Arkansas   2.174752 5.247024 3.912023 2.970414
## California 2.197225 5.620401 4.510860 3.703768
## Colorado   2.066863 5.318120 4.356709 3.655840
dist_canberra <- dist(df_scaled, method = "canberra")

Muestra y analiza detalladamente el Estadístico de Hopkin

set.seed(123)
hopkins_stat <- clustertend::hopkins(df_scaled, n = nrow(df_scaled) - 1)
hopkins_stat
## $H
## [1] 0.3330106

Muestra la gráfica asociada a esta prueba (Matriz de similitudes con la función de distancia asignada a tu equipo)

fviz_dist(dist_canberra,
          gradient = list(low = "blue", mid = "white", high = "red"))

set.seed(123)
gap_stat <- clusGap(df_scaled,
                    FUN = kmeans,
                    nstart = 25,
                    K.max = 10,
                    B = 50)

fviz_gap_stat(gap_stat)

set.seed(123)
k_opt <- 3

kmeans_result <- kmeans(df_scaled,
                        centers = k_opt,
                        nstart = 25)
pca <- prcomp(df_scaled)

fviz_cluster(kmeans_result,
             data = df_scaled,
             geom = "point",
             stand = FALSE,
             ellipse.type = "convex",
             palette = "jco",
             ggtheme = theme_minimal())

# PCA a 3 dimensiones
pca <- prcomp(df_scaled)

pca_df <- data.frame(pca$x[,1:3])
pca_df$cluster <- as.factor(kmeans_result$cluster)
pca_df$state <- rownames(df_scaled)

# Gráfico 3D
plot_ly(pca_df,
        x = ~PC1,
        y = ~PC2,
        z = ~PC3,
        color = ~cluster,
        text = ~state,
        type = "scatter3d",
        mode = "markers")

Genera conclusiones finales de tu análisis.

Similar a las exposiciones de las Actividades Iniciales, esta se llevará a cabo al iniciar la clase del Martes 12 de Mayo y para esto pueden utilizar únicamente el archivo HTML kniteado a partir de su código RMD.

Sin embargo, la entrega final deberá incluir tanto tu código completamente ejecutado en archivo HTML, así como una breve presentación en la que se mencionen claramente los principales insights detectados en su análisis y sus conclusiones principales.

Los archivos se deberán subir en Canvas por equipo a más tardar el día Viernes 29 de Mayo en la sección habilitada por el profesor para esto, junto con los archivos correspondientes a las actividades 05 y 06.