Regresion Lineal Multiple

Preparación de los datos

Inicialmente se instalan las librerías e importa la base de datos “vivienda” y se visualiza las caracteristicas para 3 registros.

library(paqueteMODELOS)
library(tidyverse)
library(ggplot2)
library(cluster)
library(knitr)
library(naniar)
library(dplyr)
library(psych)
library(tidyr)
data(vivienda)
head(vivienda,3)
## # A tibble: 3 × 13
##      id zona    piso  estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <chr>   <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  1147 Zona O… <NA>        3     250        70            1      3            6
## 2  1169 Zona O… <NA>        3     320       120            1      2            3
## 3  1350 Zona O… <NA>        3     350       220            2      2            4
## # ℹ 4 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>
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")=
##   .. cols(
##   ..   id = col_double(),
##   ..   zona = col_character(),
##   ..   piso = col_character(),
##   ..   estrato = col_double(),
##   ..   preciom = col_double(),
##   ..   areaconst = col_double(),
##   ..   parqueaderos = col_double(),
##   ..   banios = col_double(),
##   ..   habitaciones = col_double(),
##   ..   tipo = col_character(),
##   ..   barrio = col_character(),
##   ..   longitud = col_double(),
##   ..   latitud = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>
library(lmtest)

Punto 1

Realice un filtro a la base de datos e incluya solo las ofertas de: base1: casas, de la zona norte de la ciudad. Presente los primeros 3 registros de las bases y algunas tablas que comprueben la consulta. (Adicional un mapa con los puntos de las bases. Discutir si todos los puntos se ubican en la zona correspondiente o se presentan valores en otras zonas, por que?).

base1<-subset(vivienda, tipo == "Casa" & zona == "Zona Norte")
kable(head(base1,3)) # 3 registros de base1
id zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo barrio longitud latitud
1209 Zona Norte 02 5 320 150 2 4 6 Casa acopi -76.51341 3.47968
1592 Zona Norte 02 5 780 380 2 3 3 Casa acopi -76.51674 3.48721
4057 Zona Norte 02 6 750 445 NA 7 6 Casa acopi -76.52950 3.38527

Zona Norte

base1tabla= table(base1$zona, base1$tipo)
kable(base1tabla, caption = "Tabla Zona Norte")
Tabla Zona Norte
Casa
Zona Norte 722

Mapa con los puntos de las bases

library(leaflet)
color <- colorFactor(palette = c("red"), domain = base1$zona)
mapa <- leaflet(base1) %>% # se crea el mapa con las Casas según su latitud y longitud según el color asignado.
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = ~color(zona), radius = 4)
mapa

En el mapa se puede observar algunas inconsistencias del lugar de algunas viviendas pues señalan su ubicación en la zona norte, pero su estrato y otras características como el precio pueden corresponder a otras zonas, por ejemplo, la zona sur. Esta inconsistencia puede atribuirse a deficiencias en la recolección de datos o una tabulación errónea de los datos que produce un input erratico de las coordenadas. Este fenomeno tambien se evidencia en otras zonas, pues existen datos de viviendas ubicadas en zonas distintas a la real. Ver mapa1.

casas <- vivienda

casas$base1 <- ifelse(vivienda$zona =="Zona Norte" & vivienda$tipo =="Casa", "Base 1", 
                         ifelse(vivienda$zona =="Zona Centro" & vivienda$tipo =="Casa", "Base 2",
                          ifelse(vivienda$zona =="Zona Oeste" & vivienda$tipo =="Casa", "Base 3",
                           ifelse(vivienda$zona =="Zona Oriente" & vivienda$tipo =="Casa", "Base 4",
                            ifelse(vivienda$zona == "Zona Sur" & vivienda$tipo == "Casa", "Base 5", "NA")))))
head(casas,3)
## # A tibble: 3 × 14
##      id zona    piso  estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <chr>   <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  1147 Zona O… <NA>        3     250        70            1      3            6
## 2  1169 Zona O… <NA>        3     320       120            1      2            3
## 3  1350 Zona O… <NA>        3     350       220            2      2            4
## # ℹ 5 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>,
## #   base1 <chr>
casas <- subset(casas, tipo == "Casa") # Filtrar unicamente las Casas

