Cargamos las bases y las librerias

Base y estructura

Aunque las base contiene un total de 13 variables, algunas de ellas no son de nuestro interes para el analisis, aún más teniendo en cuenta que filtraremos los datos para la zona norte y el tipo Casa.

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>
base1 <- subset(vivienda, zona == "Zona Norte" & tipo == "Casa")

Correlaciones

Podemos observar que existe una alta corrrelación entre el precio y el área construida, así como con las variables estrato y Baños.

head(base1)
## # A tibble: 6 × 13
##      id zona    piso  estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <chr>   <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  1209 Zona N… 02          5     320       150            2      4            6
## 2  1592 Zona N… 02          5     780       380            2      3            3
## 3  4057 Zona N… 02          6     750       445           NA      7            6
## 4  4460 Zona N… 02          4     625       355            3      5            5
## 5  6081 Zona N… 02          5     750       237            2      6            6
## 6  7824 Zona N… 02          4     600       160            1      4            5
## # ℹ 4 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>
ggpairs(base1[,3:9], title=" ") 
## Warning: Removed 372 rows containing missing values or values outside the scale range
## (`stat_boxplot()`).
## Removed 372 rows containing missing values or values outside the scale range
## (`stat_boxplot()`).
## Removed 372 rows containing missing values or values outside the scale range
## (`stat_boxplot()`).
## Removed 372 rows containing missing values or values outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 96 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 372 rows containing missing values or values outside the scale range
## (`stat_boxplot()`).
## Removed 372 rows containing missing values or values outside the scale range
## (`stat_boxplot()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
## Removed 287 rows containing missing values
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
## Removed 287 rows containing missing values
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
## Removed 287 rows containing missing values
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 287 rows containing non-finite outside the scale range
## (`stat_bin()`).
## Warning: Removed 287 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Removed 287 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Removed 287 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 287 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
## Removed 287 rows containing missing values

## Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
## Removed 287 rows containing missing values
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 287 rows containing missing values or values outside the scale range
## (`geom_point()`).
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 287 rows containing missing values or values outside the scale range
## (`geom_point()`).

Tratamiento de outliers y NA

Utilizaremos el método de Winzorización para estandarizar la base, imputando a los faltantes con 1 debido a que es difícil o improbable que existan casas con 0 baños, 0 habitaciones o demás variables que puedan truncar nuestro analisis. Con este método podemos observar que las correlaciones de las variables mencionadas anteriormente aumentan.

columnas_no_numericas <- sapply(base1, function(x) !is.numeric(x))
print(names(base1)[columnas_no_numericas])
## [1] "zona"   "piso"   "tipo"   "barrio"
base1[columnas_no_numericas] <- lapply(base1[columnas_no_numericas], as.numeric)
## Warning in lapply(base1[columnas_no_numericas], as.numeric): NAs introducidos
## por coerción

## Warning in lapply(base1[columnas_no_numericas], as.numeric): NAs introducidos
## por coerción

## Warning in lapply(base1[columnas_no_numericas], as.numeric): NAs introducidos
## por coerción
base1[is.na(base1)] <- 1

base2 <- as.data.frame(lapply(base1, Winsorize))


ggpairs(base2[,3:9], title=" ")

## Mapa

En el mapa aparecen unos puntos por fuera de la zona norte, esto se puede deber a la imputación del barrio por parte del capturador de información, dicho error se puede soluccionar con un método de corrección de georeferenciación con la dirección del inmueble.

datos <- data.frame(
  latitud = base2$latitud,
  longitud = base2$longitud
)

mapa <- leaflet(data = datos) %>%
  addTiles() %>%  
  addMarkers(~longitud, ~latitud, clusterOptions = markerClusterOptions())  

mapa

Verificación

Verificamos los mínimos y máximos para nuestra base y procedemos con los analísis.

summary(base2)
##        id              zona        piso          estrato         preciom     
##  Min.   : 206.2   Min.   :1   Min.   :1.000   Min.   :3.000   Min.   :145.0  
##  1st Qu.: 766.2   1st Qu.:1   1st Qu.:1.000   1st Qu.:3.000   1st Qu.:261.2  
##  Median :2257.0   Median :1   Median :1.000   Median :4.000   Median :390.0  
##  Mean   :2532.0   Mean   :1   Mean   :1.468   Mean   :4.202   Mean   :430.7  
##  3rd Qu.:4225.0   3rd Qu.:1   3rd Qu.:2.000   3rd Qu.:5.000   3rd Qu.:550.0  
##  Max.   :6135.1   Max.   :1   Max.   :3.000   Max.   :6.000   Max.   :928.5  
##    areaconst      parqueaderos       banios       habitaciones        tipo  
##  Min.   : 75.0   Min.   :1.000   Min.   :2.000   Min.   :3.000   Min.   :1  
##  1st Qu.:140.0   1st Qu.:1.000   1st Qu.:2.000   1st Qu.:3.000   1st Qu.:1  
##  Median :240.0   Median :1.000   Median :3.000   Median :4.000   Median :1  
##  Mean   :254.2   Mean   :1.633   Mean   :3.546   Mean   :4.557   Mean   :1  
##  3rd Qu.:336.8   3rd Qu.:2.000   3rd Qu.:4.000   3rd Qu.:5.000   3rd Qu.:1  
##  Max.   :535.5   Max.   :4.000   Max.   :6.000   Max.   :8.000   Max.   :1  
##      barrio     longitud         latitud     
##  Min.   :1   Min.   :-76.54   Min.   :3.386  
##  1st Qu.:1   1st Qu.:-76.53   1st Qu.:3.452  
##  Median :1   Median :-76.52   Median :3.468  
##  Mean   :1   Mean   :-76.52   Mean   :3.461  
##  3rd Qu.:1   3rd Qu.:-76.50   3rd Qu.:3.482  
##  Max.   :1   Max.   :-76.49   Max.   :3.489
table(base2$zona)
## 
##   1 
## 722
table(base2$tipo)
## 
##   1 
## 722
table(base2$barrio)
## 
##   1 
## 722

