Actividad 2 - Regresión Lineal Múltiple

Contexto

La compañía C&A (Casas y Apartamentos) ha recibido una solicitud de compra para dos viviendas por parte de una compañía internacional. Como aliados en el proceso de ánalisis a la solicitud se aborda este problema con el desarrollo de un Modelo de Regresión Lineal Múltiple que nos permita identificar las potenciales ofertas que respondan a las características del cliente.

Características de las Viviendas:

Características	Vivienda 1	Vivienda 2
Tipo	Casa	Apartamento
Área Construida	200	300
Parqueaderos	1	3
Baños	2	3
Habitaciones	4	5
Estrato	4 ó 5	5 ó 6
Zona	Norte	Sur
Crédito Preaprobado	350’ millones	850’ millones

Carga de los datos

head(vivienda)#primeras 5 filas de los datos

Limpieza de los datos

Inicialmente verificamos si hay datos faltantes en nuestro conjunto de datos y a apartir de ellos decidimos cómo los vamos a tratar

colSums(is.na(vivienda))#Cuantos valores NA hay?

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

De los datos de partida inicial, contramos ausencia de 1605 registros para parqueaderos y 2638 registros para pisos con datos ausentes.

En este caso asumiremos para la característica piso que todos tiene 1 piso y para los parqueaderos imputaremos con 0 indicando que no tienen parqueadero asociado a la vivienda.

Para el caso de las características que tienen valores ausentes del orden de 3 registros a lo sumo, aplicamos eliminación de faltantes. Obteniendo una reducción en el conjunto de datos de 8322 a 8319 registros.

#imputación para piso y parquederos
vivienda_df$piso <- ifelse(is.na(vivienda_df$piso), 1, vivienda_df$piso)
vivienda_df$parqueaderos <- ifelse(is.na(vivienda_df$parqueaderos), 0, vivienda_df$parqueaderos)

#eliminación de datos faltantes para el resto de características
clean_df <- na.omit(vivienda_df)

md.pattern(clean_df)

##  /\     /\
## {  `---'  }
## {  O   O  }
## ==>  V <==  No need for mice. This data set is completely observed.
##  \  \|/  /
##   `-----'

##      id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## 8319  1    1    1       1       1         1            1      1            1
##       0    0    0       0       0         0            0      0            0
##      tipo barrio longitud latitud  
## 8319    1      1        1       1 0
##         0      0        0       0 0

Validación de variables categóricas para entendimiento de los datos que usaremos más adelante

## [1] "Zona Oriente" "Zona Sur"     "Zona Norte"   "Zona Oeste"   "Zona Centro" 
## [6] NA

## [1] "Casa"        "Apartamento" NA

Plan de ejecución

Para la obtención de los resultados se plantean 7 pasos, desarrollados a contuación para ambos tipos de vivienda.

Vivienda 1

1. Filtros por oferta

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

head(base1, 3)

# Definición del Icono
customIcon <- makeIcon(
  iconUrl = "https://img.icons8.com/?size=100&id=ORAO5DF37nXq&format=png&color=000000", # URL del icono
  iconWidth = 8, iconHeight = 8
)

#Gráfico del mapa
leaflet() %>% 
  addTiles() %>% 
  setView(lng =  -76.51595234451665, lat = 3.436834062816008, zoom = 12)  %>%
  addMarkers(lng = base1$longitud,
             lat = base1$latitud,
             label = as.character(paste0(base1$tipo, " est:", base1$estrato, " Precio:",base1$preciom, "'000.000", " Pisos:", base1$piso)), 
             icon = customIcon
  )

Para la Base1 encontramos que algunos puntos considerablemente se encuentran por fuera de la Zona Norte a la cual están categorizados. Es necesario ajustar estas ubicaciones, basado en dos características conocidas como lo son latitud y longitud.

A continuación se visualizan las correcciones basadas en latitud y logitud para las Zonas de la ciudad de Santiago de Cali.

# Definición del Icono
customIcon <- makeIcon(
  iconUrl = "https://img.icons8.com/?size=100&id=q7rRPuQpoLiF&format=png&color=000000", # URL del icono
  iconWidth = 8, iconHeight = 8
)

