ACTIVIDAD 3 -REGRESION

Se cargan los datos de la libreria “paquete metodos” y la data es vivienda

library(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
library(readxl)
library(paqueteMETODOS)
## Loading required package: cubature
## Loading required package: GGally
## Loading required package: ggplot2
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
## Loading required package: summarytools
## Loading required package: psych
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
## Loading required package: tidyverse
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.0
## ✔ readr     2.1.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%()    masks ggplot2::%+%()
## ✖ psych::alpha()  masks ggplot2::alpha()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ MASS::select()  masks dplyr::select()
## ✖ tibble::view()  masks summarytools::view()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
data(vivienda4)

library(readxl)
library(ggplot2)
library(ggpubr)
library(table1)
## 
## Attaching package: 'table1'
## 
## The following objects are masked from 'package:summarytools':
## 
##     label, label<-
## 
## The following objects are masked from 'package:base':
## 
##     units, units<-
library(lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
mi_base<-vivienda4 
mi_base_filtrada <- mi_base %>%
filter(tipo == "Apartamento")

view(mi_base_filtrada)

PUNTO 1

g1<-ggplot(mi_base_filtrada,aes(x=areaconst))+geom_histogram(bins=30,color="black",fill="mediumvioletred")+theme_bw()+xlab("metros cuadrados")+ylab("Frecuencia") 

g2<-ggplot(mi_base_filtrada,aes(x=areaconst))+geom_boxplot(color="mediumvioletred",fill="mistyrose")+theme_bw()+xlab("metros cuadrados")

g3<-ggplot(mi_base_filtrada,aes(x=preciom))+geom_histogram(bins=30,color="black",fill="mediumturquoise")+theme_bw()+xlab("millones de pesos COP")+ylab("Frecuencia") 
           
g4<-ggplot(mi_base_filtrada,aes(x=preciom))+geom_boxplot(color="mediumturquoise",fill="lightsteelblue1")+theme_bw()+xlab("millones de pesos COP")


ggarrange(g1,g2,g3,g4,ncol = 2, nrow = 2)

table1(~areaconst+preciom, data=mi_base_filtrada,overall="Total",topclass="Rtable1-zebra")
Total
(N=1363)
areaconst
Mean (SD) 75.5 (22.6)
Median [Min, Max] 70.0 [40.0, 200]
preciom
Mean (SD) 202 (65.3)
Median [Min, Max] 185 [78.0, 645]

El area construida de las viviendas objeto de análisis es en promedio de 75.5 m3, el area minima es de 40 m3 y el area maxima es de 200 m3, los datos registran una desviación estandar de 22.6.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.

El precio promedio de las viviendas objeto de análisis es de $202.000.000, el valor minimo es de $78.000.000 y el valor maximo es de $645.000.000, los datos registran una desviación estandar de $65.300.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.

PUNTO 2

ggplot(mi_base_filtrada,aes(x=areaconst,y=preciom))+geom_point(color="mediumvioletred")+theme_bw()+geom_smooth(color="mistyrose")+xlab("metros cuadrados")+ylab("millones de pesos COP")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

cor(mi_base_filtrada$preciom,mi_base_filtrada$areaconst)
## [1] 0.7481389

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

PUNTO 3

modelo=lm(preciom~areaconst,data=mi_base_filtrada)
summary(modelo)
## 
## Call:
## lm(formula = preciom ~ areaconst, data = mi_base_filtrada)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -225.404  -23.902   -4.754   25.763  209.021 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 39.04679    4.09977   9.524   <2e-16 ***
## areaconst    2.16473    0.05204  41.595   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 43.34 on 1361 degrees of freedom
## Multiple R-squared:  0.5597, Adjusted R-squared:  0.5594 
## F-statistic:  1730 on 1 and 1361 DF,  p-value: < 2.2e-16

El coeficiente B0=39.04679, indica que si en el area de la vivienda no se tiene metros cuadrados construidos, el valor esperado del lote es de 39.046.790 pesos.

El coeficiente B1=2.16473, indica que por cada metro cuadrado construido en el area de la vivienda, se espera un aumento de 2.164.000 pesos en el precio de la vivienda.

PUNTO 4

confint(modelo,2,0.95)
##             2.5 %   97.5 %
## areaconst 2.06264 2.266826

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.06264 - 2.266826), 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= 2e-16 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.

PUNTO 5

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.5597 se puede considerar que el ajuste de la recta de regresión a los datos es aceptable.

PUNTO 6

predict(modelo,list(areaconst=110),interval = "confidence",level = 0.95)
##        fit      lwr      upr
## 1 277.1674 272.9573 281.3775

De acuerdo al modelo ajustado, el precio promedio estimado de un apartamento con 110 metros cuadrados es de 217.167.400 de pesos y con un 95% de confianza sabemos que este valor oscila entre (272.957.300 - 281.377.500) 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 una cantidad aceptable del precio de los apartamentos de acuerdo al area, sin embargo no tiene un ajuste excelente.

PUNTO 7

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

bptest(modelo)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo
## BP = 292.99, df = 1, p-value < 2.2e-16
shapiro.test(modelo$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo$residuals
## W = 0.96486, p-value < 2.2e-16

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 no se distribuyen a lo largo de la linea, por lo cual se puede considerar que no se cumple el supuesto de normalidad de los residuos y con base al test de shapiro wilk se corrobora la no normalidad; tambien se pueden apreciar puntos atipicos. 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.

PUNTO 8

Se ajusta nuevamente el modelo, empleando una transformación hiperbolica, donde Y=precio y W=1/area.

W=1/mi_base_filtrada$areaconst
modelo2=lm(preciom~W,data=mi_base_filtrada)
summary(modelo2)
## 
## Call:
## lm(formula = preciom ~ W, data = mi_base_filtrada)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -162.035  -21.361   -1.438   22.415  310.627 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    416.633      5.173   80.55   <2e-16 ***
## W           -15135.732    356.210  -42.49   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 42.82 on 1361 degrees of freedom
## Multiple R-squared:  0.5702, Adjusted R-squared:  0.5699 
## F-statistic:  1805 on 1 and 1361 DF,  p-value: < 2.2e-16

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.57, se puede considerar que el ajuste de la recta de regresión a los datos no 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, por lo anterior se podria seguir buscando alguna transformacion que sea mejor en el ajuste o revisar una muestra mas significativa tanto en el tamaño como en la seleción de esta.

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

bptest(modelo2)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo2
## BP = 137.41, df = 1, p-value < 2.2e-16
shapiro.test(modelo2$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo2$residuals
## W = 0.94797, p-value < 2.2e-16

En el gráfico de residuos frente a valores ajustados se puede observar que los puntos parecen no distribuirse aleatoriamente; perol valor-P del test Breusch-Pagan es menor que el nivel de significancia de 5%, por lo tanto, se puede considerar que la varianza de los residuos no es homocedastica, lo cual es acorde a los graficos; de acuerdo al gráfico QQ-Plot los puntos no se distribuyen a lo largo de la linea, por lo cual no se puede considerar que se cumple el supuesto de normalidad de los residuos y con base al test de shapiro wilk se corrobora la no normalidad.

PUNTO 9

Al aplicar la transformación hiperbolica, se puede apreciar que el indicador de bondad y ajuste (R2) no mejora significativamente ya que pasa del 55% al 57%, pero cabe resaltar que solo se esta utlizando una sola variable para explicar la Y se podrian utlizar otras variables que sean significativas y mejoren el ajuste del modelo. cabe resaltar que con esta transformacion mejora en algo el ajuste pero no s ayuda a los supuesttos del modelo (este modelo era el sugerido y fue el de mejor ajuste tenia pero los supuestos no se cumplieron).