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.

Solucion

ipak <- function(pkg){
  new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
  if (length(new.pkg)) 
    install.packages(new.pkg, dependencies = TRUE)
  sapply(pkg, require, character.only = TRUE)
}
## paqueteMODELOS        ggplot2          dplyr           mice      tidyverse 
##           TRUE           TRUE           TRUE           TRUE           TRUE 
##       reshape2          proxy     factoextra      gridExtra     FactoMineR 
##           TRUE           TRUE           TRUE           TRUE           TRUE 
##             ca        cluster         pander 
##           TRUE           TRUE           TRUE

De acuerdo con los datos, se asumirá que los datos faltantes de parqueadero corresponderán a 0, ya que se asume que si no tiene información del parqueadero es porque no tendrá parqueadero. Y en el piso se asumirá que en caso de no mencionar piso, es porque su piso es el piso 1.

Análisis de Componentes Principales

# Convertir las columnas necesarias a tipo numérico
db[c("piso", "estrato",
     "areaconst", "parqueaderos",
     "habitaciones", "banios", "preciom")] <- lapply(db[c("piso", "estrato", "areaconst",
                                     "parqueaderos", "habitaciones",
                                     "banios", "preciom")], as.numeric)

# Escalar las columnas
dbZ <- scale(db[c("piso", "estrato", "areaconst", "parqueaderos",
                  "habitaciones", "banios", "preciom")])

head(dbZ)
##            piso    estrato  areaconst parqueaderos habitaciones      banios
## [1,] -0.7523142 -1.5872276 -0.7339949   -0.3875522    1.6406840 -0.07793773
## [2,] -0.7523142 -1.5872276 -0.3842568   -0.3875522   -0.4147626 -0.77811479
## [3,] -0.7523142 -1.5872276  0.3152194    0.4168506    0.2703863 -0.77811479
## [4,] -0.3549490 -0.6156201  0.7349051    1.2212534   -0.4147626  1.32241640
## [5,] -0.7523142  0.3559875 -0.5940997   -0.3875522   -0.4147626 -0.77811479
## [6,] -0.7523142  0.3559875 -0.6150839   -0.3875522   -0.4147626 -0.07793773
##         preciom
## [1,] -0.5595498
## [2,] -0.3465670
## [3,] -0.2552886
## [4,] -0.1031580
## [5,] -0.5291236
## [6,] -0.5899759

A partir de esta información se obtienen los 7 componentes principales, como sigue:

# Realizar el PCA
pca_result <- prcomp(dbZ)

# Calcular el porcentaje de varianza explicada por cada componente principal
varianza_explicada <- pca_result$sdev^2
porcentaje_varianza <- varianza_explicada / sum(varianza_explicada) * 100

# Crear un dataframe con los datos
df <- data.frame(Componente = paste0("PC", 1:length(porcentaje_varianza)),
                 Porcentaje_Var_Explicada = porcentaje_varianza,
                 Varianza_Acumulada = cumsum(porcentaje_varianza))

# Crear el gráfico con ggplot2
ggplot(df, aes(x = Componente)) +
  geom_bar(aes(y = Porcentaje_Var_Explicada), stat = "identity", fill = "lightblue") +
  geom_line(aes(y = Varianza_Acumulada, group = 1), color = "blue", linewidth = 1) +
  geom_point(aes(y = Varianza_Acumulada), color = "blue", size = 3) +
  labs(x = "Componente Principal", y = "Porcentaje de Varianza Explicada",
       title = "Varianza Explicada por Componente Principal") +
  scale_y_continuous(sec.axis = sec_axis(~ ., name = "Varianza Acumulada")) +
  theme_minimal()

Con el gráfico anterior, se observa que con dos componentes principales se obtiene más del 60% de explicación de las variables, mientras que al usar 3 componentes principales, estos resumen más el 80% del conjunto de datos.

Además, en el primer componente se obtiene que las variables de más peso corresponden al número de baños, al área construída, parqueaderos y precio, siendo una relación negativa. En el componente 2 es el número de piso y el estrato con relaciones fuertes positivas, y el número de habitaciones una relación fuerte negativa. En el componente principal 3 presenta una relación altamente fuerte negativa en el número de piso.

# Obtener los componentes principales y las variables
pca_result <- as.data.frame(pca_result$rotation)
pca_result$Variable <- rownames(pca_result)

