Modulo 1, Unidad 1: Modelos Multivariados

Introducción

Una empresa inmobiliaria líder en una gran ciudad está buscando comprender en profundidad el mercado de viviendas urbanas para tomar decisiones estratégicas más informadas. La empresa posee una base de datos extensa que contiene información detallada sobre diversas propiedades residenciales disponibles en el mercado. Se requiere realizar un análisis holístico de estos datos para identificar patrones, relaciones y segmentaciones relevantes que permitan mejorar la toma de decisiones en cuanto a la compra, venta y valoración de propiedades.

# devtools::install_github("centromagis/paqueteMODELOS", force = TRUE)
library(paqueteMODELOS)

Loading required package: boot
Loading required package: broom
Loading required package: GGally
Loading required package: ggplot2
Registered S3 method overwritten by 'GGally':
  method from   
  +.gg   ggplot2
Loading required package: gridExtra
Loading required package: knitr
Loading required package: summarytools

Attaching package: ‘paqueteMODELOS’

The following object is masked _by_ ‘.GlobalEnv’:

    vivienda

data("vivienda", package = "paqueteMODELOS")
str(vivienda)

spc_tbl_ [8,322 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ id          : num [1:8322] 1147 1169 1350 5992 1212 ...
 $ zona        : chr [1:8322] "Zona Oriente" "Zona Oriente" "Zona Oriente" "Zona Sur" ...
 $ piso        : chr [1:8322] NA NA NA "02" ...
 $ estrato     : num [1:8322] 3 3 3 4 5 5 4 5 5 5 ...
 $ preciom     : num [1:8322] 250 320 350 400 260 240 220 310 320 780 ...
 $ areaconst   : num [1:8322] 70 120 220 280 90 87 52 137 150 380 ...
 $ parqueaderos: num [1:8322] 1 1 2 3 1 1 2 2 2 2 ...
 $ banios      : num [1:8322] 3 2 2 5 2 3 2 3 4 3 ...
 $ habitaciones: num [1:8322] 6 3 4 3 3 3 3 4 6 3 ...
 $ tipo        : chr [1:8322] "Casa" "Casa" "Casa" "Casa" ...
 $ barrio      : chr [1:8322] "20 de julio" "20 de julio" "20 de julio" "3 de julio" ...
 $ longitud    : num [1:8322] -76.5 -76.5 -76.5 -76.5 -76.5 ...
 $ latitud     : num [1:8322] 3.43 3.43 3.44 3.44 3.46 ...
 - attr(*, "spec")=List of 3
  ..$ cols   :List of 13
  .. ..$ id          : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ zona        : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ piso        : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ estrato     : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ preciom     : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ areaconst   : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ parqueaderos: list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ banios      : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ habitaciones: list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ tipo        : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ barrio      : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ longitud    : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ latitud     : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  ..$ default: list()
  .. ..- attr(*, "class")= chr [1:2] "collector_guess" "collector"
  ..$ delim  : chr ";"
  ..- attr(*, "class")= chr "col_spec"
 - attr(*, "problems")=<externalptr> 

print(vivienda)

Punto 1. Análisis de Componentes Principales

Reducir la dimensionalidad del conjunto de datos y visualizar la estructura de las variables en componentes principales para identificar características clave que influyen en la variación de precios y oferta del mercado.

1. Limpieza de datos

# Verificar las primeras filas y la estructura
head(vivienda)

str(vivienda)

spc_tbl_ [8,322 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ id          : num [1:8322] 1147 1169 1350 5992 1212 ...
 $ zona        : chr [1:8322] "Zona Oriente" "Zona Oriente" "Zona Oriente" "Zona Sur" ...
 $ piso        : chr [1:8322] NA NA NA "02" ...
 $ estrato     : num [1:8322] 3 3 3 4 5 5 4 5 5 5 ...
 $ preciom     : num [1:8322] 250 320 350 400 260 240 220 310 320 780 ...
 $ areaconst   : num [1:8322] 70 120 220 280 90 87 52 137 150 380 ...
 $ parqueaderos: num [1:8322] 1 1 2 3 1 1 2 2 2 2 ...
 $ banios      : num [1:8322] 3 2 2 5 2 3 2 3 4 3 ...
 $ habitaciones: num [1:8322] 6 3 4 3 3 3 3 4 6 3 ...
 $ tipo        : chr [1:8322] "Casa" "Casa" "Casa" "Casa" ...
 $ barrio      : chr [1:8322] "20 de julio" "20 de julio" "20 de julio" "3 de julio" ...
 $ longitud    : num [1:8322] -76.5 -76.5 -76.5 -76.5 -76.5 ...
 $ latitud     : num [1:8322] 3.43 3.43 3.44 3.44 3.46 ...
 - attr(*, "spec")=List of 3
  ..$ cols   :List of 13
  .. ..$ id          : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ zona        : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ piso        : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ estrato     : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ preciom     : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ areaconst   : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ parqueaderos: list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ banios      : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ habitaciones: list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ tipo        : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ barrio      : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
  .. ..$ longitud    : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  .. ..$ latitud     : list()
  .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
  ..$ default: list()
  .. ..- attr(*, "class")= chr [1:2] "collector_guess" "collector"
  ..$ delim  : chr ";"
  ..- attr(*, "class")= chr "col_spec"
 - attr(*, "problems")=<externalptr> 

# Verificar si hay valores faltantes
sum(is.na(numerical_data))

[1] 23

# Verificar cuántos valores faltantes hay en cada columna
colSums(is.na(numerical_data))

          id      estrato      preciom    areaconst parqueaderos 
           3            3            2            3            0 
      banios habitaciones     longitud      latitud 
           3            3            3            3 

# Calcular la media de la variable 'parqueaderos' excluyendo NA
mean_parqueaderos <- mean(numerical_data$parqueaderos, na.rm = TRUE)

# Imputar los valores faltantes en 'parqueaderos' con la media
numerical_data$parqueaderos[is.na(numerical_data$parqueaderos)] <- mean_parqueaderos

# Eliminar filas con valores faltantes
clean_data <- na.omit(numerical_data)

# Verificar cuántos valores faltantes hay en cada columna
colSums(is.na(clean_data))

          id      estrato      preciom    areaconst parqueaderos 
           0            0            0            0            0 
      banios habitaciones     longitud      latitud 
           0            0            0            0 

# Eliminar la columna 'ID' antes de estandarizar los datos
data_without_id <- clean_data[, !(names(clean_data) %in% "id")]

# Estandarizar los datos
scaled_data <- scale(data_without_id)

2. Análisis de Componentes Principales

# PCA
pca_result <- prcomp(scaled_data, center = TRUE, scale. = TRUE)
# Proporción de varianza explicada
variance_explained <- pca_result$sdev^2 / sum(pca_result$sdev^2)
cumulative_variance <- cumsum(variance_explained)

# Visualizar la varianza explicada
plot(variance_explained, xlab = "Componente Principal", ylab = "Proporción de Varianza Explicada", type = "b", main = "Varianza Explicada por Cada Componente Principal")

plot(cumulative_variance, xlab = "Número de Componentes", ylab = "Varianza Acumulada", type = "b", main = "Varianza Acumulada")

# Biplot de los primeros dos componentes principales
biplot(pca_result, scale = 0, main = "Biplot de PCA")

summary(pca_result)

Importance of components:
                          PC1    PC2    PC3     PC4     PC5     PC6
Standard deviation     1.8851 1.2203 0.9506 0.85270 0.72297 0.61964
Proportion of Variance 0.4442 0.1861 0.1130 0.09089 0.06534 0.04799
Cumulative Proportion  0.4442 0.6303 0.7433 0.83418 0.89952 0.94751
                           PC7     PC8
Standard deviation     0.48605 0.42855
Proportion of Variance 0.02953 0.02296
Cumulative Proportion  0.97704 1.00000

Análisis de Resultados

Varianza Explicada por Cada Componente Principal y Varianza Explicada por Cada Componente Principal

• Primer Componente Principal (0.45): Explica el 45% de la varianza total en los datos. Esto indica que el primer componente principal captura una cantidad significativa de la variabilidad en el conjunto de datos. Es el componente más importante en términos de explicar la variabilidad.

• Segundo Componente Principal (0.19): Explica el 19% de la varianza total. Aunque es menos significativo que el primer componente, todavía contribuye de manera importante a la variabilidad en los datos.

• Los componentes principales del tercero en adelante explican proporciones cada vez menores de la variación total. Esto sugiere que estos componentes adicionales aportan relativamente poca información adicional.

Biplot de PCA

• Observaciones: La distribución de los puntos nos indica que las observaciones tienen caracteristicas similares

• Variables: las variables longitud, estrato y habitaciones tienen mayor influencia en los componentes principales

Punto 2. Análisis de Conglomerados

# Calcular el WSS (Within-Cluster Sum of Squares) para diferentes números de clústeres
wss <- function(k) {
  kmeans(scaled_data, centers = k, nstart = 10)$tot.withinss
}

# Aplicar la función a un rango de valores para k
k_values <- 1:10
wss_values <- sapply(k_values, wss)

Warning: Quick-TRANSfer stage steps exceeded maximum (= 415950)
Warning: did not converge in 10 iterations
Warning: did not converge in 10 iterations

# Graficar codo
plot(k_values, wss_values, type = "b", pch = 19, xlab = "Número de Clústeres", ylab = "WSS", main = "Método del Codo")

# 4 clústeres
set.seed(123) # Para reproducibilidad
kmeans_result <- kmeans(scaled_data, centers = 4, nstart = 10)

# Agregar la asignación de clústeres al dataset original
data_without_id$Cluster <- as.factor(kmeans_result$cluster)

# Calcular estadísticas descriptivas por clúster
library(dplyr)

Attaching package: ‘dplyr’

The following object is masked from ‘package:gridExtra’:

    combine

The following objects are masked from ‘package:stats’:

    filter, lag

The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union

cluster_summary <- data_without_id %>%
  group_by(Cluster) %>%
  summarise(across(everything(), list(mean = mean, sd = sd), na.rm = TRUE))

Warning: There was 1 warning in `summarise()`.
ℹ In argument: `across(everything(), list(mean = mean, sd = sd), na.rm =
  TRUE)`.
ℹ In group 1: `Cluster = 1`.
Caused by warning:
! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
Supply arguments directly to `.fns` through an anonymous function instead.

  # Previously
  across(a:b, mean, na.rm = TRUE)

  # Now
  across(a:b, \(x) mean(x, na.rm = TRUE))
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.

print(cluster_summary)

# Visualizar los clústeres
library(ggplot2)

# Graficar los primeros dos componentes principales si has realizado PCA
# Para visualizar la separación entre clústeres
pca_result <- prcomp(scaled_data, center = TRUE, scale. = TRUE)
pca_data <- as.data.frame(pca_result$x)
pca_data$Cluster <- as.factor(kmeans_result$cluster)

ggplot(pca_data, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point() +
  labs(title = "Visualización de Clústeres en los Primeros Dos Componentes Principales",
       x = "Componente Principal 1", y = "Componente Principal 2")

NA
NA
NA

Análisis de resultados

A través del método del codo se decidió que 4 es el número óptimo de clústeres

• El clúster 2 contiene los datos de mayor media para las variables estrato, precio y parqueaderos, así como la mayor desviación estándar para las variable precio y parqueaderos, pero tiene la menor desviación estándar para la variable estrato. lo que sugiere que aquí están agrupadas las viviendas de mayor estrato y precio del DataSet, aunque tambien sugiere que este clúster incluye tanto propiedades extremadamente caras como algunas que son un poco menos costosas, pero aún en el rango alto

• los clúster 1 y 2 presentan una mayor dispersión de los datos.

Punto 3. Análisis de Correspondencia

# Imputar la media en 'parqueaderos' solo para datos numéricos
# Primero, asegúrate de que 'parqueaderos' sea numérico en el dataset original
vivienda$parqueaderos <- as.numeric(vivienda$parqueaderos)

# Imputar los valores faltantes en 'parqueaderos' con la media
mean_parqueaderos <- mean(vivienda$parqueaderos, na.rm = TRUE)
vivienda$parqueaderos[is.na(vivienda$parqueaderos)] <- mean_parqueaderos

# Eliminar filas con valores faltantes en cualquier columna
clean_data1 <- na.omit(vivienda)

# Eliminar la columna 'ID' del dataset
clean_data1 <- clean_data1[, !(names(clean_data1) %in% "id")]

# Instala y carga el paquete FactoMineR
#install.packages("FactoMineR")
#library(FactoMineR)

# Realiza el Análisis de Correspondencia Múltiple
acm_result <- MCA(clean_data1[, c("tipo", "zona", "barrio")], graph = FALSE)

# Instala y carga el paquete factoextra para visualizar los resultados
#install.packages("factoextra")
#library(factoextra)

# Graficar los resultados del ACM
fviz_mca_biplot(acm_result, repel = TRUE, ggtheme = theme_minimal())

Punto 4. Conclusiones

• Las variables longitud, estrato y habitaciones tienen una mayor influencia en los componentes principales. Esto sugiere que estas características son clave para entender la variabilidad en el mercado de viviendas.
• La distribución de las observaciones en el biplot indica que hay patrones de agrupamiento entre las propiedades, lo cual puede ser útil para segmentar el mercado.
• El número óptimo de clústeres sugiere que 4 es el número adecuado. Esto permite una segmentación efectiva del mercado en cuatro grupos distintos.

Punto 5. Recomendaciones para la empresa

• Enfoque en el Primer Componente Principal:

Dado que el primer componente principal captura una gran parte de la variabilidad en los datos, la empresa debería centrarse en las características asociadas a este componente. Esto permitirá a la empresa entender mejor qué factores son más influyentes en el mercado inmobiliario.

• Optimización de la Oferta de Productos:

Clúster 2: Dado que este clúster representa propiedades de alto estrato y precio, la empresa debería considerar enfocarse en este segmento para ofrecer productos premium y servicios exclusivos. Sin embargo, también deben ser conscientes de la alta variabilidad en precios y parqueaderos dentro de este grupo, lo que podría requerir estrategias de precios diferenciados y servicios personalizados. Clústeres 1 y 2: La mayor dispersión en estos clústeres indica una diversidad de propiedades. La empresa podría desarrollar estrategias de marketing y oferta que apunten a los diferentes subsegmentos dentro de estos clústeres, ajustando las ofertas a las características específicas de las propiedades en cada segmento.

• Segmentación de Mercado:

Utilizar la segmentación en clústeres para dirigir campañas de marketing específicas y diseñar ofertas personalizadas para cada grupo. Por ejemplo, campañas específicas para propiedades de alto estrato podrían atraer a compradores de lujo, mientras que otras estrategias podrían centrarse en propiedades más accesibles o con características particulares.

• Monitoreo y Adaptación Continua:

Monitorear continuamente el mercado para ajustar los clústeres y estrategias a medida que las condiciones del mercado cambian. La recopilación de datos adicionales y la realización de análisis periódicos pueden proporcionar información actualizada y relevante.