Gráfico de torta

Al menos 2/3 de nuestros datos se úbican en los estratos 4, 5 y 6, lo que corresponde con el segmento de altos ingresos que es el objeto de nuestro analísis.

colores_personalizados <- c("#ffbc42", "#0496ff", "#d81159", "#8f2d56")
frecuencia_estrato <- table(base2$estrato)
pie(frecuencia_estrato, 
    labels = paste(names(frecuencia_estrato), "\n", frecuencia_estrato), 
    main = "Distribución de Estratos",
    col = colores_personalizados)

## Correlaciones interactivas

Como era de esperarse, a mayor precio mayor es el área construida y el estrato, este graáfico puede ser usado por el vendedor para identificar con el cliente su mejor posibilidad dado el recurso disponible, e incluso identificar datos atipicos para compras inmediatas.

scatter_plot <- plot_ly(data = base2, x = ~areaconst, y = ~preciom, mode = "markers",
                        marker = list(color = ~estrato, colorscale = "Viridis"),
                        text = ~paste("Estrato: ", estrato, "<br>Precio $", preciom),
                        hoverinfo = "text") %>%
  layout(title = "Relación entre área construida y Precio",
         xaxis = list(title = "Área Construida"),
         yaxis = list(title = "Precio"))

scatter_plot
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter

Contorno

En el gráfico de contornos verificamos el razonamiento anterior y se puede utilizar como presentación en la sala de ventas con la respectiva explicación de los colores.

contour_plot <- plot_ly(data = base2, x = ~areaconst, y = ~preciom, z = ~estrato,
                        type = "contour",
                        colorscale = "Viridis",
                        colorbar = list(title = "Estrato"),
                        contours = list(coloring = "heatmap"),
                        hoverinfo = "text",
                        text = ~paste("Estrato: ", estrato, "<br>Precio $", preciom, "<br>Área Construida: ", areaconst))


contour_plot <- contour_plot %>%
  layout(title = "Contorno de Precio y Área Construida según Estrato",
         xaxis = list(title = "Área Construida"),
         yaxis = list(title = "Precio"))


contour_plot

Box

Así mismo los gráficos de cajas y bigotes pueden servirle al vendedor para identificar los maximos, mínimos y medias de forma rápida e interactiva.

boxplot_precio <- plot_ly(data = base2, y = ~preciom, type = "box", name = "Precio")
boxplot_banios <- plot_ly(data = base2, y = ~banios, type = "box", name = "Baños")
boxplot_habitaciones <- plot_ly(data = base2, y = ~habitaciones, type = "box", name = "Habitaciones")
boxplot_area <- plot_ly(data = base2, y = ~areaconst, type = "box", name = "Área Construida")
boxplot_estrato <- plot_ly(data = base2, y = ~estrato, type = "box", name = "Estrato")


boxplot_precio <- boxplot_precio %>% layout(title = "Boxplot de Precio")
boxplot_banios <- boxplot_banios %>% layout(title = "Boxplot de Baños")
boxplot_habitaciones <- boxplot_habitaciones %>% layout(title = "Boxplot de Habitaciones")
boxplot_area <- boxplot_area %>% layout(title = "Boxplot de Área Construida")
boxplot_estrato <- boxplot_estrato %>% layout(title = "Boxplot de Estrato")

subplot(boxplot_precio, boxplot_banios, boxplot_habitaciones, boxplot_area, boxplot_estrato)

Modelo 1

En el ajuste del primer modelo observamos un R2 de 0.73, con al menos 4 variables significativas incluidas el intercepto. En este modelo podemos observar que el cambio en el estrato puede representar un costo adicional de un inmubele en hasta 76.5 millones, un metro más de area construida en 0.86 millones y un baño adicional puede representar hasta 23.4 millones. En los análisis posteriores intentaremos mejorar este modelo.