#Gráfico del mapa
leaflet() %>% 
  addTiles() %>% 
  setView(lng =  -76.51595234451665, lat = 3.436834062816008, zoom = 12)  %>%
  addMarkers(lng = base1$longitud,
             lat = base1$latitud,
             label = as.character(paste0(base1$tipo, " est:", base1$estrato, " Precio:",base1$preciom, "'000.000", " Pisos:", base1$piso)), 
             icon = customIcon
  )

2. Análisis Exploratorio de Datos

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.

# Crear matriz de correlacion
mc <- cor(base1[, c("preciom", "areaconst", "estrato", "banios", "habitaciones")])

#Heatmap de la matriz de correlaciones
grafico_mc <- plot_ly(
  z = mc,
  x = colnames(mc),
  y = colnames(mc),
  type = "heatmap",
  colorscale = "Viridis"
)

grafico_mc

Teniendo en cuenta la anterior matriz de correlación entre las características Precio, Área Construida, Estrato, Baños y habitaciones, y apoyandose en el mapa de calor para estos valores; tenemos que existe una correlación fuerte de 0.7432 entre el preciom&areaconst, seguido por el valor de correlación 0.6190 entre preciom&estrato que podemos considerar moderada respecto a la anterior.

3. Modelo de Regresión

modelo_c <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = base1)
summary(modelo_c)

## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = base1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -865.03  -68.38  -14.02   36.18  913.98 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -163.12828   33.75197  -4.833 1.75e-06 ***
## areaconst       0.76158    0.04747  16.044  < 2e-16 ***
## estrato        67.96263    8.30215   8.186 1.92e-15 ***
## habitaciones   -2.36813    4.80391  -0.493    0.622    
## parqueaderos   18.57173    4.60589   4.032 6.31e-05 ***
## banios         25.67734    6.35532   4.040 6.11e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 143.7 on 545 degrees of freedom
## Multiple R-squared:  0.6713, Adjusted R-squared:  0.6683 
## F-statistic: 222.6 on 5 and 545 DF,  p-value: < 2.2e-16

De los resultados obtenidos del modelo podemos deducir que las variables areaconst, estrato, parqueaderos, banios tienen una ingerencia mayor en precio de la vivienda que la variable habitaciones teniendo en cuenta el valor p 0.622 (estadísticamente no significativo).

También tenemos para este modelo un valor de R2=0.6713, lo que nos da a entender que el 67% de la variabilidad del precio es contribuido por areaconst, estrato, parqueaderos, banios.

Este porcentaje del 67% lo podemos entender como bueno y se podría implementar como oportunidad de mejora del rendimiento del modelo haciendo ajustes sobre la variable estrato como dummy y eliminar de nuestra predictoras la variable habitaciones.

Función precio() = -163.12 + 0.76x(areaconst) + 67.96x(estrato) -2.36x(habitaciones) +18.57(parqueaderos) +25.67(baños)

4. Validación de Supuestos

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).

# Verificar los supuestos del modelo
par(mfrow = c(2, 2))
plot(modelo_c)

Linealidad: Existen algunos outliers que generan un tipo de ruido en la definición de lo que buscamos para supuesto, lo que nos sugiere que a pesar de definirse una línea ligeramente recta, esta relación podría no ser completamente lineal.

Normalidad: en este caso aplicamos el test shapiro donde el valor de α > 2.2e-16 sugiere que los residuos no siguen una distribución normal a pesar de cubrir en su parte central, esta no sigue completamente la distribución normal.