# Convertir los datos a un formato adecuado para ggplot2
df <- melt(pca_result, id.vars = "Variable", variable.name = "Componente")

# Crear el gráfico de dispersión
ggplot(df, aes(x = Componente, y = Variable, fill = value)) +
  geom_tile(color = "white") +
  geom_text(aes(label = round(value, 2)), color = "black", size = 3) +  # Agregar etiquetas con 1 decimal
  scale_fill_gradient2(low = "#034D94", mid = "white", high = "#FF7F00", midpoint = 0) +
  labs(x = "Componente Principal", y = "Variable", fill = "Carga") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

Análisis de Cluster

# Escalar las columnas
data_Z <- as.data.frame(dbZ)

head(data_Z)
##         piso    estrato  areaconst parqueaderos habitaciones      banios
## 1 -0.7523142 -1.5872276 -0.7339949   -0.3875522    1.6406840 -0.07793773
## 2 -0.7523142 -1.5872276 -0.3842568   -0.3875522   -0.4147626 -0.77811479
## 3 -0.7523142 -1.5872276  0.3152194    0.4168506    0.2703863 -0.77811479
## 4 -0.3549490 -0.6156201  0.7349051    1.2212534   -0.4147626  1.32241640
## 5 -0.7523142  0.3559875 -0.5940997   -0.3875522   -0.4147626 -0.77811479
## 6 -0.7523142  0.3559875 -0.6150839   -0.3875522   -0.4147626 -0.07793773
##      preciom
## 1 -0.5595498
## 2 -0.3465670
## 3 -0.2552886
## 4 -0.1031580
## 5 -0.5291236
## 6 -0.5899759

Se calculan las distancias para posteriormente formar los clusters.

distancia <- get_dist(data_Z, method = "euclidean")

# Calcular los resultados con diferentes métodos
result_wss <- fviz_nbclust(data_Z, kmeans, method = "wss")
result_silhouette <- fviz_nbclust(data_Z, kmeans, method = "silhouette")

# Crear el gráfico dividido horizontalmente
grid.arrange(result_wss, result_silhouette, ncol = 2)

A partir de las gráficas presentadas, se puede concluir que la mejor opción es clusterizar la información en 2 grupos.

#calculamos los dos clústers
k2 <- kmeans(data_Z, centers = 2, nstart = 25)
fviz_cluster(k2, data = data_Z)

Aquí se muestra la agrupación por cluster, asumiendo 2 clusters como fue sugerido en los graficos anteriores.

# Obtener los tamaños de los clusters
tamanos_clusters <- k2$size

# Calcular el total de observaciones
total_observaciones <- sum(tamanos_clusters)

# Calcular los porcentajes para cada cluster
porcentajes_clusters <- tamanos_clusters / total_observaciones * 100

# Crear la tabla con los porcentajes
tabla_clusters <- data.frame(
  Cluster = c("Cluster 1", "Cluster 2"),
  Size = tamanos_clusters,
  Percentage = porcentajes_clusters
)

# Mostrar la tabla
print(tabla_clusters)
##     Cluster Size Percentage
## 1 Cluster 1 5607   67.39993
## 2 Cluster 2 2712   32.60007

Como se muestra, existe un desbalance en la clusterización, siendo el cluster 1 más grande que el cluster 2, sin embargo, no se observa una clara separación entre los datos, esto puede deberse justamente a la data que se tiene con muchos datos centralizados. Lo que sugiere que puede ser mejor una clusterización de otro tipo.

# Cluster jerarquico con el método complete
hc_emp <- hclust(distancia, method = 'complete')

# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_emp, k = 2)

# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(data_Z))
sil_avg <- mean(sil[,3])

# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=2 : ", sil_avg)
## Coeficiente de Silhouette promedio k=2 :  0.6169867

Este coeficiente señala que a pesar de no ser excelente, la elección de 2 clusters e una adecuada división.

A continuación se presentan los parámetros de calidad del cluster.

# Calcular los centroides de los clusters
centroides <- apply(as.matrix(data_Z), 2, function(x) tapply(x, k2$cluster, mean))

# Calcular la distancia entre cada observación y su centroide de cluster
distancias_cuadradas <- apply(as.matrix(data_Z), 1, function(x) sum((x - centroides[k2$cluster, ])^2))