colores <- colorFactor(palette = "Set4", domain = casas$base1) #comando colorFactor() para asignar automáticamente un color distinto para cada nivel de la variable categórica

mapa1 <- leaflet(casas) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = ~colores(base1), radius = 4) # Mapa de las viviendas marcadas por su latitud y longitud y con el color asignado por la variable "base"
mapa1 # Mostrar el mapa1

Punto 2

Realice un análisis exploratorio de datos enfocado en la correlación entre la variable respuesta (precio de la casa) en función del área construida, estrato, numero de baños, numero de habitaciones y zona donde se ubica la vivienda. Use gráficos interactivos con el paquete plotly e interprete los resultados.

library(plotly)
## 
## Adjuntando el paquete: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
plot_ly(base1, x = ~preciom, y = ~areaconst, type = "histogram", fill = "pink", color = "green") %>%
  layout(title = "Area contruida")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'histogram' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'autobinx', 'autobiny', 'bingroup', 'cliponaxis', 'constraintext', 'cumulative', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'histfunc', 'histnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'nbinsx', 'nbinsy', 'offsetgroup', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textsrc', 'texttemplate', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'xaxis', 'xbins', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'yaxis', 'ybins', 'ycalendar', 'yhoverformat', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(casas$areaconst)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    30.0   154.0   240.0   273.4   350.0  1745.0

Existe una relacion inversa entre área construída y precios.

plot_ly(base1, x = ~preciom, y = ~estrato, type = "histogram", fill = "pink", color = "red") %>%
  layout(title = "Estrato")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'histogram' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'autobinx', 'autobiny', 'bingroup', 'cliponaxis', 'constraintext', 'cumulative', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'histfunc', 'histnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'nbinsx', 'nbinsy', 'offsetgroup', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textsrc', 'texttemplate', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'xaxis', 'xbins', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'yaxis', 'ybins', 'ycalendar', 'yhoverformat', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(casas$preciom)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##      77     300     430     540     670    1999
plot_ly(base1, x = ~preciom, y = ~banios, type = "histogram", fill = "pink", color = "green") %>%
  layout(title = "Numero de banos")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'histogram' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'autobinx', 'autobiny', 'bingroup', 'cliponaxis', 'constraintext', 'cumulative', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'histfunc', 'histnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'nbinsx', 'nbinsy', 'offsetgroup', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textsrc', 'texttemplate', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'xaxis', 'xbins', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'yaxis', 'ybins', 'ycalendar', 'yhoverformat', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(casas$banios)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   3.000   4.000   3.894   5.000  10.000
plot_ly(base1, x = ~preciom, y = ~habitaciones, type = "histogram", fill = "pink", color = "green") %>% layout(title = "Numero de habitaciones")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'histogram' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'autobinx', 'autobiny', 'bingroup', 'cliponaxis', 'constraintext', 'cumulative', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'histfunc', 'histnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'nbinsx', 'nbinsy', 'offsetgroup', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textsrc', 'texttemplate', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'xaxis', 'xbins', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'yaxis', 'ybins', 'ycalendar', 'yhoverformat', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(casas$habitaciones)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00    3.00    4.00    4.61    5.00   10.00
zonacasas <- casas %>%
  count(zona) # Nuevo objeto zonacasa

# Create the bar chart
plot_ly(zonacasas, x = ~zona, y = ~n, type = "bar", color = "blue") %>% layout(title = "Distribucion por Zona")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

Segun la distribución por zona, se observa la mayor participación de casas ubicadas en la zona sur, con un 60% del total.

cor <-base1[,c("preciom","areaconst","estrato","banios","habitaciones")]
ggpairs(cor, title="Correlacion entre variables", progress = FALSE)