shapiro.test(modelo_c$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  modelo_c$residuals
## W = 0.8183, p-value < 2.2e-16

Heterocedasticidad (Homocedasticidad): Prueba Breush-Pagan no cumple con el criterio de supuesto p-value < 2.2e-16 es extremadamente bajo, lo que indica que la heterocedasticidad es significativa.

bptest(modelo_c)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_c
## BP = 113.09, df = 5, p-value < 2.2e-16

5. Predicciones

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

request1 <- data.frame(areaconst = 200, estrato = 4, habitaciones = 4, parqueaderos = 1, banios = 2)

# Predecir el precio
precio_predict <- predict(modelo_c, request1)
cat('Precio predicho para la Vivienda 1 en estrato 4:',precio_predict)

## Precio predicho para la Vivienda 1 en estrato 4: 321.492

request1 <- data.frame(areaconst = 200, estrato = 5, habitaciones = 4, parqueaderos = 1, banios = 2)

# Predecir el precio
precio_predict <- predict(modelo_c, request1)
cat('Precio predicho para la Vivienda 1 en estrato 5:',precio_predict)

## Precio predicho para la Vivienda 1 en estrato 5: 389.4547

6. Sugerencia de Ofertas - Vivienda 1

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.

# Filtrar propiedades dentro del rango de precio y zona norte
ofertas_vivienda1 <- base1 %>%
  filter(areaconst >= 200,
         parqueaderos >= 1,
         banios >= 2,
         habitaciones <= 4,
         estrato %in% c(4, 5),
         preciom <= 350)
ofertas_vivienda1 <- ofertas_vivienda1[1:6, ]

# Mostrar las ofertas
head(ofertas_vivienda1)

# Definición del Icono personalizado
customIcon <- makeIcon(
  iconUrl = "https://img.icons8.com/?size=100&id=4g9D6i4Tppwe&format=png&color=000000", # URL del icono
  iconWidth = 20, iconHeight = 20
)

# Gráfico del mapa con las primeras 6 ofertas
leaflet(ofertas_vivienda1) %>% 
  addTiles() %>% 
  setView(lng = -76.51595234451665, lat = 3.436834062816008, zoom = 12)  %>%
  addMarkers(lng = ~longitud,
             lat = ~latitud,
             label = ~as.character(paste0(tipo, " est:", estrato, " Precio:", preciom, "'000.000", " Pisos:", piso)),
             icon = customIcon
  )

Vivienda 2

base2 <- subset(clean_df, tipo == "Casa" & zona == "Zona Sur")

head(base2, 3)

Ubicación del conjunto de datos para la Zona Sur. Este conjunto de datos ya cuenta con el procesamiento de latitud y longitud.

# Definición del Icono
customIcon <- makeIcon(
  iconUrl = "https://img.icons8.com/?size=100&id=q7rRPuQpoLiF&format=png&color=000000", # URL del icono
  iconWidth = 8, iconHeight = 8
)

#Gráfico del mapa
leaflet() %>% 
  addTiles() %>% 
  setView(lng =  -76.51595234451665, lat = 3.436834062816008, zoom = 12)  %>%
  addMarkers(lng = base2$longitud,
             lat = base2$latitud,
             label = as.character(paste0(base2$tipo, " est:", base2$estrato, " Precio:",base2$preciom, "'000.000", " Pisos:", base1$piso)), 
             icon = customIcon
  )

2. Análisis Exploratorio de Datos

# Crear matriz de correlacion
mc <- cor(base2[, c("preciom", "areaconst", "estrato", "banios", "habitaciones")])

#Heatmap de la matriz de correlaciones
grafico_mc <- plot_ly(
  z = mc,
  x = colnames(mc),
  y = colnames(mc),
  type = "heatmap",
  colorscale = "Viridis"
)

grafico_mc

Teniendo en cuenta la anterior matriz de correlación entre las características Precio, Área Construida, Estrato, Baños y habitaciones, y apoyandose en el mapa de calor para estos valores; tenemos que existe una correlación fuerte de 0.6842 entre el preciom&areaconst, seguido por el valor de correlación 0.6773 entre preciom&estrato que podemos considerar muy cercanas entre si.

3. Modelo de Regresión

modelo_c2 <- lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = base2)
summary(modelo_c2)

## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = base2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -745.00 -123.99  -31.22   78.93  968.01 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -517.18572   39.11693 -13.222  < 2e-16 ***
## areaconst       0.82614    0.04127  20.019  < 2e-16 ***
## estrato       138.79297    7.95996  17.436  < 2e-16 ***
## habitaciones  -13.77436    4.88107  -2.822  0.00484 ** 
## parqueaderos   48.35331    4.34041  11.140  < 2e-16 ***
## banios         42.69949    5.75544   7.419 2.02e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 217.1 on 1429 degrees of freedom
## Multiple R-squared:  0.6963, Adjusted R-squared:  0.6953 
## F-statistic: 655.4 on 5 and 1429 DF,  p-value: < 2.2e-16

De los resultados obtenidos del modelo podemos deducir que las variables areaconst, estrato, parqueaderos, banios tienen una ingerencia mayor en precio de la vivienda que la variable habitaciones con un valor p 0.00484** .

También tenemos para este modelo un valor de R2=0.6963, lo que nos da a entender que el 70% de la variabilidad del precio es contribuido por areaconst, estrato, parqueaderos, banios.

Función precio() = -517.18 + 0.83x(areaconst) + 138.79x(estrato) -13.77x(habitaciones) +48.35(parqueaderos) + 42.69(baños)

4. Validación de Supuestos

# Verificar los supuestos del modelo
par(mfrow = c(2, 2))
plot(modelo_c2)

Linealidad: Podemos observar que no existe una relación lineal entre los residuos y los valores ajustados.

Normalidad: en este caso aplicamos el test shapiro donde el valor de α > 2.2e-16 sugiere que los residuos no siguen una distribución normal a pesar de cubrir en su parte central, esta no sigue completamente la distribución normal. El mismo indicador

shapiro.test(modelo_c2$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  modelo_c2$residuals
## W = 0.90312, p-value < 2.2e-16

Heterocedasticidad (Homocedasticidad): Prueba Breush-Pagan no cumple con el criterio de supuesto p-value < 2.2e-16 es extremadamente bajo, lo que indica que la heterocedasticidad es significativa.

bptest(modelo_c2)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_c2
## BP = 155.16, df = 5, p-value < 2.2e-16

5. Predicciones

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

request2 <- data.frame(areaconst = 300, estrato = 5, habitaciones = 5, parqueaderos = 3, banios = 3)

# Predecir el precio
precio_predict2 <- predict(modelo_c2, request2)
cat('Precio predicho para la Vivienda 2 en estrato 5:',precio_predict2)

## Precio predicho para la Vivienda 2 en estrato 5: 628.908

request2 <- data.frame(areaconst = 300, estrato = 6, habitaciones = 5, parqueaderos = 3, banios = 3)

# Predecir el precio
precio_predict2 <- predict(modelo_c2, request2)
cat('Precio predicho para la Vivienda 2 en estrato 6:',precio_predict2)

## Precio predicho para la Vivienda 2 en estrato 6: 767.701

6. Sugerencia de Ofertas - Vivienda 2

Para la segunda solicitud que tiene un crédito preaprobado por valor de $850 millones.

# Filtrar propiedades dentro del rango de precio y zona sur
ofertas_vivienda2 <- base2 %>%
  filter(areaconst >= 300,
         parqueaderos >= 3,
         banios >= 3,
         habitaciones <= 5,
         estrato %in% c(5, 6),
         preciom <= 850)
ofertas_vivienda2 <- ofertas_vivienda2[1:6, ]

# Mostrar las ofertas
head(ofertas_vivienda2)

# Definición del Icono personalizado
customIcon <- makeIcon(
  iconUrl = "https://img.icons8.com/?size=100&id=4g9D6i4Tppwe&format=png&color=000000", # URL del icono
  iconWidth = 20, iconHeight = 20
)

# Gráfico del mapa con las primeras 6 ofertas
leaflet(ofertas_vivienda2) %>% 
  addTiles() %>% 
  setView(lng = -76.51595234451665, lat = 3.436834062816008, zoom = 11)  %>%
  addMarkers(lng = ~longitud,
             lat = ~latitud,
             label = ~as.character(paste0(tipo, " est:", estrato, " Precio:", preciom, "'000.000", " Pisos:", piso)),
             icon = customIcon
  )