library(readxl)
library(ggplot2)
library(ggpubr)
library(table1)
library(lmtest)
datos_vivienda <- read_excel("C:/Users/Cata/Desktop/MAESTRIA CD/1. Metodos y tecnicas de simulacion estadistica/Unidad 3/datos_vivienda.xlsx")
g1<-ggplot(datos_vivienda,aes(x=Area_contruida))+geom_histogram(bins=30,color="black",fill="mediumvioletred")+theme_bw()+xlab("metros cuadrados")+ylab("Frecuencia")
g2<-ggplot(datos_vivienda,aes(x=Area_contruida))+geom_boxplot(color="mediumvioletred",fill="mistyrose")+theme_bw()+xlab("metros cuadrados")
g3<-ggplot(datos_vivienda,aes(x=precio_millon))+geom_histogram(bins=30,color="black",fill="mediumturquoise")+theme_bw()+xlab("millones de pesos COP")+ylab("Frecuencia")
g4<-ggplot(datos_vivienda,aes(x=precio_millon))+geom_boxplot(color="mediumturquoise",fill="lightsteelblue1")+theme_bw()+xlab("millones de pesos COP")
ggarrange(g1,g2,g3,g4,ncol = 2, nrow = 2)
table1(~Area_contruida+precio_millon, data=datos_vivienda,overall="Total",topclass="Rtable1-zebra")
| Total (N=26) |
|
|---|---|
| Area_contruida | |
| Mean (SD) | 116 (35.5) |
| Median [Min, Max] | 97.0 [80.0, 195] |
| precio_millon | |
| Mean (SD) | 332 (82.1) |
| Median [Min, Max] | 305 [240, 480] |
El area construida de las viviendas objeto de análisis es en promedio de 116 m3, el area minima es de 80 m3 y el area maxima es de 195 m3, los datos registran una desviación estandar de 35.5 m3; y de acuerdo a los gráficos se puede observar que los datos de la variable area construida de la vivienda tienen una distribución aisimetrica positiva.
El precio promedio de las viviendas objeto de análisis es de $332.000.000, el valor minimo es de $240.000.000 y el valor maximo es de $480.000.000, los datos registran una desviación estandar de $82.100.000; y de acuerdo a los gráficos se puede observar que los datos de la variable precio de la vivienda tienen una distribución aisimetrica positiva.
ggplot(datos_vivienda,aes(x=Area_contruida,y=precio_millon))+geom_point(color="mediumvioletred")+theme_bw()+geom_smooth(color="mistyrose")+xlab("metros cuadrados")+ylab("millones de pesos COP")
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
cor(datos_vivienda$precio_millon,datos_vivienda$Area_contruida)
## [1] 0.9190295
En el grafico de dispersión entre las variables X=area construida y Y=precio vivienda, se observa una relación creciente la cual parece ser de tipo no lineal pues gráficamente se percibe concavidad. De acuerdo al coeficiente de correlación entre las variables precio y area de la vivienda (0.91), se podria decir que la relación entre las variables es directa y fuerte, es decir que a mayor area construida (m3) mayor es el precio de la vivienda (millones de pesos COP).
modelo=lm(precio_millon~Area_contruida,data=datos_vivienda)
summary(modelo)
##
## Call:
## lm(formula = precio_millon ~ Area_contruida, data = datos_vivienda)
##
## Residuals:
## Min 1Q Median 3Q Max
## -51.673 -25.612 -6.085 24.875 67.650
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 86.234 22.479 3.836 0.000796 ***
## Area_contruida 2.124 0.186 11.422 3.45e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 33.05 on 24 degrees of freedom
## Multiple R-squared: 0.8446, Adjusted R-squared: 0.8381
## F-statistic: 130.5 on 1 and 24 DF, p-value: 3.45e-11
El coeficiente B0=86.234, indica que si en el area de la vivienda no se tiene metros cuadrados construidos, el valor esperado del lote es de 86.234.000 pesos.
El coeficiente B1=2.124, indica que por cada metro cuadrado construido en el area de la vivienda, se espera un aumento de 2.124.000 pesos en el precio de la vivienda.
confint(modelo,2,0.95)
## 2.5 % 97.5 %
## Area_contruida 1.74017 2.507771
De acuerdo al intervalo de confianza calculado para B1, se puede concluir que con un 95% de confianza el valor de B1 oscila entre (1.74017 - 2.507771), se puede apreciar que el intervalo no contiene el valor 0 por lo cual se puede pensar que el coeficiente es significativo para el modelo. Se contrasta la hipotesis Ho: B1=0 y Ha: B1 Dif 0 bajo la prueba t, de acuerdo a los resultados obtenidos en el resumen del modelo se tiene que con un Valor-P= 3.45e-11 se rechaza la hipotesis nula a un nivel de significancia del 5%, por lo cual se puede concluir que el coeficiente B1 es diferente de cero.
De acuerdo a la tabla resumen del modelo, se tiene que la proporción de la variabilidad de Y que es posible explicar a través del modelo planteado es del 0.84, se puede considerar que el ajuste de la recta de regresión a los datos es buena.
predict(modelo,list(Area_contruida=110),interval = "confidence",level = 0.95)
## fit lwr upr
## 1 319.8706 306.3133 333.4279
De acuerdo al modelo ajustado, el precio promedio estimado de un apartamento con 110 metros cuadrados es de 319.000.000 de pesos y con un 95% de confianza sabemos que este valor oscila entre (306.313.300 - 333.427.900) pesos, conseguir un apartamento con 110 metros cuadrados en la misma zona por valor de 200.000.000 pesos de acuerdo a los resultados del modelo seria una buena oferta, sin embargo se deberian evaluar otras variables como la antiguedad de la propiedad, numero de cuartos, numero de baños, entre otras caracteristicas que actualmente no considera el modelo, ademas, se debe tener en cuenta que el modelo explica en gran medida el precio de los apartamentos de acuerdo al area, sin embargo no tiene un ajuste excelente.
par(mfrow=c(2,2))
plot(modelo)
bptest(modelo)
##
## studentized Breusch-Pagan test
##
## data: modelo
## BP = 5.8737, df = 1, p-value = 0.01537
shapiro.test(modelo$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo$residuals
## W = 0.95489, p-value = 0.3009
En el gráfico de residuos frente a valores ajustados se puede observar que los puntos parecen no distribuirse aleatoriamente, lo cual sugiere una relación no lineal entre las variables Y y X; el valor-P del test Breusch-Pagan es menor que el nivel de significancia de 5%, por lo tanto, hay evidencias para decir que no se cumple la homocedasticidad en los residuales del modelo, lo cual es acorde a los graficos donde se evidencia que no hay varianza constante; de acuerdo al gráfico QQ-Plot los puntos se distribuyen a lo largo de la linea, por lo cual se puede considerar que se cumple el supuesto de normalidad de los residuos y con base al test de shapiro wilk se corrobora la normalidad; tambien se pueden apreciar puntos atipicos (observaciones 25 y 4). Basados en la validación de supuestos de modelo se sugiere realizar una transformación al modelo original que permita mejorar el ajuste y se de cumplimiento a los supuestos.
Se ajusta nuevamente el modelo, empleando una transformación hiperbolica, donde Y=precio y W=1/area.
W=1/datos_vivienda$Area_contruida
modelo2=lm(precio_millon~W,data=datos_vivienda)
summary(modelo2)
##
## Call:
## lm(formula = precio_millon ~ W, data = datos_vivienda)
##
## Residuals:
## Min 1Q Median 3Q Max
## -36.987 -16.743 -5.023 18.547 44.379
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 635.35 18.27 34.77 < 2e-16 ***
## W -32464.72 1895.32 -17.13 5.84e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 23.05 on 24 degrees of freedom
## Multiple R-squared: 0.9244, Adjusted R-squared: 0.9212
## F-statistic: 293.4 on 1 and 24 DF, p-value: 5.839e-15
De acuerdo a la tabla resumen del modelo, se tiene que la proporción de la variabilidad de Y que es posible explicar a través del modelo planteado es del 0.92, se puede considerar que el ajuste de la recta de regresión a los datos es excelente. Con base en el Valor-P de la prueba t, se evidencia que aun nivel de significancia del 5% el coeficiente B1 es diferente de cero.
par(mfrow=c(2,2))
plot(modelo2)
bptest(modelo2)
##
## studentized Breusch-Pagan test
##
## data: modelo2
## BP = 2.6558, df = 1, p-value = 0.1032
shapiro.test(modelo2$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo2$residuals
## W = 0.96859, p-value = 0.5871
En el gráfico de residuos frente a valores ajustados se puede observar que los puntos parecen distribuirse aleatoriamente; el valor-P del test Breusch-Pagan es mayor que el nivel de significancia de 5%, por lo tanto, se puede considerar que la varianza de los residuos es homocedastica, lo cual es acorde a los graficos; de acuerdo al gráfico QQ-Plot los puntos se distribuyen a lo largo de la linea, por lo cual se puede considerar que se cumple el supuesto de normalidad de los residuos y con base al test de shapiro wilk se corrobora la normalidad.
Al aplicar la transformación hiperbolica, se puede apreciar que el indicador de bondad y ajuste (R2) paso de 0.84 a 0.92 mejorando significativamente la proporción de variabilidad de Y que es posible explicar a través del modelo; en ambos modelos los coeficientes son significativos a un nivel de confianza del 5%, y se pudo evidenciar que la transformación mejoro el ajuste y el cumplimiento de los supuestos del modelo.