La tabla de correlaciones muestra relaciones fuertes y positivas entre el precio de las viviendas, el área construida, el estrato, el número de baños y el número de habitaciones, con correlaciones mayores al 52%. Esta información es importante para el sector inmobiliario pues muestra las tendencias del mercado y las características más importantes para la construcción y comercialización de viviendas.

Punto 3

Estime un modelo de regresión lineal múltiple con las variables del punto anterior (precio = f(área construida, estrato, número de cuartos, número de parqueaderos, número de baños )) e interprete los coeficientes si son estadísticamente significativos. Las interpretaciones deber están contextualizadas y discutir si los resultados son lógicos. Adicionalmente interprete el coeficiente R2 y discuta el ajuste del modelo e implicaciones (que podrían hacer para mejorarlo).

regre = lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = casas)
summary(regre)
## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = casas)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1190.80  -114.52   -25.94    74.59   986.16 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -413.87536   25.58852 -16.174  < 2e-16 ***
## areaconst       0.74227    0.02941  25.235  < 2e-16 ***
## estrato       116.07109    5.26618  22.041  < 2e-16 ***
## habitaciones  -14.74995    3.18137  -4.636 3.73e-06 ***
## parqueaderos   64.29943    3.47719  18.492  < 2e-16 ***
## banios         39.03498    4.05083   9.636  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 205.2 on 2480 degrees of freedom
##   (733 observations deleted due to missingness)
## Multiple R-squared:  0.6834, Adjusted R-squared:  0.6828 
## F-statistic:  1071 on 5 and 2480 DF,  p-value: < 2.2e-16

Análisis de los resultados. La estimación de los coeficientes del modelo “casas”, muestra un R2 de 0.6834, es decir que el 68.34% de las variaciones del precio son explicadas por las variables independientes del modelo “casas”. Con respecto a los estimadores de los parámetros se destaca que todas las variables son significativas para el modelo. En general el modelo tiene un buen poder explicativo.

El modelo tiene la siguiente construcción: p=Bo+B1X1+B2X2+B3X3+B4X4+B5X5 Precio = -413.87536 + 0.74227(areaconst)+116.07109(estrato)+ 64.29943(parqueaderos)+39.03498(banios)-14.74995(habitaciones)

Intercepto: El coeficiente del intercepto es -413.87 lo cual significa que cuando todas las variables predictoras o independientes (área construida, estrato, habitaciones, parqueaderos y baños) son iguales a cero, el precio estimado de la vivienda sería de 413.87. En general, Bo es el valor esperado de la variable dependiente (precio) cuando las variables independientes toman el valor de cero. Área construida: El coeficiente de área construida es 0.7422. Significa que, por cada aumento unitario en el área construida, se espera un aumento de 0.7422 unidades en el precio de la vivienda, dejando las demás variables fijas. Es decir, a medida que aumenta el área construida, también aumenta el precio de la vivienda. Estrato: El coeficiente del estrato de 116.07 indica que las viviendas de estratos más altos tienden a tener un precio 116.07 unidades más alto que las viviendas de estratos más bajos, dejando las demás variables fijas.
Parqueaderos: El coeficiente de parqueaderos de 64.29 indica que, por cada parqueadero adicional, el precio de la vivienda se incrementa en 64.29 unidades monetarias, dejando las demás variables fijas. Es decir, el número de parqueaderos influye en el precio de la vivienda. Baños: El coeficiente de baños de 39.03 indica que por cada baño adicional el precio de la vivienda aumenta en 39.03 unidades monetarias, dejando las demás variables fijas. Al igual, que los parqueaderos, el número de baños también influye en el precio de la vivienda. Habitaciones: El coeficiente de habitaciones de 14.74995 indica que por cada habitación menos el precio de la vivienda disminuye en 14.74995 unidades monetarias, dejando las demás variables fijas. Es decir, las casas con menores habitaciones tienen un menor precio.

