Actividad 1

Modelos Estadísticos para la toma de decisiones Evaluación de la oferta inmobiliaria urbana

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.

EDA - Exploratory Data Analysis

Cargue de Librerias

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)

#Dimension


dataFrame <- as.data.frame(vivienda)

cat("Número de filas:", nrow(dataFrame), "Número de columnas:", ncol(dataFrame), "\n")

## Número de filas: 8322 Número de columnas: 13

# clases de las variables
lapply(dataFrame, class)

## $id
## [1] "numeric"
## 
## $zona
## [1] "character"
## 
## $piso
## [1] "character"
## 
## $estrato
## [1] "numeric"
## 
## $preciom
## [1] "numeric"
## 
## $areaconst
## [1] "numeric"
## 
## $parqueaderos
## [1] "numeric"
## 
## $banios
## [1] "numeric"
## 
## $habitaciones
## [1] "numeric"
## 
## $tipo
## [1] "character"
## 
## $barrio
## [1] "character"
## 
## $longitud
## [1] "numeric"
## 
## $latitud
## [1] "numeric"

# cambiando tipo de datos
dataFrame$piso <- as.numeric(dataFrame$piso)
dataFrame$estrato <- as.factor(dataFrame$estrato)
dataFrame$parqueaderos <- as.numeric((dataFrame$parqueaderos))
lapply(dataFrame, class)

## $id
## [1] "numeric"
## 
## $zona
## [1] "character"
## 
## $piso
## [1] "numeric"
## 
## $estrato
## [1] "factor"
## 
## $preciom
## [1] "numeric"
## 
## $areaconst
## [1] "numeric"
## 
## $parqueaderos
## [1] "numeric"
## 
## $banios
## [1] "numeric"
## 
## $habitaciones
## [1] "numeric"
## 
## $tipo
## [1] "character"
## 
## $barrio
## [1] "character"
## 
## $longitud
## [1] "numeric"
## 
## $latitud
## [1] "numeric"

# Contar los NA por columna
num_nas <- colSums(is.na(dataFrame))
print(num_nas)

##           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

#Esta la tabla la muestro profe, dado que preferí no eliminar las columnas de piso y parqueadero, 
# esto debido a que en mi teoría, los inmuebles que no aparecen con piso pueden pertenecer a locales 
#comerciales que se encuentran sótanos (por ejemplo en los centros comerciales) o posiblemente un 
#apartamento en el sótano de una casa que suelen verse mucho en EEUU (basement)

subset_df <- dataFrame[is.na(dataFrame$piso), ]
subset_df

# Aplicando tecnica de redondeo y medias para asignar a valores NA y elimiando los valores no considerados

df_piso  <- round(mean(dataFrame$piso, na.rm = T),2)
df_parqueadero <- round(mean(dataFrame$parqueaderos, na.rm = T), 2)

dataFrame$piso[is.na(dataFrame$piso)] <- df_piso
dataFrame$parqueaderos[is.na(dataFrame$parqueaderos)] <- df_parqueadero


num_nas <- colSums(is.na(dataFrame))
num_nas

##           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

dataFrame <-  na.omit(dataFrame)
num_nas <- colSums(is.na(dataFrame))
num_nas

##           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

datos_long <- reshape2::melt(dataFrame)

## Using zona, estrato, tipo, barrio as id variables

boxplot(value ~ variable, data = datos_long, outline = TRUE)

# Graficar un boxplot para la variable "preciom"
boxplot(dataFrame$preciom, main = "Boxplot para estrato")

# Graficar un boxplot para la variable "areaconst"
boxplot(dataFrame$areaconst, main = "Boxplot para preciom")

#Se eliminan Outliers y se imprime nuevamente los boxplot
 
cuantiles_preciom <- quantile(dataFrame$preciom, probs = c(0.25, 0.75), na.rm = TRUE)
cuantiles_areaconst <- quantile(dataFrame$areaconst, probs = c(0.25, 0.75), na.rm = TRUE)
 
iqr_preciom <- cuantiles_preciom[2] - cuantiles_preciom[1]
iqr_areaconst <- cuantiles_areaconst[2] - cuantiles_areaconst[1]
 
umbral_superior_preciom <- cuantiles_preciom[2] + 1.5 * iqr_preciom
umbral_inferior_preciom <- cuantiles_preciom[1] - 1.5 * iqr_preciom

umbral_superior_areaconst <- cuantiles_areaconst[2] + 1.5 * iqr_areaconst
umbral_inferior_areaconst <- cuantiles_areaconst[1] - 1.5 * iqr_areaconst
 
filas_outliers_preciom <- dataFrame$preciom > umbral_superior_preciom | dataFrame$preciom < umbral_inferior_preciom
filas_outliers_areaconst <- dataFrame$areaconst > umbral_superior_areaconst | dataFrame$areaconst < umbral_inferior_areaconst
 
dataFrame <- dataFrame[!filas_outliers_preciom & !filas_outliers_areaconst, ]

# Graficar un boxplot para la variable "preciom"
boxplot(dataFrame$preciom, main = "Boxplot para estrato")

# Graficar un boxplot para la variable "areaconst"
boxplot(dataFrame$areaconst, main = "Boxplot para preciom")

Retos

