Problema

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.


Preprocesamiento de los datos:

En el preprocesamiento de datos se hace un tratamiento a los valores faltantes, principalmente de las variables piso y parqueaderos, cuyos registros nulos son cerca de un 40% del total de registros. A estas dos variables se les reemplazó los valores faltantes por la moda.No se les eliminó sus valores nulos, debido a que se perdería gran parte de sus datos. 

datos <- read.csv(file = 'C:/Jorge Gomez/Maestria/Metodos y simulacion estadistica/vivienda.csv', 
                  header = TRUE, 
                  sep = ";")


Tratamiento de valores faltantes:

Para los valores faltantes se imputa la moda como método para abordar valores faltantes.

datos$areaconst <- gsub(",", ".", datos$areaconst)


imputar_moda <- function(x) {
  moda <- names(sort(table(x), decreasing = TRUE))[1]
  x_imputada <- ifelse(is.na(x), moda, x)
  return(x_imputada)
}

datos <- as.data.frame(lapply(datos, imputar_moda))


Se convierten a numéricos y categoricos las diferentes variables

datos <- as.data.frame(lapply(datos, imputar_moda))

# Convertir a enteros las variables numéricas convertidas de texto
datos$piso <- as.integer(datos$piso)
datos$preciom <- as.integer(datos$preciom)
datos$areaconst <- as.numeric(datos$areaconst)
datos$parqueaderos <- as.integer(datos$parqueaderos)
datos$banios <- as.integer(datos$banios)
datos$habitaciones <- as.integer(datos$habitaciones)

datos$zona <- factor(datos$zona, levels = c("Zona Centro", "Zona Norte", "Zona Oeste", "Zona Oriente", "Zona Sur"))
datos$estrato <- as.factor(datos$estrato)
datos$tipo <- factor(datos$tipo, levels = c("Casa", "Apartamento"))
datos$barrio <- as.factor(datos$barrio)



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


1. Análisis de Componentes Principales (PCA)


Para este método solo se utilizan variables numéricas.

library(psych)
library(factoextra)




datosPCA <- datos[, c("piso", "preciom", "areaconst", "parqueaderos", "banios", "habitaciones")]
head(datosPCA)
##   piso preciom areaconst parqueaderos banios habitaciones
## 1    2     250        70            1      3            6
## 2    2     320       120            1      2            3
## 3    2     350       220            2      2            4
## 4    2     400       280            3      5            3
## 5    1     260        90            1      2            3
## 6    1     240        87            1      3            3


Se escalan los datos, paso necesario para realizar el análisis de componentes principales. El escalamiento se realiza restando la media y dividiendolo con la desviación estándar.

datosPCA <- scale(datosPCA)
head(datosPCA)
##         piso    preciom  areaconst parqueaderos      banios habitaciones
## 1 -0.5231243 -0.5595498 -0.7339949   -0.6343338 -0.07793773    1.6406840
## 2 -0.5231243 -0.3465670 -0.3842568   -0.6343338 -0.77811479   -0.4147626
## 3 -0.5231243 -0.2552886  0.3152194    0.3063120 -0.77811479    0.2703863
## 4 -0.5231243 -0.1031580  0.7349051    1.2469577  1.32241640   -0.4147626
## 5 -0.9554580 -0.5291236 -0.5940997   -0.6343338 -0.77811479   -0.4147626
## 6 -0.9554580 -0.5899759 -0.6150839   -0.6343338 -0.07793773   -0.4147626


Se realizan el test de Barlett y el coeficiente KMO para verificar la correlación entre las variables.

# test de Bartlett
test_bartlett <- cortest.bartlett(datosPCA)
## R was not square, finding R from data
print(test_bartlett)
## $chisq
## [1] 22180.89
## 
## $p.value
## [1] 0
## 
## $df
## [1] 15
#  coeficiente KMO
kmo_resultado <- KMO(datosPCA)
print(kmo_resultado)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datosPCA)
## Overall MSA =  0.75
## MSA for each item = 
##         piso      preciom    areaconst parqueaderos       banios habitaciones 
##         0.64         0.70         0.80         0.86         0.77         0.62


-> Test de Barlett:

El resultado arroja que hay evidencia suficiente para rechazar la hipótesis nula y que al menos una de las variables esta correlacionada con otra, por lo que realizar el PCA resulta adecuado para reducir la dimensionalidad.

-> KMO:

El valor de kmo es 0.75, lo que sugiere que los datos tienen una adecuación razonable para el análisis factorial, incluyendo el PCA.


Se realiza el análisis de componentes principales

resultado_pca <- prcomp(datosPCA)

A continuacion, se observa la varianza explicada por cada componente principal 

fviz_eig(resultado_pca, addlabels = TRUE, ylim = c(0, 100))

summary(resultado_pca)
## Importance of components:
##                           PC1    PC2    PC3    PC4     PC5     PC6
## Standard deviation     1.7876 1.0425 0.8951 0.6317 0.57010 0.43864
## Proportion of Variance 0.5326 0.1811 0.1335 0.0665 0.05417 0.03207
## Cumulative Proportion  0.5326 0.7137 0.8473 0.9138 0.96793 1.00000

Como se observa, los tres primeros componentes explican la mayor parte de la varianza con un 84%, lo cual puede sugeririr que es suficiente con utilizar esos 3 componentes.


Se hace un análisis de los loadings o cargas de cada componente para verificar el aporte de cada variable en las componentes.

loadings <- resultado_pca$rotation
print(loadings)
##                     PC1          PC2          PC3         PC4        PC5
## piso          0.1017998 -0.800271394  0.574890748 -0.02933253  0.1311150
## preciom      -0.4700094 -0.288185116 -0.251236150 -0.34105599 -0.2366324
## areaconst    -0.4831504  0.060931000 -0.003161386 -0.54350252  0.5640787
## parqueaderos -0.4171612 -0.304374739 -0.382312384  0.70538969  0.2792254
## banios       -0.4863201  0.003284964  0.230949296  0.04288848 -0.6971766
## habitaciones -0.3532180  0.424438070  0.637864165  0.29666713  0.2112042
##                      PC6
## piso         -0.02552613
## preciom       0.67868021
## areaconst    -0.38634625
## parqueaderos -0.10783500
## banios       -0.47143371
## habitaciones  0.39446169


PC1: La variable piso tiene una contribución positiva pero baja en esta componente. Por el contrario, las variables precio, area construida, parqueaderos, baños y habitaciones tienen una contribución negativa pero más alta.


PC2: Se destaca la contribución de la variable piso a la segunda componente, la cual tiene una contribución positiva.


PC3: Se destaca la contribución positiva y alta de las variables piso y habitaciones en la tercer componente.


Se observa el círculo de correlaciones

#Entre el componente 1 y 2
fviz_pca_var(resultado_pca, axes = c(1, 2), col.var = "blue")

#Entre el componente 1 y 3
fviz_pca_var(resultado_pca, axes = c(1, 3), col.var = "blue")



2. Análisis de Conglomerados


Se utilizan solo variables numéricas para el algoritmo k-means, el cual solo recibe este tipo de variables.

library(tidyverse)
library(cluster)


datosClusters <- datos[, c("piso", "preciom", "areaconst", "parqueaderos", "banios", "habitaciones")]
head(datosClusters)
##   piso preciom areaconst parqueaderos banios habitaciones
## 1    2     250        70            1      3            6
## 2    2     320       120            1      2            3
## 3    2     350       220            2      2            4
## 4    2     400       280            3      5            3
## 5    1     260        90            1      2            3
## 6    1     240        87            1      3            3


Se escalan las variables numéricas, esto debido a que los variables con registros altos pueden generar que el cálculo de las distancias en el algoritmo no sea óptimo.

datosClusters <- datosClusters %>%
  select_if(is.numeric) %>%
  scale()


Se realiza la técnica del codo para determinar el número adecuado de clusters a realizar 

wss <- numeric(10)
for (i in 1:10) {
  wss[i] <- sum(kmeans(datosClusters, centers = i)$withinss)
}


wss <- numeric(10)
for (i in 1:10) {
  wss[i] <- sum(kmeans(datosClusters, centers = i)$withinss)
}


# Graficar el codo
plot(1:10, wss, type = "b", pch = 19, frame = FALSE, 
     xlab = "Número de clusters", ylab = "Within-cluster sum of squares")


El resultado sugiere que donde ya no hay una mejora significativa en el número de agrupamientos es con 2 clusters.

Se entrena el algoritmo k-means

set.seed(123)
kmeans_model <- kmeans(datosClusters, centers = 2)


Se grafica en dos dimensiones los clusters generados y los registros que entraron en cada grupo 

clusplot(datosClusters, kmeans_model$cluster, color=T, shade=T, lines=0)