modelo1 <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = base2)
summary(modelo1)
## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = base2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -320.70  -68.68  -13.17   50.47  483.08 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -195.05217   22.75891  -8.570  < 2e-16 ***
## areaconst       0.85809    0.04338  19.782  < 2e-16 ***
## estrato        76.55798    5.43041  14.098  < 2e-16 ***
## habitaciones   -1.19788    3.63388  -0.330    0.742    
## parqueaderos    5.06191    4.90856   1.031    0.303    
## banios         23.42380    4.65086   5.036 6.01e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 113.5 on 716 degrees of freedom
## Multiple R-squared:  0.7285, Adjusted R-squared:  0.7266 
## F-statistic: 384.3 on 5 and 716 DF,  p-value: < 2.2e-16

Modelo 2

En el modelo 2 podemos observar una leve mejoría de hasta 2% en la capacidad de predicción del modelo usando las variables estadisticamente significativas.Tambien observamos un aumento de los coeficientes.

set.seed(123)
indices_entrenamiento <- createDataPartition(base2$preciom, p = 0.7, list = FALSE)
datos_entrenamiento <- base2[indices_entrenamiento, ]
datos_prueba <- base2[-indices_entrenamiento, ]
modelo2 <- lm(preciom ~ areaconst + estrato + banios, data = datos_entrenamiento)
summary(modelo2)
## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + banios, data = datos_entrenamiento)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -309.36  -69.80  -12.72   50.77  479.21 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -210.00168   22.86463  -9.185  < 2e-16 ***
## areaconst      0.88822    0.04945  17.961  < 2e-16 ***
## estrato       78.63187    6.13426  12.818  < 2e-16 ***
## banios        24.90111    4.58869   5.427 8.94e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 112.5 on 503 degrees of freedom
## Multiple R-squared:  0.7412, Adjusted R-squared:  0.7397 
## F-statistic: 480.3 on 3 and 503 DF,  p-value: < 2.2e-16
predicciones <- predict(modelo2, newdata = datos_prueba)
head(predicciones)
##        2        6        7        9       10       11 
## 595.3828 346.2447 460.4052 217.8106 462.0698 207.1831
summary(predicciones)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   142.3   249.0   443.9   438.1   578.1   886.8
plot(predicciones)

## Predicciones vs Datos reales

En esta gráfica podemos ver como los puntos de predicción se ajustan a la línea de tendencia.

ggplot(datos_prueba, aes(x = preciom, y = predicciones)) +
  geom_point(aes(color = "Predicción")) +  
  geom_point(aes(y = preciom, color = "Real")) +  
  geom_abline(intercept = 0, slope = 1, color = "blue", linetype = "dashed") +  
  labs(x = "Precio Real", y = "Predicción") +  
  ggtitle("Modelo Base vs Predicción") +  
  theme_minimal() +  
  scale_color_manual(values = c("blue", "red"), 
                     labels = c("Real", "Predicción")) +  
  guides(color = guide_legend(title = "Datos"))  

base3 <- base2[, !(names(base1) %in% c("id", "longitud", "latitud", "zona", "tipo", "barrio"))]

Bosque Aleatorio

Mediante el modelo de Bosque aleatorio pasaremos a confirmar que nuestra elección de variables es la mejor posible dado la explicación que puede alcanzar el modelo dadola combinación de distintos árboles. Dicho resultado nos confirma la elección de variables con un 70% de la varianza explicada.

library(randomForest)
## Warning: package 'randomForest' was built under R version 4.3.3
## randomForest 4.7-1.1
## Type rfNews() to see new features/changes/bug fixes.
## 
## Attaching package: 'randomForest'
## The following object is masked from 'package:dplyr':
## 
##     combine
## The following object is masked from 'package:gridExtra':
## 
##     combine
## The following object is masked from 'package:ggplot2':
## 
##     margin
predictores <- base3[, -which(names(base3) == "preciom")]  
objetivo <- base3$preciom  # Variable 'preciom'

modelo_rf <- randomForest(x = predictores, y = objetivo)

print(modelo_rf)
## 
## Call:
##  randomForest(x = predictores, y = objetivo) 
##                Type of random forest: regression
##                      Number of trees: 500
## No. of variables tried at each split: 2
## 
##           Mean of squared residuals: 12605.82
##                     % Var explained: 73.24
importance <- importance(modelo_rf)
varImpPlot(modelo_rf)

print(modelo_rf$err.rate)
## NULL

COnlusiones

  1. Para la determinación del precio las variables más importantes son el estrato, el area construida y el número de baños, las demás variables con instrumentales a los principales determinantes del precio.

  2. Los vendedores pueden ofrecer a forma de marketing las demás carécteristicas sin que eso cambie de forma radical el precio.

  3. En el segmento de las casas para altos ingresos las variables habitaciones y otras variables que pudierán ser significativas para familias númerosas no tienen efecto en este segmento. Dicha tesis se podría confirmar con la tasa de fecundidad respecto al nivel de ingreso, estimando de forma inicial un comportamiento decreciente.