# Suma de cuadrados dentro de los clusters (SSC)
SSC <- sum(distancias_cuadradas)

# Calcular la distancia entre los centroides
centroides_combinados <- combn(1:ncol(centroides), 2, FUN = function(x) sqrt(sum((centroides[,x[1]] - centroides[,x[2]])^2)))

# Suma de cuadrados entre clusters (SSB)
SSB <- sum(centroides_combinados^2)

# Mostrar los resultados
print(paste("Suma de cuadrados dentro de los clusters (SSC):", SSC))
## [1] "Suma de cuadrados dentro de los clusters (SSC): 641057925.903421"
print(paste("Suma de cuadrados entre clusters (SSB):", SSB))
## [1] "Suma de cuadrados entre clusters (SSB): 9.0310511243202"

Análisis de Correspondencia

En este caso se analizarán las variables de interés que son: tipo de vivienda, zona y barrio.

# Escalar las columnas
data_corr <- db %>% select("tipo", "zona", "barrio")

# Crear una tabla de contingencia
tabla_contingencia <- table(db$tipo, db$zona, db$barrio)

# Convertir la tabla de contingencia en una matriz
matriz_contingencia <- as.matrix(tabla_contingencia)

# Realizar la prueba de chi-cuadrado
resultado_chi_cuadrado <- chisq.test(matriz_contingencia)

# Imprimir el resultado
print(resultado_chi_cuadrado)
## 
##  Chi-squared test for given probabilities
## 
## data:  matriz_contingencia
## X-squared = 689709, df = 4359, p-value < 2.2e-16

Inicialmente la prueba de chi cuadrado indica que existe una asociación entre las variables.

# Generar los gráficos
uni.mca <- MCA(data_corr, graph = FALSE)
uni.mca
## **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"

Esto corresponde a los datos que pueden obtenerse del análisis de correspondencia múltiple.

eigenval <- get_eigenvalue(uni.mca)
pander(head(eigenval))
  eigenvalue variance.percent cumulative.variance.percent
Dim.1 0.711 0.4848 0.4848
Dim.2 0.6602 0.4501 0.9349
Dim.3 0.6508 0.4438 1.379
Dim.4 0.6232 0.4249 1.804
Dim.5 0.4442 0.3029 2.106
Dim.6 0.3333 0.2273 2.334

Al obtener la varianza acumulada para este análisis de correspondencia, las dimensiones generadas realmente tienen una varianza muy baja, es decir, explican muy poco de los datos originales.

fviz_screeplot(uni.mca, addlabels = TRUE, ylim = c(0, 0.6), ncp = 10)

Como se observa, las dimensiones no logran explicar gran parte de la información. Esto puede deberse al gran número de categorias en la variable de barrios. Se decide hacer un análisis de correspondencia simple usando sólo las variables Zona y estrato.

Análisis de Correspondencia Simple

# Crear una tabla de contingencia
tabla <- table(db$barrio, db$zona)

# Realizar la prueba de chi-cuadrado
chi_cuadrado <- chisq.test(tabla)

# Imprimir el resultado
print(chi_cuadrado)
## 
##  Pearson's Chi-squared test
## 
## data:  tabla
## X-squared = 29343, df = 1740, p-value < 2.2e-16

Al ser ambas variables relacionadas se procede a realizar el análisis de correspondencia simple:

resultados_ac <- CA(tabla)

Aquí se observa la dificultad de analizar la variable de barrios, al disponer tantas opciones es casi imposible ubicar la información adecuadamente relacionando ambas informaciones, sin embargo, con la gráfica anterior se logra identificar qué barrios corresponden con cada zona de la ciudad, teniendo algunos que quedan en un camino intermedio entre dos zonas, pero la mayoría se relacionan casi enteramente con una zona específica.

valores_prop <-resultados_ac$eig ; valores_prop
##       eigenvalue percentage of variance cumulative percentage of variance
## dim 1  0.9619479               27.27168                          27.27168
## dim 2  0.9298275               26.36105                          53.63272
## dim 3  0.8951910               25.37909                          79.01181
## dim 4  0.7403118               20.98819                         100.00000
fviz_screeplot(resultados_ac, addlabels = TRUE)+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")

Los datos aquí presentados muestran que las dos primeras componentes explican el 53% de la data, y ya con 3 componentes se alcanza casi el 80%.