Sugerencias para mejorar el modelo: Incluir otras variables con poder explicativo, como podrían ser: años de antigüedad de la casa, zonas verdes, senderos peatonales, niveles de seguridad de la zona, y proximidad a centros comerciales, universidades, etc. Suprimir variables con poco poder explicativo que no aporten significativamente al modelo o integrarlas en un índice que agrupe varias variables. Todo esto, podría aumentar la efectividad del modelo al reducir la complejidad y centrarse en las características más influyentes en la determinación del precio de la vivienda. La simplificación del modelo puede llevar a una mayor precisión en las predicciones y facilitar su interpretación. Realizar una exploración más detallada de los datos para identificar posibles valores atípicos o datos faltantes que puedan afectar el modelo. Evaluar la multicolinealidad entre las variables predictoras para asegurarte de que no estén altamente correlacionadas. Probar diferentes transformaciones de las variables.

En resumen, para mejorar el modelo, se podría enriquecer con información relevante de variables externas a la vivienda y realizar una revisión exhaustiva para eliminar aquellas variables que no contribuyan de manera significativa. Estas acciones pueden aumentar la capacidad explicativa del modelo y su efectividad en la predicción de precios de viviendas, aunque en este modelo todos los coeficientes son estadísticamente significativos pues tienen un valor P inferior a 0.05.

Punto 4

Realice la validación de supuestos del modelo e interprete los resultados (no es necesario corregir en caso de presentar problemas, solo realizar sugerencias de que se podría hacer).

par(mfrow = c(2, 2))
plot(regre)

Como se evidencia en el grafico se violan los supuestos de linealidad y no autocorrelación debido al patron observado en la gráfica de residuals vs fitted, tambien se viola es supuesto de normalidad como se ve en la gráfica de los residuales, así mismo se viola el supuesto de homocedasticidad pues no se evidencia una varianza constante en la gráfica de Scale-Location.

res=regre$residuals
shapiro.test(res)
## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.89699, p-value < 2.2e-16

Dado que el test de Shapiro-Wilks plantea que la hipótesis nula de una muestra proviene de una distribución normal, es decir:

Ho: los residuos se distribuyen normalmente.

Ha: los residuos no se distribuyen normalmente.

Los resultados indican un valor de W 0.8966, es decir que los residuales se aproximan a una distribución normal (1), pero, como W 0.8966<1, existe eviencia que la distribución de los residuos se desvía en cierta medida de una distribución normal. Ademas, el valor p (< 2.2e-16) es mucho menor que el nivel de significancia, y por tanto se rechaza la hipótesis nula. En resumen, no hay suficiente evidencia para aceptar la hipótesis nula de normalidad según la prueba de Shapiro-Wilk, pues los residuos del modelo de regresión no siguen una distribución normal.

install.packages("lmtest")
## Warning: package 'lmtest' is in use and will not be installed
library(lmtest)

Validación de supuestos - Homocedasticidad

bptest(regre)
## 
##  studentized Breusch-Pagan test
## 
## data:  regre
## BP = 321.2, df = 5, p-value < 2.2e-16

Se aplica la prueba estadística Breusch-Pagan para detectar la presencia de heterocedasticidad del modelo de regresión, con las siguientes hipótesis:

Ho: Existe homocedasticidad (los residuos se distribuyen con varianza igual) Ha: Existe heterocedasticidad (los residuos no se distribuyen con varianza igual)

La prueba de Breusch-Pagan se utiliza con el proposito de determinar la presencia de homocedasticidad o heterocedasticidad en un modelo. En este modelo el valor p es mucho menor que el nivel de significancia alfa: 2.2e-16 < 0.05, es decir se rechaza Ho (existe heterocedasticidad) y por tanto los residuos no se distribuyen con una varianza constante.

Validación de supuestos - Independencia

dwtest(regre)
## 
##  Durbin-Watson test
## 
## data:  regre
## DW = 1.5759, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is greater than 0

Se utiliza la prueba Durbin-Watson para verificar la no autocorrelación de los residuos, con las siguientes hipótesis:

Ho: No hay evidencia de autocorrelación de primer orden en los residuos del modelo, es decir, no hay patrones sistemáticos de correlación en los errores. Ha: Hay evidencia de autocorrelación de primer orden en los residuos del modelo, es decir existen patrones sistemáticos de correlación en los errores.

El valor del estadístico DW es 1.5759, y dado que este estadístico tiene un valor cercano a 2 sugiere que podría existir autocorrelación positiva en los residuos, es decir, que los residuos podrían estar correlacionados positivamente entre sí. Respecto al Pvalue < 0.05 el valor p asociado al modelo es muy pequeño < 2.2e-16. Es decir, se confirma la presencia de autocorrelacion y por tanto se aprueba la Ha. Esto tiene implicaciones para la independencia de los residuos y podría afectar la validez de las inferencias realizadas en el modelo.

Punto 5

Con el modelo identificado debe predecir el precio de la vivienda con las características de la primera solicitud.

pre= data.frame(
  areaconst = 200,
  parqueaderos = 1,
  estrato = c(4, 5),
  banios = 2,
  habitaciones = 4)
pre #se realiza la predicción del precio utilizando los dos modelos creados previamente.
##   areaconst parqueaderos estrato banios habitaciones
## 1       200            1       4      2            4
## 2       200            1       5      2            4
predict(regre,pre)
##        1        2 
## 282.2318 398.3029

Segun el modelo una casa de 200 metros cuadrados, con 1 parqueadero, 2 baños, 4 habitaciones, de estrato 4 y ubicada en la zona Norte, tendria un precio estimado de 282 millones. Por su parte, una casa con las mismas características, pero de estrato 5, tendria un precio estimado de 398 millones.

Punto 6

Con las predicciones del modelo sugiera potenciales ofertas que responda a la solicitud de la vivienda 1. Tenga encuentra que la empresa tiene crédito pre-aprobado de máximo 350 millones de pesos. Realice un análisis y presente en un mapa al menos 5 ofertas potenciales que debe discutir.

oferta = filter(base1, areaconst >= 200, parqueaderos >= 1, banios >= 2, habitaciones >= 4, zona == "Zona Norte", estrato %in% c(4, 5), preciom <= 350)
oferta
## # A tibble: 34 × 13
##       id zona   piso  estrato preciom areaconst parqueaderos banios habitaciones
##    <dbl> <chr>  <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
##  1  4210 Zona … 01          5     350       200            3      3            4
##  2  4267 Zona … 01          5     335       202            1      4            5
##  3  4800 Zona … 01          5     340       250            2      4            4
##  4  4209 Zona … 02          5     350       300            3      5            6
##  5  4422 Zona … 02          5     350       240            2      3            6
##  6  4458 Zona … 02          4     315       270            2      4            4
##  7  4483 Zona … 02          5     342       250            1      4            6
##  8  1009 Zona … <NA>        5     250       243            1      4            5
##  9  1270 Zona … <NA>        5     350       203            2      2            5
## 10  3352 Zona … <NA>        4     335       300            3      4            4
## # ℹ 24 more rows
## # ℹ 4 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>
min(oferta$preciom)
## [1] 230
max(oferta$preciom)
## [1] 350
head(oferta,30)
## # A tibble: 30 × 13
##       id zona   piso  estrato preciom areaconst parqueaderos banios habitaciones
##    <dbl> <chr>  <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
##  1  4210 Zona … 01          5     350       200            3      3            4
##  2  4267 Zona … 01          5     335       202            1      4            5
##  3  4800 Zona … 01          5     340       250            2      4            4
##  4  4209 Zona … 02          5     350       300            3      5            6
##  5  4422 Zona … 02          5     350       240            2      3            6
##  6  4458 Zona … 02          4     315       270            2      4            4
##  7  4483 Zona … 02          5     342       250            1      4            6
##  8  1009 Zona … <NA>        5     250       243            1      4            5
##  9  1270 Zona … <NA>        5     350       203            2      2            5
## 10  3352 Zona … <NA>        4     335       300            3      4            4
## # ℹ 20 more rows
## # ℹ 4 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>