El reto principal consisten en realizar un análisis integral y multidimensional de la base de datos para obtener una comprensión del mercado inmobiliario urbano. Se requiere aplicar diversas técnicas de análisis de datos

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.

# separando las variables numericas de las categoricas y normalizando
df_2_num <- dataFrame[sapply(dataFrame, function(x) class(x))=='numeric'] 
df_2_num <- select(df_2_num, -longitud, -latitud, -id)  
head(df_2_num)

# 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.004079537 -0.52833591 -0.8284738   -0.8744757  0.06778087    1.7981729
## 2 -0.004079537 -0.18893023 -0.2828522   -0.8744757 -0.72628353   -0.3659256
## 3 -0.004079537 -0.04347066  0.8083909    0.3981445 -0.72628353    0.3554406
## 4 -0.827322434  0.19896197  1.4631367    1.6707647  1.65590965   -0.3659256
## 5 -1.292431415 -0.47984939 -0.6102252   -0.8744757 -0.72628353   -0.3659256
## 6 -1.292431415 -0.57682244 -0.6429625   -0.8744757  0.06778087   -0.3659256

# aplicacion de PCA

sct_pca <- prcomp(df_2_num_Z)
sct_pca

## Standard deviations (1, .., p=6):
## [1] 1.7506119 1.0316251 0.9180717 0.7179554 0.5711413 0.4319602
## 
## Rotation (n x k) = (6 x 6):
##                     PC1         PC2         PC3        PC4         PC5
## piso          0.1211821 -0.80791409  0.53279453  0.1729430  0.12392594
## preciom      -0.4639556 -0.33058380 -0.17545654 -0.4858193  0.03350917
## areaconst    -0.5030510  0.07540466  0.06509377 -0.1581929  0.70346184
## parqueaderos -0.3607436 -0.29358837 -0.57262459  0.6697076 -0.06178913
## banios       -0.4927156 -0.04214365  0.22537123 -0.1929019 -0.69573759
## habitaciones -0.3795986  0.37991195  0.54992425  0.4725737  0.02814682
##                      PC6
## piso         -0.05876030
## preciom       0.63838180
## areaconst    -0.46597541
## parqueaderos -0.05869207
## banios       -0.42825349
## habitaciones  0.43015928

fviz_pca_ind(sct_pca, geom.ind = "point", 
             col.ind = "blue", 
             axes = c(1, 2), 
             pointsize = 1.5)

fviz_eig(sct_pca, addlabels = TRUE)

fviz_pca_var(sct_pca,
col.var = "contrib",
repel = TRUE   
)

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.

# Estandarizacion de precio, área y zona
precio_area <- dataFrame %>% select(preciom, areaconst)
c_precio_area <- as.data.frame(scale(precio_area))
c_precio_area$zona <- dataFrame$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)

# Estandarizacion de precio, área y zona
precio_banios <- dataFrame %>% select(preciom, banios)
c_precio_banios <- as.data.frame(scale(precio_banios))
c_precio_banios$zona <- dataFrame$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)

# Estandarizacion de precio, área y zona
precio_habitaciones <- dataFrame %>% select(preciom, habitaciones)
c_precio_habitaciones <- as.data.frame(scale(precio_habitaciones))
c_precio_habitaciones$zona <- dataFrame$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()

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.

# Seleccionar todas las variables categóricas para el análisis de correspondencia
categorias <- dataFrame %>% select(tipo, zona, estrato)

# Realizar el análisis de correspondencia múltiple (ACM)
resultados <- MCA(categorias)

# 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.5702573              21.384651                          21.38465
## dim 2  0.4537296              17.014861                          38.39951
## dim 3  0.3742155              14.033080                          52.43259
## dim 4  0.3333357              12.500089                          64.93268
## dim 5  0.3162102              11.857882                          76.79056
## dim 6  0.2648973               9.933648                          86.72421
## dim 7  0.2087617               7.828563                          94.55277
## dim 8  0.1452594               5.447227                         100.00000

fviz_screeplot(resultados, addlabels = TRUE, ylim = c(0, 25))+ggtitle("")+
  ylab("Porcentaje de varianza explicado") + xlab("Ejes")

# Se crea la tabla de contingencia para el analisis entre estrato y zona
est_zona <- table(dataFrame$zona, dataFrame$estrato)
colnames(est_zona) <- c("Estrato3", "Estrato4", "Estrato5", "Estrato6" )
est_zona

##               
##                Estrato3 Estrato4 Estrato5 Estrato6
##   Zona Centro       103       11        4        1
##   Zona Norte        565      397      718      142
##   Zona Oeste         52       80      257      564
##   Zona Oriente      328        7        2        0
##   Zona Sur          375     1585     1612      765

chisq.test(est_zona) # test chi-squere

## 
##  Pearson's Chi-squared test
## 
## data:  est_zona
## X-squared = 3418.3, df = 12, p-value < 2.2e-16

acm_est_zona <- CA(est_zona)

valores_est_zona <-acm_est_zona$eig
valores_est_zona

##        eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.315159713              69.775012                          69.77501
## dim 2 0.126947048              28.105533                          97.88055
## dim 3 0.009573151               2.119455                         100.00000

fviz_screeplot(acm_est_zona, addlabels = TRUE, ylim = c(0, 80))+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")

Modelos Estadisticos. Actividad 1 - Evaluación de la oferta inmobiliaria urbana

Jesus Olier

2024-02-15