Se requiere aplicar diversas técnicas de análisis de datos, incluyendo:
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.
Análisis de Conglomerados: Agrupar las propiedades residenciales en segmentos homogéneos con características similares para entender las dinámicas de las ofertas específicas en diferentes partes de la ciudad y en diferentes estratos socioeconómicos.
Análisis de Correspondencia : Examinar la relación entre las variables categóricas (tipo de vivienda, zona y barrio), para identificar patrones de comportamiento de la oferta en mercado inmobiliario.
Visualización de resultados: Presentar gráficos, mapas y otros recursos visuales para comunicar los hallazgos de manera clara y efectiva a la dirección de la empresa.
#devtools::install_github("dgonxalex80/paqueteMODELOS", force = TRUE)
library(tidyverse) # Libreria para el uso y transformacion del dataset
library(paqueteMODELOS)
library(kableExtra) #para la visualizacion de tablas
library(reshape2) # Para melt(), dibujo de correlacion
library(gridExtra) # Union de graficas
library(factoextra)
library(FactoMineR)
df <- as.data.frame(vivienda)
dim(df) #Dimension del dataset
## [1] 8322 13
sapply(df, function(x) class(x)) # identificacion de tipos por variables
## id zona piso estrato preciom areaconst
## "numeric" "character" "character" "numeric" "numeric" "numeric"
## parqueaderos banios habitaciones tipo barrio longitud
## "numeric" "numeric" "numeric" "character" "character" "numeric"
## latitud
## "numeric"
Se identifican algunos errores en el tipo de variable en los siguientes atributos: piso, estrato y parqueaderos.
# Correccion de tipos
df$piso <- as.numeric(df$piso)
df$estrato <- as.factor(df$estrato)
df$parqueaderos <- as.numeric((df$parqueaderos))
sapply(df, function(x) class(x))
## id zona piso estrato preciom areaconst
## "numeric" "character" "numeric" "factor" "numeric" "numeric"
## parqueaderos banios habitaciones tipo barrio longitud
## "numeric" "numeric" "numeric" "character" "character" "numeric"
## latitud
## "numeric"
sapply(df, function(x) sum(is.na(x))) # Identificacion de NA's
## id zona piso estrato preciom areaconst
## 3 3 2638 3 2 3
## parqueaderos banios habitaciones tipo barrio longitud
## 1605 3 3 3 3 3
## latitud
## 3
Se presenta gran cantidad de NA’s en las variables piso y parqueadero; por lo cual, se imputara la media de ambas variables para la correccion de dichos registros vacios.
# Imputacion de medias
piso_media <- round(mean(df$piso, na.rm = T),2)
parq_media <- round(mean(df$parqueaderos, na.rm = T), 2)
df$piso[is.na(df$piso)] <- piso_media
df$parqueaderos[is.na(df$parqueaderos)] <- parq_media
sapply(df, function(x) sum(is.na(x)))
## id zona piso estrato preciom areaconst
## 3 3 0 3 2 3
## parqueaderos banios habitaciones tipo barrio longitud
## 0 3 3 3 3 3
## latitud
## 3
Dado que los demas NA’s son de 2 a 3 registros se pueden eliminar de la base de datos, dada su baja representatividad
df <- drop_na(df)
sapply(df, function(x) sum(is.na(x)))
## id zona piso estrato preciom areaconst
## 0 0 0 0 0 0
## parqueaderos banios habitaciones tipo barrio longitud
## 0 0 0 0 0 0
## latitud
## 0
#Nueva dimensión de la base de datos
dim(df)
## [1] 8319 13
Se corrobora la eliminacion de solo 3 registros de la base original.
summary(df)
## id zona piso estrato preciom
## Min. : 1 Length:8319 Min. : 1.000 3:1453 Min. : 58.0
## 1st Qu.:2080 Class :character 1st Qu.: 2.000 4:2129 1st Qu.: 220.0
## Median :4160 Mode :character Median : 3.770 5:2750 Median : 330.0
## Mean :4160 Mean : 3.771 6:1987 Mean : 433.9
## 3rd Qu.:6240 3rd Qu.: 4.000 3rd Qu.: 540.0
## Max. :8319 Max. :12.000 Max. :1999.0
## areaconst parqueaderos banios habitaciones
## Min. : 30.0 Min. : 1.000 Min. : 0.000 Min. : 0.000
## 1st Qu.: 80.0 1st Qu.: 1.000 1st Qu.: 2.000 1st Qu.: 3.000
## Median : 123.0 Median : 1.840 Median : 3.000 Median : 3.000
## Mean : 174.9 Mean : 1.836 Mean : 3.111 Mean : 3.605
## 3rd Qu.: 229.0 3rd Qu.: 2.000 3rd Qu.: 4.000 3rd Qu.: 4.000
## Max. :1745.0 Max. :10.000 Max. :10.000 Max. :10.000
## tipo barrio longitud latitud
## Length:8319 Length:8319 Min. :-76.59 Min. :3.333
## Class :character Class :character 1st Qu.:-76.54 1st Qu.:3.381
## Mode :character Mode :character Median :-76.53 Median :3.416
## Mean :-76.53 Mean :3.418
## 3rd Qu.:-76.52 3rd Qu.:3.452
## Max. :-76.46 Max. :3.498
# Se detecta correlación para las variables numéricas
num_df <- df[sapply(df, function(x) class(x))=='numeric']
num_df <- select(num_df, -longitud, -latitud, -id) # Se eliminan id, latitud y longitud
#Se aplica la correlación
cor_mat <- round(cor(num_df),2)
cor_mat_long <- melt(cor_mat)
# Crear el mapa de calor con ggplot2
ggplot(data = cor_mat_long, aes(x = Var1, y = Var2, fill = value)) +
geom_tile(color = "white") + # Tiles con borde blanco
scale_fill_gradient(low = "lightblue", high = "darkblue") + # Escala de colores
labs(title = "Correlación", x = "", y = "") + # Títulos de ejes
geom_text(aes(label = value), color = "black") + #Valores
theme_minimal() + # Estilo del tema
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Ajustar la orientación del texto en el eje x
La correlacion mas elevada se presenta entre la variable areaconst y
preciom, con 0.69; lo que no sugiere redundancia en los datos
suministrados para el ejercicio.
# Base de variables categoricas, exceptuando barrio ya que no es leible a primera vista
cat_df <- df[sapply(df, function(x) class(x)) !='numeric']
ggplot(cat_df, aes(x = zona))+
geom_bar(aes(fill = zona), show.legend = F)+
theme_classic()
ggplot(cat_df, aes(x = estrato))+
geom_bar(aes(fill = estrato), show.legend = F)+
theme_classic()
ggplot(cat_df, aes(x = tipo))+
geom_bar(aes(fill = tipo), show.legend = F)+
theme_classic()
Las graficas anteriores muestran que la mayoria de los datos reposan en la zona sur, son de estrato 5 y son de tipo apartamento.
# Graficas boxplot para variables numericas
gr_box <- names(num_df)
colores <- rainbow(length(gr_box))
for (i in seq_along(1:ncol(num_df))){
boxes <- ggplot(num_df, aes(y = num_df[[i]]))+
geom_boxplot(fill = colores[i])+
labs(title = paste("Boxplot_",gr_box[i]), y = "")+
theme_classic()
print(boxes)
}
## Warning: Use of `num_df[[i]]` is discouraged.
## ℹ Use `.data[[i]]` instead.
## Warning: Use of `num_df[[i]]` is discouraged.
## ℹ Use `.data[[i]]` instead.
## Warning: Use of `num_df[[i]]` is discouraged.
## ℹ Use `.data[[i]]` instead.
## Warning: Use of `num_df[[i]]` is discouraged.
## ℹ Use `.data[[i]]` instead.
## Warning: Use of `num_df[[i]]` is discouraged.
## ℹ Use `.data[[i]]` instead.
## Warning: Use of `num_df[[i]]` is discouraged.
## ℹ Use `.data[[i]]` instead.
Dada la detección de outliers en la mayoría de variables numéricas se procedera a eliminarlos
df_sin_outliers <- df
for (i in seq_along(1:ncol(num_df))) {
q1 <- quantile(num_df[[i]], 0.25)
q3 <- quantile(num_df[[i]], 0.75)
IQR <- q3 - q1
li <- q1 - 1.5*IQR
ls <- q3 + 1.5*IQR
## sym convierte el caracter en un simbolo y !! lo evalua con el dataframe
df_sin_outliers <- filter(df_sin_outliers, !!sym(gr_box[i]) >= li & !!sym(gr_box[i]) <= ls)
}
summary(df_sin_outliers)
## id zona piso estrato preciom
## Min. : 1 Length:6070 Min. :1.000 3:1089 Min. : 58.0
## 1st Qu.:1938 Class :character 1st Qu.:2.000 4:1734 1st Qu.: 185.0
## Median :3950 Mode :character Median :3.770 5:2075 Median : 295.0
## Mean :4045 Mean :3.361 6:1172 Mean : 338.4
## 3rd Qu.:6138 3rd Qu.:3.770 3rd Qu.: 430.0
## Max. :8318 Max. :7.000 Max. :1000.0
## areaconst parqueaderos banios habitaciones
## Min. : 30.0 Min. :1.000 Min. :0.000 Min. :2.000
## 1st Qu.: 73.0 1st Qu.:1.000 1st Qu.:2.000 1st Qu.:3.000
## Median :106.0 Median :1.840 Median :3.000 Median :3.000
## Mean :131.8 Mean :1.582 Mean :2.752 Mean :3.239
## 3rd Qu.:164.0 3rd Qu.:2.000 3rd Qu.:3.000 3rd Qu.:4.000
## Max. :450.0 Max. :3.000 Max. :7.000 Max. :5.000
## tipo barrio longitud latitud
## Length:6070 Length:6070 Min. :-76.59 Min. :3.333
## Class :character Class :character 1st Qu.:-76.54 1st Qu.:3.381
## Mode :character Mode :character Median :-76.53 Median :3.413
## Mean :-76.53 Mean :3.418
## 3rd Qu.:-76.52 3rd Qu.:3.452
## Max. :-76.46 Max. :3.497
Dadas las disminuciones de registros por outliers se tienen cambios representativos, como por ejemplo, el precio metro cuadrado tiene un maximo actual de 1000 millones de pesos, donde anteriormente se encontraba cerca de los 2000; el area construida paso de 1745 a 450 metros cuadrados; los parqueaderos, baños y habitaciones pasaron de tener 10 unidades a 3, 7 y 5 respectivamente.
Con lo anterior, se da paso a la aplicacion de los distintos modelos solicitados por el ejercicio, haciendo uso del dataset modificado.
Acorde a lo explicado en el material de la clase, se deben de separar las variables numericas de las categoricas y normalizar. De esta manera:
df_2_num <- df_sin_outliers[sapply(df_sin_outliers, function(x) class(x))=='numeric']
df_2_num <- select(df_2_num, -longitud, -latitud, -id) #Se eliminan latitud, longitud e id al no ser representativas
head(df_2_num)
## piso preciom areaconst parqueaderos banios habitaciones
## 1 3.77 320 120 1 2 3
## 2 3.77 350 220 2 2 4
## 3 2.00 400 280 3 5 3
## 4 1.00 260 90 1 2 3
## 5 1.00 240 87 1 3 3
## 6 1.00 220 52 2 2 3
# Se estandarizan las variables numericas
df_2_num_Z <- scale(df_2_num)
head(df_2_num_Z)
## piso preciom areaconst parqueaderos banios habitaciones
## [1,] 0.2926144 -0.09365885 -0.1490748 -1.0506033 -0.6876025 -0.308998
## [2,] 0.2926144 0.05877420 1.1177550 0.7554056 -0.6876025 0.983640
## [3,] -0.9734572 0.31282929 1.8778528 2.5614145 2.0546755 -0.308998
## [4,] -1.6887518 -0.39852496 -0.5291237 -1.0506033 -0.6876025 -0.308998
## [5,] -1.6887518 -0.50014700 -0.5671286 -1.0506033 0.2264902 -0.308998
## [6,] -1.6887518 -0.60176904 -1.0105190 0.7554056 -0.6876025 -0.308998
# aplicacion de PCA
sct_pca <- prcomp(df_2_num_Z)
sct_pca
## Standard deviations (1, .., p=6):
## [1] 1.7512906 1.0203090 0.8991086 0.7389889 0.5836865 0.4435761
##
## Rotation (n x k) = (6 x 6):
## PC1 PC2 PC3 PC4 PC5
## piso -0.09327843 0.89205812 0.3979668 -0.1512224 0.10426720
## preciom 0.48482710 0.22483546 -0.1362132 0.4588239 0.08310017
## areaconst 0.49629283 -0.09689301 0.1351241 0.1401768 0.69896934
## parqueaderos 0.34255955 0.25002558 -0.7029700 -0.5646017 -0.01518162
## banios 0.49161654 0.08650403 0.1362144 0.2489122 -0.69850956
## habitaciones 0.38846026 -0.27257538 0.5404523 -0.6051698 -0.07428647
## PC6
## piso -0.05842963
## preciom 0.69167384
## areaconst -0.46673223
## parqueaderos -0.08347319
## banios -0.42708657
## habitaciones 0.33311200
fviz_pca_ind(sct_pca, geom.ind = "point",
col.ind = "blue",
axes = c(1, 2),
pointsize = 1.5)
fviz_eig(sct_pca, addlabels = TRUE)
En este caso el primer componente principal explica el 51.1% de la variabilidad contenida en la base de datos y entre los dos primeros se casi el 70% de los datos (68.5), lo cual indicaría que con solo una variable (CP1) que se obtiene mediante una combinación lineal de las variables se puede resumir gran parte de la variabilidad que contiene la base de datos.
fviz_pca_var(sct_pca,
col.var = "contrib",
repel = TRUE # Evita la superposición de etiquetas
)
Al visualizar las variables, se observa que el PC1 esta asociado principalmente con Preciom y banios
Clasificar las propiedades residenciales en segmentos homogéneos con atributos similares con el fin de comprender las dinámicas y necesidades específicas en diversas áreas urbanas y en diferentes estratos socioeconómicos. Se realizaran tres análisis de Conglomerados teniendo en cuenta el precio de la vivienda en función del área, la cantidad de baños y la cantidad de habitaciones respectivamente:
# Estandarizacion de precio, área y zona
precio_area <- df_sin_outliers %>% select(preciom, areaconst)
c_precio_area <- as.data.frame(scale(precio_area))
c_precio_area$zona <- df_sin_outliers$zona
# Calcular distancia euclidiana
dist_precio_area <- dist(c_precio_area, method = 'euclidean')
# Cluster con método complete
cl_precio_area <- hclust(dist_precio_area, method = 'complete')
# Determinar la pertenencia de cada observación
cl_assigments_precio_area <- cutree(cl_precio_area, k = 4)
# Asignar los clusters
cassign_precio_area <- c_precio_area %>%
mutate(cluster = as.factor(cl_assigments_precio_area))
# Gráfico de puntos
ggplot(cassign_precio_area, aes(x = areaconst, y = preciom, color = cluster)) +
geom_point(size = 2, alpha = 0.5) +
geom_text(aes(label = cluster), vjust = -.8) +
theme_classic()
# Dendograma
plot(cl_precio_area, cex = 0.6, main = "Dendograma Precio - Area", las=1,
ylab = "Distancia euclidiana", xlab = "Grupos")
rect.hclust(cl_precio_area, k = 2, border = 2:5)
A simple vista, al observar el agrupamiento de área y precio, se nota
una considerable densidad de viviendas en el grupo 1, donde estas dos
variables están altamente correlacionadas. Le siguen los grupos 4, 3 y
2.
En este contexto, el dendrograma no resulta ser una herramienta útil para comprender los datos, debido a la diversidad de resultados que presenta.
# Estandarizacion de precio, área y zona
precio_banios <- df_sin_outliers %>% select(preciom, banios)
c_precio_banios <- as.data.frame(scale(precio_banios))
c_precio_banios$zona <- df_sin_outliers$zona
# Calcular distancia euclidiana
dist_precio_banios <- dist(c_precio_banios, method = 'euclidean')
# Cluster con método complete
cl_precio_banios <- hclust(dist_precio_banios, method = 'complete')
# Determinar la pertenencia de cada observación
cl_assigments_precio_banios <- cutree(cl_precio_banios, k = 4)
# Asignar los clusters
cassign_precio_banios <- c_precio_banios %>%
mutate(cluster = as.factor(cl_assigments_precio_banios))
# Gráfico de puntos
ggplot(cassign_precio_banios, aes(x = banios, y = preciom, color = cluster)) +
geom_point(size = 2, alpha = 0.5) +
geom_text(aes(label = cluster), vjust = -.8) +
theme_classic()
# Dendograma
plot(cl_precio_banios, cex = 0.6, main = "Dendograma precio - banios", las=1,
ylab = "Distancia euclidiana", xlab = "Grupos")
rect.hclust(cl_precio_area, k = 2, border = 2:5)
El análisis del conglomerado de baños frente al precio revela un
comportamiento similar en los clústeres 1 y 2 al compararlo con el
conglomerado de área frente al precio.
Por otro lado, los clústeres 3 y 4, aunque menos densos, muestran una concentración importante. Esto sugiere que la variable de cantidad de baños está fuertemente relacionada y tiene un gran impacto en el precio de venta de las viviendas.
Una vez más, en este caso el dendrograma no resulta ser una herramienta útil para comprender los datos.
# Estandarizacion de precio, área y zona
precio_habitaciones <- df_sin_outliers %>% select(preciom, habitaciones)
c_precio_habitaciones <- as.data.frame(scale(precio_habitaciones))
c_precio_habitaciones$zona <- df_sin_outliers$zona
# Calcular distancia euclidiana
dist_precio_habitaciones <- dist(c_precio_habitaciones, method = 'euclidean')
# Cluster con método complete
cl_precio_habitaciones <- hclust(dist_precio_habitaciones, method = 'complete')
# Determinar la pertenencia de cada observación
cl_assigments_precio_habitaciones <- cutree(cl_precio_habitaciones, k = 4)
# Asignar los clusters
cassign_precio_habitaciones <- c_precio_habitaciones %>%
mutate(cluster = as.factor(cl_assigments_precio_habitaciones))
# Gráfico de puntos
ggplot(cassign_precio_habitaciones, aes(x = habitaciones, y = preciom, color = cluster)) +
geom_point(size = 2, alpha = 0.5) +
geom_text(aes(label = cluster), vjust = -.8) +
theme_classic()
Se puede entrever a primera vista que los cluster 2 y 1, tienen una
caracterizacion peculiar al no tener habitaciones, haciendo referencia a
los apartaestudios.
#Analisis de correspondencia
Se llevara a cabo un análisis de correspondencia para las variables categóricas: tipo, zona y estrato, no se escoge barrio dada a su cantidad de variables.
# Seleccionar todas las variables categóricas para el análisis de correspondencia
categorias <- df_sin_outliers %>% select(tipo, zona, estrato)
# Realizar el análisis de correspondencia múltiple (ACM)
resultados <- MCA(categorias)
En la gráfica anterior se pueden denotar las siguientes aspectos generales: - El estrato 6 esta ubicado en su mayoría en la zona oeste y es conformado por apartamentos. - El estrato 3 esta ubicado en las zonas norte y centro, conformado en su mayoría de casas - Los estratos 4 y 5 se encuentran en las zonas sur y norte, conformado en su mayoría por apartamentos.
# Gráfico de contribución al primer y segundo eje del ACM tipo-zona-estrato
fviz_mca_var(resultados, col.var = "contrib",
title = "Contribución al Primer y Segundo Eje ")
var_resultados <-resultados$eig
var_resultados
## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.5439507 20.398151 20.39815
## dim 2 0.4602130 17.257987 37.65614
## dim 3 0.3679552 13.798320 51.45446
## dim 4 0.3333363 12.500113 63.95457
## dim 5 0.3239211 12.147043 76.10161
## dim 6 0.2765950 10.372314 86.47393
## dim 7 0.2070853 7.765698 94.23962
## dim 8 0.1536100 5.760375 100.00000
fviz_screeplot(resultados, addlabels = TRUE, ylim = c(0, 25))+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")
El gráfico anterior ilustra la contribución de las 8 dimensiones
obtenidas tras llevar a cabo el análisis de componentes para las
variables zona, tipo y estrato. La primera dimensión captura el 20.4% de
la variabilidad total, y las dos primeras dimensiones están
representadas en el plano factorial. En conjunto, estos dos primeros
ejes explican el 37.7% de la variabilidad presente en los datos.
Nota: Para reducir la dimensionalidad se quiso realizar un acm con la variable tipo y estrato o tipo y zona, sin embargo la variabilidad era representada en una sola dimension por lo cual no se ejecutaria como un buen ejercicio; estableciendo la0 unica relacion posible entre estrato y zona
# Se crea la tabla de contingencia para el analisis entre estrato y zona
est_zona <- table(df_sin_outliers$zona, df_sin_outliers$estrato)
colnames(est_zona) <- c("Estrato3", "Estrato4", "Estrato5", "Estrato6" )
est_zona
##
## Estrato3 Estrato4 Estrato5 Estrato6
## Zona Centro 64 7 3 0
## Zona Norte 502 315 536 117
## Zona Oeste 42 68 214 479
## Zona Oriente 191 5 2 0
## Zona Sur 290 1339 1320 576
chisq.test(est_zona) # test chi-squere
##
## Pearson's Chi-squared test
##
## data: est_zona
## X-squared = 2606.5, df = 12, p-value < 2.2e-16
acm_est_zona <- CA(est_zona)
El análisis ACM con las variables estrato y zona, permite observar que
el estrato 6 esta concentrado en la zona oeste del municipio, el estrato
4 y 5 en la zonas norte y sur, mientras que el estrato 3 pertenece mas a
la zona centro y oriente.
valores_est_zona <-acm_est_zona$eig
valores_est_zona
## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.28558054 66.506700 66.50670
## dim 2 0.13722621 31.957578 98.46428
## dim 3 0.00659441 1.535722 100.00000
fviz_screeplot(acm_est_zona, addlabels = TRUE, ylim = c(0, 80))+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")
Los resultados indican que la primera componente resume el 66.5%, mientras que los dos primeros ejes resumen un 98.5% de los datos