Al filtrar los datos se observa varias opciones que cumplen con la mayoría de las características solicitadas, pero no muy específicamente con lo requerido. Por ejemplo, la condición de 1 parqueadero y 2 baños no está disponible. Sin embargo, hay varias opciones con 3 baños y el resto de características que se adaptan a las condiciones del cliente.

colores<- colorFactor(palette = c( "blue"), domain = oferta$zona)

# se crea el mapa con las Casas según su latitud y longitud según el color marcado en el paso anterior.
mapa2 <- leaflet(oferta) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = ~colores(zona), radius = 4)

# Ver Mapa
mapa2

Punto 7

Realice los pasos del 1 al 6. Para la segunda solicitud que tiene un crédito pre-aprobado por valor de $850 millones.

base2<-subset(vivienda, tipo == "Apartamento" & zona == "Zona Sur")
kable(head(base2,3)) # 3 registros de base2
id zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo barrio longitud latitud
5098 Zona Sur 05 4 290 96 1 2 3 Apartamento acopi -76.53464 3.44987
698 Zona Sur 02 3 78 40 1 1 2 Apartamento aguablanca -76.50100 3.40000
8199 Zona Sur NA 6 875 194 2 5 3 Apartamento aguacatal -76.55700 3.45900 
base2tabla= table(base2$zona, base2$tipo)
kable(base2tabla, caption = "Tabla Zona Sur")
Tabla Zona Sur
Apartamento
Zona Sur 2787 
library(leaflet)
color <- colorFactor(palette = c("red"), domain = base2$zona)
mapa <- leaflet(base2) %>% # se crea el mapa con los apartamentos según su latitud y longitud según el color marcado.
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = ~color(zona), radius = 4)
mapa
apto <- vivienda
apto$base2 <- ifelse(vivienda$zona =="Zona Norte" & vivienda$tipo ==" Apartamento ", "Base 1", 
                         ifelse(vivienda$zona =="Zona Centro" & vivienda$tipo ==" Apartamento ", "Base2",
                          ifelse(vivienda$zona =="Zona Oeste" & vivienda$tipo ==" Apartamento ", "Base 3",
                           ifelse(vivienda$zona =="Zona Oriente" & vivienda$tipo ==" Apartamento ", "Base 4",
                            ifelse(vivienda$zona == "Zona Sur" & vivienda$tipo == " Apartamento ", "Base 5", "NA")))))
head(apto,3)
## # A tibble: 3 × 14
##      id zona    piso  estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <chr>   <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  1147 Zona O… <NA>        3     250        70            1      3            6
## 2  1169 Zona O… <NA>        3     320       120            1      2            3
## 3  1350 Zona O… <NA>        3     350       220            2      2            4
## # ℹ 5 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>,
## #   base2 <chr>
apto <- subset(apto, tipo == "Apartamento") # Filtrar unicamente los apartamentos
colores <- colorFactor(palette = "Set4", domain = apto$zona) 

#comando colorFactor() para asignar automáticamente un color distinto para cada nivel de la variable categórica
mapa2 <- leaflet(apto) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = ~colores(zona), radius = 4) # Mapa de las viviendas marcadas por su latitud y longitud y con el color asignado por la variable "base"
mapa2 # Mostrar el mapa2

Análisis de los resultados: Al examinar la ubicación de los apartamentos se oberva que la mayoría se encuentra en la zona sur de la ciudad. No obstante, existen algunos datos que se encuentran en otras áreas de la ciudad, lo que podría atribuirse a posibles errores en la recopilación de datos, como problemas en la entrada de información o en la precisión de su representación en el mapa.

Punto 2

plot_ly(base2, y = ~preciom, x = ~areaconst, type = "histogram", fill = "pink", color = "green") %>%
  layout(title = "Area contruida")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'histogram' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'autobinx', 'autobiny', 'bingroup', 'cliponaxis', 'constraintext', 'cumulative', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'histfunc', 'histnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'nbinsx', 'nbinsy', 'offsetgroup', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textsrc', 'texttemplate', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'xaxis', 'xbins', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'yaxis', 'ybins', 'ycalendar', 'yhoverformat', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(base2$areaconst)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   40.00   65.00   85.00   97.47  110.00  932.00
