## Loading required package: cubature
## Loading required package: dplyr
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
## Loading required package: flextable
## Warning: package 'flextable' was built under R version 4.3.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.3.3
## Loading required package: lmtest
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
## Loading required package: psych
## Warning: package 'psych' was built under R version 4.3.3
##
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
## Loading required package: summarytools
## Loading required package: randtests
## Loading required package: rapportools
##
## Attaching package: 'rapportools'
## The following objects are masked from 'package:summarytools':
##
## label, label<-
## The following object is masked from 'package:dplyr':
##
## n
## The following objects are masked from 'package:stats':
##
## IQR, median, sd, var
## The following objects are masked from 'package:base':
##
## max, mean, min, range, sum
## spc_tbl_ [1,706 × 5] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ zona : Factor w/ 5 levels "Zona Centro",..: 2 2 2 5 2 2 2 2 2 2 ...
## $ estrato : Factor w/ 4 levels "3","4","5","6": 2 2 2 2 2 2 2 2 2 2 ...
## $ preciom : num [1:1706] 232 272 255 258 250 ...
## $ areaconst: num [1:1706] 52 160 108 96 82 117 75 60 84 117 ...
## $ tipo : Factor w/ 2 levels "Apartamento",..: 1 2 1 1 1 2 1 1 1 1 ...
El dataset nos muestra 1706 registros con 5 variables a saber : zona, estrato, preciom, areaconst, y tipo
## zona estrato preciom areaconst
## Zona Centro : 8 3: 0 Min. :207.4 Min. : 40.00
## Zona Norte : 288 4:1706 1st Qu.:230.7 1st Qu.: 60.00
## Zona Oeste : 60 5: 0 Median :238.8 Median : 75.00
## Zona Oriente: 6 6: 0 Mean :243.7 Mean : 87.63
## Zona Sur :1344 3rd Qu.:251.5 3rd Qu.: 98.00
## Max. :309.7 Max. :200.00
## tipo
## Apartamento:1363
## Casa : 343
##
##
##
##
La función nos ofrece resumen de resultados, indicando la siguiente información importante: Precio en millones, mínimo de 207.4m y máximo 309.7m con una mediana de 238.8m. Área construida:, mínimo de 40m, máximo de 200m, y una media de 87.63m
Ahora veamos algunos indicadores estadísticos: - precio
vivienda4|> summarise(media = mean(preciom),
varianza = var(preciom),
desviación = sd(preciom),
Q1 = quantile(preciom, probs=0.25),
P90 = quantile(preciom, probs=0.90))Se observa que el preciom medio es 243.7031m, con desviación estandar de 19.55537m y un primer cuartil de 230.7371m y un percentil 273.415m que nos indica que el 90% de las viviendas el precio será inferior a 273.415m
Area Construida:
vivienda4|> summarise(media = mean(areaconst),
varianza = var(areaconst),
desviación = sd(areaconst),
Q1 = quantile(areaconst, probs=0.25),
D4 = quantile(areaconst, probs=0.40),
P90 = quantile(areaconst, probs=0.90))Se observar que el área construida media es de 87.62metros, con desviación estandar de 36.34. Un primer cuartil de 60metros, un cuantil 0.40 de 70 metros y un percentil 90 de 144.5m que nos indica que el 90% de las viviendas el área construida esta por debajo de 144.5metros.
Veamos los datos en histogramas ## definir variables que usaremos
plot(area,precio,xlab = "Área construida (en metros cuadrados)", ylab = "Precio (en millones)", main = "Análisis Exploratorio Bivariado")Se observa con el gráfico de dispersión lo mencionado sobre la correlación entre el área y el precio de las viviendas; entre mayor es el área, tiende a ser mayor el precio.
##
## Call:
## lm(formula = precio ~ area)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.5997 -5.0198 -0.0056 4.6648 24.4010
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.998e+02 4.514e-01 442.7 <2e-16 ***
## area 5.009e-01 4.758e-03 105.3 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.141 on 1704 degrees of freedom
## Multiple R-squared: 0.8667, Adjusted R-squared: 0.8666
## F-statistic: 1.108e+04 on 1 and 1704 DF, p-value: < 2.2e-16
Creamos un grafico de dispersión y añadimos una línea de regresión lineal
plot (area, precio, xlab = "Área construida", ylab= "precio", main = "Prueba de regresión lineal")
abline(model, col="purple")Con el modelo creadopodemos establecer que el intercepto o β0 es 199.8 millones y el β1 es”0.5009. Lo anterior indica que el precio es de 199.8 millones y que por cada metro construido el precio aumentará 0.5009 millones.
## 2.5 % 97.5 %
## (Intercept) 198.9248215 200.6954749
## area 0.4915592 0.5102243
Se tiene que el intervalo de confianza para β1 está entre 0.4915592 y 0.5102243, valores en los cuales podría encontrarse β1 con un nivel de confianza del 95%.
##
## Call:
## lm(formula = precio ~ area)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.5997 -5.0198 -0.0056 4.6648 24.4010
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.998e+02 4.514e-01 442.7 <2e-16 ***
## area 5.009e-01 4.758e-03 105.3 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.141 on 1704 degrees of freedom
## Multiple R-squared: 0.8667, Adjusted R-squared: 0.8666
## F-statistic: 1.108e+04 on 1 and 1704 DF, p-value: < 2.2e-16
El coeficiente R-squared: 0.8667, indica que este modelo logra explicar un 86% el precio basandose en el area.
datos_nuevos <- data.frame(area= 110)
predict (model, datos_nuevos, interval = "confidence", level = 0.95)## fit lwr upr
## 1 254.9082 254.51 255.3065
Acorde con el modelo, el precio promedio estimado para los apartamentos de 110 metros cuadrados sería de 254.9082 Millones de pesos, con un limite inferior 254.51 Millones y limite superior de 255.3065 Millones (IC 95%). Por lo anterior, se determina que el precio de 200 Millones por un apartamento de 110 metros cuadrados en la misma zona es una oferta muy atractiva para cualquier comprador.
residuals = model$residuals
hist(residuals, main = "Histograma de residuos del modelo",col="green" )Linealidad:
De acuerdo a estas gráficas, podemos presumir que hay una relación lineal entre los metros de área construida y el precio de la vivienda.
Normalidad
Como no conocemos la media y la varianza del modelo, se usa el test de Lilliefors, que nos rechazan la hipotesis nula indicando que los datos no tienen una distribución normal.
Autocorrelación Al realizar un test de Durbin-Watson podemos darnos cuenta que la correlación es positiva.
##
## Durbin-Watson test
##
## data: model
## DW = 2.0651, p-value = 0.9092
## alternative hypothesis: true autocorrelation is greater than 0
Homocedasticidad:
res.estudentizados <- studres(model) #cálculo de residuos estudentizados
plot(model$fitted.values, res.estudentizados, ylab = "Residuos Estudentizados", xlab = "Valores Ajustados")
abline(h = 0, lty = 2)vamos a ejecutar la prueba de Breusch-Pagan
##
## studentized Breusch-Pagan test
##
## data: model
## BP = 0.089882, df = 1, p-value = 0.7643
Siendo 0.089882, nos indica que hay diferencia entre el modelo que asume homocedasticidad y el modelo que permite heterocedasticidad, y siendo p un valor muy bajo casi cero, podemos decir que no satisface la suposición de Homocedasticidad lo que puede significar que las varianzas de los errores no es constante y que toque aplicar transformaciones.
##
## Call:
## lm(formula = precio ~ area_log)
##
## Residuals:
## Min 1Q Median 3Q Max
## -27.7898 -5.5579 -0.3407 5.4662 24.5710
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 22.5210 2.4272 9.279 <2e-16 ***
## area_log 50.2241 0.5494 91.421 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.05 on 1704 degrees of freedom
## Multiple R-squared: 0.8306, Adjusted R-squared: 0.8305
## F-statistic: 8358 on 1 and 1704 DF, p-value: < 2.2e-16
ajustados2 <- modelo2$fitted.values
residuos2 <- modelo2$residuals
plot(area_log, precio, main='Log(Área (m^2)) vs Precio (Millones de pesos)', xlab='Log(Área)', ylab='Precio', col='#88aaff')
abline(modelo2, col = "red")##
## Shapiro-Wilk normality test
##
## data: residuos2
## W = 0.99721, p-value = 0.003935
##
## studentized Breusch-Pagan test
##
## data: modelo2
## BP = 18.932, df = 1, p-value = 1.354e-05
##
## Durbin-Watson test
##
## data: modelo2
## DW = 1.8858, p-value = 0.008885
## alternative hypothesis: true autocorrelation is greater than 0
Q1_area <- quantile(area, 0.25)
Q3_area <- quantile(area, 0.75)
IQR_area <- Q3_area - Q1_area
lim_inf_area <- Q1_area - 2 * IQR_area
lim_sup_area <- Q3_area + 2 * IQR_area
Q1_precio <- quantile(precio, 0.25)
Q3_precio <- quantile(precio, 0.75)
IQR_precio <- Q3_precio - Q1_precio
lim_inf_precio <- Q1_precio - 1.5 * IQR_precio
lim_sup_precio <- Q3_precio + 1.5 * IQR_precio
datos <- vivienda4[,c("preciom", "areaconst")]
datos2 <- datos[datos$areaconst > lim_inf_area & datos$areaconst < lim_sup_area,]
datos_sin_outliers <- datos2[datos2$preciom > lim_inf_precio & datos2$preciom < lim_sup_precio,]
area2 <- datos_sin_outliers$areaconst
precio2 <- datos_sin_outliers$preciom
plot(area2, precio2)Ajustar nuevo modelo
##
## Call:
## lm(formula = precio2 ~ log(area2))
##
## Residuals:
## Min 1Q Median 3Q Max
## -22.9427 -5.1861 -0.0282 4.9015 23.0345
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 56.2730 2.8017 20.09 <2e-16 ***
## log(area2) 42.2786 0.6438 65.67 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.329 on 1583 degrees of freedom
## Multiple R-squared: 0.7315, Adjusted R-squared: 0.7313
## F-statistic: 4313 on 1 and 1583 DF, p-value: < 2.2e-16
Grafica del modelo
ajustados3 <- modelo3$fitted.values
residuos3 <- modelo3$residuals
plot(area2, precio2, main='Log(Área (m^2)) vs Precio (Millones de pesos)', xlab='Log(Área)', ylab='Precio', col='#88aaff')
abline(modelo3, col = "red")Validación de supuestos
par(mfrow=c(2,2))
hist(residuos3, main="Histograma de residuales", xlab="Residuos", ylab="Frecuencia", col="#3344aa")
qqnorm(residuos3, main="QQplot de residuales", xlab="Cuantiles teóricos", ylab="Cuantile de muestra", col="#44cc1188")
qqline(residuos3, col = "red", lwd="1")
plot(ajustados3, residuos3, main="Ajustados vs Residuales", xlab="Valores ajustados", ylab="Residuales", col="#838bc7")
abline(0,0, col="#d3122f")
plot(precio2, residuos3, xlab="Precio", ylab="Residuos", main = "Precio vs Residuales", col="#670d12")##
## Shapiro-Wilk normality test
##
## data: residuos3
## W = 0.99854, p-value = 0.1952
##
## studentized Breusch-Pagan test
##
## data: modelo3
## BP = 0.32862, df = 1, p-value = 0.5665
El sesgo que presentan tanto el precio como el área, no permite ajustar un modelo lineal confiable.
Ninguno de los modelos ajustado cumple con los supuestos de normalidad, homocedasticidad e independencia de los errores.
El mejor modelo es el modelo2, sin eliminación de outliers y la tranformación logarítmica de la variable independiente. Este modelo de regresión se ajusta un 61.44 % a nuestros datos, es decir, 61.44 % de la variabilidad del precio está siendo explicada por el modelo de regresión. Esto es mejor que el 58.22 % y el 57.3 % de los modelos 1 y 3, respectivamente.
De los 3 modelos ajustados, se recomienda usar el modelo2, ya que fue el que dio el mayor porcentaje de explicabilidad. Pero, con precausión porque es muy propenso a dar errores altos en el precio con áreas muy grandes.