Se realiza el método de silhouette para determinar que tan bien agrupa el algoritmo a los datos.

silhouette_vals <- silhouette(kmeans_model$cluster, dist(datosClusters))
mean_silhouette <- mean(silhouette_vals[, 3])
mean_silhouette
## [1] 0.4060821


El valor de 0.406 sugiere que, en promedio, los clusters tienen una buena cohesión dentro de ellos y una separación razonable con otros clusters, siendo el 1 el valor maximo a conseguir, por lo que esta en un valor adecuado.


## 3.Análisis de Correspondencia

Para este método solo se utilizan variables categóricas.

library(ca)
library(FactoMineR)
library(factoextra)
library(naniar)
library(tidyverse)
library(easypackages)


datosCorres <- datos[, c("zona", "estrato", "tipo")]
head(datosCorres)
##           zona estrato        tipo
## 1 Zona Oriente       3        Casa
## 2 Zona Oriente       3        Casa
## 3 Zona Oriente       3        Casa
## 4     Zona Sur       4        Casa
## 5   Zona Norte       5 Apartamento
## 6   Zona Norte       5 Apartamento


Se ilustran diagramas de columnas para las 3 variables categóricas, buscando que no haya alguna variable con pocos registros que distorsione el análisis.

for (i in 1:3){
  plot(datosCorres[,i], main = colnames(datosCorres)[i],
       ylab = "Cantidad", col ="steelblue", las = 2)
}


Se realiza un test de chi-cuadrado para verificar la independencia de las variables categóricas.

tabla_contingencia <- table(datosCorres$zona, datosCorres$estrato, datosCorres$tipo)

matriz_contingencia <- as.matrix(tabla_contingencia)

resultado_chi_cuadrado <- chisq.test(matriz_contingencia)

print(resultado_chi_cuadrado)
## 
##  Chi-squared test for given probabilities
## 
## data:  matriz_contingencia
## X-squared = 14946, df = 39, p-value < 2.2e-16


Dado que el valor p es extremadamente bajo, rechazamos la hipótesis nula y se concluye que hay una asociación significativa entre las categorías, por lo que vale la pena realizar el análisis de correspondencia para reducir la dimensionalidad.


Se ejecuta el análisis de correspondencia

mca_lb <- MCA(datosCorres, graph = FALSE)
mca_lb
## **Results of the Multiple Correspondence Analysis (MCA)**
## The analysis was performed on 8319 individuals, described by 3 variables
## *The results are available in the following objects:
## 
##    name              description                       
## 1  "$eig"            "eigenvalues"                     
## 2  "$var"            "results for the variables"       
## 3  "$var$coord"      "coord. of the categories"        
## 4  "$var$cos2"       "cos2 for the categories"         
## 5  "$var$contrib"    "contributions of the categories" 
## 6  "$var$v.test"     "v-test for the categories"       
## 7  "$var$eta2"       "coord. of variables"             
## 8  "$ind"            "results for the individuals"     
## 9  "$ind$coord"      "coord. for the individuals"      
## 10 "$ind$cos2"       "cos2 for the individuals"        
## 11 "$ind$contrib"    "contributions of the individuals"
## 12 "$call"           "intermediate results"            
## 13 "$call$marge.col" "weights of columns"              
## 14 "$call$marge.li"  "weights of rows"
eig_val <- factoextra::get_eigenvalue(mca_lb)
head(eig_val)
##       eigenvalue variance.percent cumulative.variance.percent
## Dim.1  0.5620882         21.07831                    21.07831
## Dim.2  0.4531232         16.99212                    38.07043
## Dim.3  0.3796450         14.23669                    52.30711
## Dim.4  0.3334444         12.50416                    64.81128
## Dim.5  0.3233137         12.12426                    76.93554
## Dim.6  0.2717762         10.19161                    87.12715
fviz_screeplot(mca_lb, addlabels = TRUE)


La gráfica muestra el procentaje de varianza explicada por cada dimensión. En este caso, la dimension 1 explica el 21% de la varianza y la dimensión 2 el 17%.

Contribución de cada variable a las dimensiones.

fviz_mca_var(mca_lb, 
             choice = "mca.cor", 
             repel = TRUE, 
             ggtheme = theme_minimal()
)


Según los resultados, se tiene que la variable de tipo es la que mas contribuye a la primera dimensión. Ademas, la variable zona y estrato estan correlacionadas dado su cercania en el gráfico.

Algunas conclusiones: