U1_Modelos Multivariados - JFG
Juan Fernando Gutiérrez Ayala
Introducción
El presente ejercicio tiene como objetivo la generación de reflexiones que permitan tomar decisiones de negocio acertadas en el mercado inmobiliario de la ciudad de Santiago de Cali. Esto, haciendo uso de modelos estadísticos multivariados a partir del desarrollo de tres técnicas concretas: (1) Análisis de Componentes Principales, (2) Análisis de Clúster y (3) Análisis de Correspondencia.
1. Análisis de Componentes Principales
# Instalación y cargue de librerías
library(dplyr)
library(tidyverse)
library(factoextra)
library(paqueteMODELOS)
library(mice)
library(modeest)
library(cluster)
library(FactoMineR)
library(gridExtra)
# Importación de datos
data("vivienda")
summary(vivienda)## id zona piso estrato
## Min. : 1 Length:8322 Length:8322 Min. :3.000
## 1st Qu.:2080 Class :character Class :character 1st Qu.:4.000
## Median :4160 Mode :character Mode :character Median :5.000
## Mean :4160 Mean :4.634
## 3rd Qu.:6240 3rd Qu.:5.000
## Max. :8319 Max. :6.000
## NA's :3 NA's :3
## preciom areaconst parqueaderos banios
## Min. : 58.0 Min. : 30.0 Min. : 1.000 Min. : 0.000
## 1st Qu.: 220.0 1st Qu.: 80.0 1st Qu.: 1.000 1st Qu.: 2.000
## Median : 330.0 Median : 123.0 Median : 2.000 Median : 3.000
## Mean : 433.9 Mean : 174.9 Mean : 1.835 Mean : 3.111
## 3rd Qu.: 540.0 3rd Qu.: 229.0 3rd Qu.: 2.000 3rd Qu.: 4.000
## Max. :1999.0 Max. :1745.0 Max. :10.000 Max. :10.000
## NA's :2 NA's :3 NA's :1605 NA's :3
## habitaciones tipo barrio longitud
## Min. : 0.000 Length:8322 Length:8322 Min. :-76.59
## 1st Qu.: 3.000 Class :character Class :character 1st Qu.:-76.54
## Median : 3.000 Mode :character Mode :character Median :-76.53
## Mean : 3.605 Mean :-76.53
## 3rd Qu.: 4.000 3rd Qu.:-76.52
## Max. :10.000 Max. :-76.46
## NA's :3 NA's :3
## latitud
## Min. :3.333
## 1st Qu.:3.381
## Median :3.416
## Mean :3.418
## 3rd Qu.:3.452
## Max. :3.498
## NA's :3
## preciom id zona estrato areaconst banios habitaciones tipo barrio longitud
## 4808 1 1 1 1 1 1 1 1 1 1
## 1909 1 1 1 1 1 1 1 1 1 1
## 876 1 1 1 1 1 1 1 1 1 1
## 726 1 1 1 1 1 1 1 1 1 1
## 1 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0 0
## 2 3 3 3 3 3 3 3 3 3
## latitud parqueaderos piso
## 4808 1 1 1 0
## 1909 1 1 0 1
## 876 1 0 1 1
## 726 1 0 0 2
## 1 0 0 0 12
## 2 0 0 0 13
## 3 1605 2638 4275# Limpieza de datos
# Datos faltantes
vivienda_l <- vivienda[, !names(vivienda) %in% c("id","piso", "parqueaderos")]
# Eliminar las filas con datos faltantes
vivienda_l <- vivienda_l[complete.cases(vivienda_l), ]
md.pattern(vivienda_l)## /\ /\
## { `---' }
## { O O }
## ==> V <== No need for mice. This data set is completely observed.
## \ \|/ /
## `-----'
## zona estrato preciom areaconst banios habitaciones tipo barrio longitud
## 8319 1 1 1 1 1 1 1 1 1
## 0 0 0 0 0 0 0 0 0
## latitud
## 8319 1 0
## 0 0# Histograma de Estrato
hist(x = vivienda_l$estrato,
main = "Estratos",
xlab = "Estrato", ylab = "Frecuencia",
col = "blue")
# Histograma de área construida
hist(x = vivienda_l$areaconst,
main = "Áreas",
xlab = "Área", ylab = "Frecuencia",
col = "yellow")
# Histograma de Baños
hist(x = vivienda_l$banios,
main = "Número de Baños",
xlab = "Número de Baños", ylab = "Frecuencia",
col = "purple")
# Histograma de habitaciones
hist(x = vivienda_l$habitaciones,
main = "Número de Habitaciones",
xlab = "Número de Habitaciones", ylab = "Frecuencia",
col = "red")
# Gráfico de tipo de vivienda
barplot(table(vivienda_l$tipo),
main="Distribución por Tipo de Vivienda",
col=c("grey","pink"),
ylab="Frecuencia") 
# Histograma de Precio
hist(x = vivienda_l$preciom,
main = "Precios",
xlab = "Precio", ylab = "Frecuencia",
col = "green")
# PCA
# Selección variables
vivienda_pca <- vivienda_l[1:8319,2:6]
# estandización
vivienda_pca= scale(vivienda_pca)
# aplicación de PCA
pca <- prcomp(vivienda_pca, scale = TRUE)
#Visualización de individuos en el espacio de las componentes principales
fviz_pca_ind(pca, col.ind = "cos2", col.var = "contrib",
repel = TRUE,
geom.ind = "point", pointsize = 2,
title = "Individuos en el Espacio de Componentes Principales")
# Elección de número de componentes principales
fviz_screeplot(pca, addlabels = TRUE, ylim = c(0, 100))
Nota: El primer y segundo componente principal explican el 82.5% de la variabilidad en el comportamiento de lo datos analizados, es decir, la combinación lineal de las variables que los constituyen.
# Contribución de las variables
fviz_pca_var(pca,
col.var = "contrib",
gradient.cols = c("#FF7F00", "#034D94"),
repel = TRUE
)
Nota: Uno de los componentes se asocia principalmente con las variables de número de habitaciones, área construida y cantidad de baños, mientras que el segundo con precio y estrato del inmueble. Es decir, uno se asocia a las condiciones o comodidades de la propiedad, y otro con variables no físicas o externas al inmueble en sí mismo.
Para analizar esto, se plantea un abordaje de 4 muestras aleatorias:
datos<- rbind(vivienda_pca[250,],
vivienda_pca[1000,],
vivienda_pca[2000,],
vivienda_pca[500,])
datos <- as.data.frame(datos)
rownames(datos) = c("id 7814","id 5417","id 7659","id 7703")
datoscasos1 <- rbind(pca$x[250,1:2],pca$x[1000,1:2]) # CP1
rownames(casos1) = c("250","1000")
casos1 <- as.data.frame(casos1)
casos2 <- rbind(pca$x[2000,1:2], pca$x[500,1:2]) # CP2
rownames(casos2) = c("2000","500")
casos2 <- as.data.frame(casos2)
fviz_pca_ind(pca, col.ind = "#DEDEDE", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")) +
geom_point(data = casos1, aes(x = PC1, y = PC2), color = "red", size = 3) +
geom_point(data = casos2, aes(x = PC1, y = PC2), color = "blue", size = 3)
2. Análisis de Conglomerados
# Método de codo para elegir número de conglomerados.
# Creación y estandarización de datos para Análisis de Conglomerados usando las variables de zona, estrato, precio, área construida, cantidad de baños y habitaciones.
vivienda_ac <- vivienda_l[1:8319,1:6]
# Asignación de valores numéricos a variable Zona
vivienda_adc <- vivienda_ac [, c("zona", "estrato", "preciom", "areaconst", "habitaciones", "banios")]
vivienda_adc$zona <- factor(vivienda_adc$zona)
niveles <- levels(vivienda_adc$zona)
vivienda_adc$zona <- as.integer(vivienda_adc$zona)
for (i in 1:length(niveles)) {
cat("Categoría:", niveles[i], " - Valor asignado:", i, "\n")
}## Categoría: Zona Centro - Valor asignado: 1
## Categoría: Zona Norte - Valor asignado: 2
## Categoría: Zona Oeste - Valor asignado: 3
## Categoría: Zona Oriente - Valor asignado: 4
## Categoría: Zona Sur - Valor asignado: 5# estandarización de variables
vivienda_cong <- scale(vivienda_adc)
# Selección de Número de Clusters
# Método del Codo para encontrar el número óptimo de clusters
num_clusters <- 2:10
wss <- numeric(length(num_clusters))
for (k in num_clusters) {
kmeans_result <- kmeans(vivienda_cong, centers = k)
wss[k - num_clusters[1] + 1] <- kmeans_result$tot.withinss
}
# Graficar el método del codo
plot(num_clusters, wss, type = "b", pch = 19, frame = FALSE,
xlab = "Número de Clusters", ylab = "Suma de Cuadrados Dentro de los Clusters",
main = "Método del Codo para Selección de Clusters")
A partir de este método, se eligen 4 clústeres al identificarse el codo de la gráfica en dicho valor.
# Aplicación del método K-means con el número de clusters elegido
num_clusters_4 <- 4
res_km <- kmeans(vivienda_cong, centers = num_clusters_4)
# Agregar etiquetas de cluster al dataframe original
vivienda_l$cluster <- as.factor(res_km$cluster)
# Visualizar los resultados del clustering
fviz_cluster(res_km, data = vivienda_cong, geom = "point",
palette = "magma")
Nota: Tras elegir 4 clústeres a partir del método del codo, se observa que varios se traslapan de manera acentuada, lo que denota debilidades en la selección de la cantidad de conglomerados y un proceso de clasificación subóptimo.
# Selección con Silhouette
# distancia euclidiana
dist_k2 <- dist(vivienda_cong, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_k2 <- hclust(dist_k2, method = 'complete')
# Determinamos a dónde pertenece cada observación
clusters_k2 <- cutree(hc_k2, k = 2)
# Calcular el coeficiente de Silhouette
sil_k2 <- silhouette(clusters_k2, dist(vivienda_cong))
sil_pr_k2 <- mean(sil_k2[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=2 : ", sil_pr_k2)## Coeficiente de Silhouette promedio k=2 : 0.6789983# distancia euclidiana
dist_k3 <- dist(vivienda_cong, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_k3 <- hclust(dist_k3, method = 'complete')
# Determinamos a dónde pertenece cada observación
clusters_k3 <- cutree(hc_k3, k = 3)
# Calcular el coeficiente de Silhouette
sil_k3 <- silhouette(clusters_k3, dist(vivienda_cong))
sil_pr_k3 <- mean(sil_k3[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=3 : ", sil_pr_k3)## Coeficiente de Silhouette promedio k=3 : 0.3757597# distancia euclidiana
dist_k4 <- dist(vivienda_cong, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_k4 <- hclust(dist_k4, method = 'complete')
# Determinamos a dónde pertenece cada observación
clusters_k4 <- cutree(hc_k4, k = 4)
# Calcular el coeficiente de Silhouette
sil_k4 <- silhouette(clusters_k4, dist(vivienda_cong))
sil_pr_k4 <- mean(sil_k4[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=4 : ", sil_pr_k4)## Coeficiente de Silhouette promedio k=4 : 0.3552394# Aplicar el método K-means con el número de clusters encontrado como más óptimo
num_clusters_2 <- 2
res_km2 <- kmeans(vivienda_cong, centers = num_clusters_2)
# Agregar etiquetas de cluster al dataframe original
vivienda_l$cluster <- as.factor(res_km2$cluster)
# Visualizar los resultados del clustering
fviz_cluster(res_km2, data = vivienda_cong, geom = "point",
palette = "magma")
Nota: Al contrastar el promedio de Silhouette para 2, 3 y 4 clústeres, se encontró que el número más óptimo es 2. Esto se confirma al observar una clasificación más limpia respecto a la anterior, al mostrar una sobreposición mínima o nula en los polígonos.
# Dendrograma
plot(hc_k2, cex = 0.6, main = "Dendograma", las=1,
ylab = "Distancia euclidiana", xlab = "Grupos")
rect.hclust(hc_k2, k = 2, border = 2:5)
3. Análisis de correspondencia.
El Análisis de Correspondencia es un método estadístico que representa asociaciones entre variables categóricas con el fin establecer si existen patrones o estructuras en los datos.
# Generación de tabla de contingencia
tabla <- table(vivienda_l$zona, vivienda_l$estrato)
colnames(tabla) <- c("Estrato 3", "Estrato 4", "Estrato 5", "Estrato 6" )
tabla##
## Estrato 3 Estrato 4 Estrato 5 Estrato 6
## Zona Centro 105 14 4 1
## Zona Norte 572 407 769 172
## Zona Oeste 54 84 290 770
## Zona Oriente 340 8 2 1
## Zona Sur 382 1616 1685 1043##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 3830.4, df = 12, p-value < 2.2e-16
Nota: Como se puede ver, en el oeste de la ciudad tiende a ubicarse la vivienda de estrato 6, mientras que el estrato 4 y 5 en el sur y el 3 en el centro y el oriente.
## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.32215213 69.965515 69.96551
## dim 2 0.12745096 27.680002 97.64552
## dim 3 0.01084108 2.354483 100.00000fviz_screeplot(resultados_ac, addlabels = TRUE, ylim = c(0, 80))+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")
Los dos primeros componentes explican el 97.7% de los cambios, lo que denota una relación visible entre las variables de estrato y precio.
4. Conclusiones.
El uso de distintas técnicas de análisis multivariado permitió entender que el precio, habitaciones, área construida y zona son variables que más inciden en el comportamiento de los datos. De esta forma, impactan de manera diferencial en la medida en que el análisis de componentes reveló que las condiciones intrínsecas al inmueble explican de manera conjunta comportamientos específicos de los datos, así como lo hacen las externas en una medida distinta.
Así mismo, se encontró que existe una fuerte relación entre la ubicación de los inmuebles y su estrato, revelando que la estructura espacial y social de la ciudad tiende a configurarse en función de la calidad de servicios públicos y capacidad adquisitiva de la población.