plot_ly(base2, y = ~preciom, x = ~estrato, type = "bar", fill = "pink", color = "red") %>%
  layout(title = "Estrato")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'bar' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'base', 'basesrc', 'cliponaxis', 'constraintext', 'customdata', 'customdatasrc', 'dx', 'dy', 'error_x', 'error_y', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetgroup', 'offsetsrc', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'x', 'x0', 'xaxis', 'xcalendar', 'xhoverformat', 'xperiod', 'xperiod0', 'xperiodalignment', 'xsrc', 'y', 'y0', 'yaxis', 'ycalendar', 'yhoverformat', 'yperiod', 'yperiod0', 'yperiodalignment', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(base2$preciom)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    75.0   175.0   245.0   297.3   335.0  1750.0
plot_ly(base2, x = ~banios, type = "histogram", fill = "pink", color = "green") %>%
  layout(title = "Numero de banos")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'histogram' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'autobinx', 'autobiny', 'bingroup', 'cliponaxis', 'constraintext', 'cumulative', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'histfunc', 'histnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'nbinsx', 'nbinsy', 'offsetgroup', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textsrc', 'texttemplate', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'xaxis', 'xbins', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'yaxis', 'ybins', 'ycalendar', 'yhoverformat', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(base2$banios)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   2.000   2.000   2.488   3.000   8.000
plot_ly(base2, x = ~habitaciones, type = "histogram", fill = "pink", color = "green") %>% layout(title = "Numero de habitaciones")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning: 'histogram' objects don't have these attributes: 'fill'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'autobinx', 'autobiny', 'bingroup', 'cliponaxis', 'constraintext', 'cumulative', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'histfunc', 'histnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'nbinsx', 'nbinsy', 'offsetgroup', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textsrc', 'texttemplate', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'xaxis', 'xbins', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'yaxis', 'ybins', 'ycalendar', 'yhoverformat', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
summary(base2$habitaciones)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   3.000   3.000   2.966   3.000   6.000
cor <-base2[,c("preciom","areaconst","estrato","banios","habitaciones")]
ggpairs(cor, title="Correlacion entre variables", progress = FALSE)

A diferencia de las casas en el caso de los apartamentos tienen una correlación mas estrecha en torno a el precio las variables de area, estrato y baños, especialmente precio y area construída, lo cual se ve tanto en los indices de correlación y gráficamente, sin embargo tambien hay una alta correlación entre baños y area construida, lo que puede conducir a futuro a la multicolinealidad en el modelo de regresion lineal multiple con estas dos variables.

regre1 = lm(preciom ~ areaconst + estrato + parqueaderos + banios, data = base2)
summary(regre1)
## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + parqueaderos + banios, 
##     data = base2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1047.87   -42.64    -1.33    39.96   941.70 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -324.68369   12.21315  -26.59   <2e-16 ***
## areaconst       1.23683    0.05394   22.93   <2e-16 ***
## estrato        63.57640    3.08079   20.64   <2e-16 ***
## parqueaderos   74.94883    3.97795   18.84   <2e-16 ***
## banios         41.99857    3.13672   13.39   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 98.84 on 2376 degrees of freedom
##   (406 observations deleted due to missingness)
## Multiple R-squared:  0.7442, Adjusted R-squared:  0.7438 
## F-statistic:  1728 on 4 and 2376 DF,  p-value: < 2.2e-16

A diferencia del caso de la regresión para solo casas, en la regresión de apartamentos tiene un superior a 0.7 con un 0.7442 es decir representa casi el 74% de la variación, lo cual es considerablemente alto y es algo que tiene sentido al evaluar las correlaciones de las variables mas altas para este caso. Así mismo con valores p menores a 0.05 para cada coeficiente así como el modelo general se puede decir que estadisticamente significante.

par(mfrow = c(2, 2))
plot(regre1)

residu=regre1$residuals
shapiro.test(residu)
## 
##  Shapiro-Wilk normality test
## 
## data:  residu
## W = 0.79421, p-value < 2.2e-16
bptest(regre1)
## 
##  studentized Breusch-Pagan test
## 
## data:  regre1
## BP = 716.35, df = 4, p-value < 2.2e-16
dwtest(regre1)
## 
##  Durbin-Watson test
## 
## data:  regre1
## DW = 1.5145, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is greater than 0

Al igual que el caso del modelo de las casas se encuentra que el modelo viola los mismos supuestos, las soluciones planteadas para el caso de las viviendas también aplican para este caso y podrían solucionar varios de los inconvenientes con estos supuestos.

apto2 = data.frame(
  areaconst = 300,
  parqueaderos = 3,
  estrato = c(5, 6),
  banios = 3,
  habitaciones = 5
)
apto2
##   areaconst parqueaderos estrato banios habitaciones
## 1       300            3       5      3            5
## 2       300            3       6      3            5
predict(regre1,apto2)
##        1        2 
## 715.0890 778.6654

El modelo pronostica que los apartamentos con las siguientes características tendrán un precio de 715 millones:

Área construida de 300 metros cuadrados 3 parqueadero 3 baños 5 habitaciones Estrato 5 Ubicación en la zona Sur En contraste, para Apartamentos con las mismas características, pero con un estrato de 6, el modelo estima un precio de 778 millones.

apartamento = filter(base2, areaconst >= 300, parqueaderos >= 3, banios >= 3, habitaciones >= 5, zona == "Zona Sur", estrato %in% c(5, 6), preciom <= 850)
apartamento
## # A tibble: 2 × 13
##      id zona    piso  estrato preciom areaconst parqueaderos banios habitaciones
##   <dbl> <chr>   <chr>   <dbl>   <dbl>     <dbl>        <dbl>  <dbl>        <dbl>
## 1  7182 Zona S… <NA>        5     730       573            3      8            5
## 2  7512 Zona S… <NA>        5     670       300            3      5            6
## # ℹ 4 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>

Con este resultado Se identifica que ninguno de los apartamentos cumplen con las especificaciones y requisitos exactos requeridos, en este caso en particular solo se encuentran 2 opciones que son las que mas se acercan pero no cumplen la solicitud realizada por la compañía internacional. Las 2 opciones que tiene la compañia internacional son las siguientes: Área construida: 573 M2/300 M2 : Cumple la opción 2 (300 M2) Parqueaderos: 3/3 : Cumplen las 2 opciones (3 parqueaderos) Baños: 8/5: no cumple supera lo requerido (3 baños) Habitaciones: 5 / 6 : Cumple la opción 1, (5 habitaciones) Estrato: 5/5 : cumple para las 2 opciones (estrato 5 ó 6) Precio: 730/630 millones : Cumple con el credito preaprobado disponible (850 millones) Análisis de los resultados: La compañia internacional tiene la opción dentro de las 2 que mas se acercan escoger un apartamento de 730 Millones (120 Millones menos) con 573 M2 (273 M2 más de lo requerido), Con 3 paqueaderos con 5 habitaciones, en estrato 5 pero con 8 baños (5 mas de lo requerido). La otra opción es un apartamento de 630 Millones (220 millones menos), de 300 M2, con 3 parqueaderos, 5 baños (2 mas que lo requerido), 6 habitaciones (1 mas de lo requerido), y con un estrato 5.

colores <- colorFactor(palette = c("purple"), domain = apartamento$zona)
mapa <- leaflet(apartamento) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = ~colores(zona), radius = 10)
mapa

Conclusiones

Con respecto al poder predictivo, ambos modelos presentan algunas limitaciones que son suceptibles de mejoras, y para ello es imporatnete revisar y verificar la consistencia del dataset, pues se encontraron inconsistencias entre algunos datos que se reflejan en el analisis descriptivo y la ubicación en el mapa.