Punto 1

library(paqueteMETODOS)
## 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
data(vivienda4)

Analisis Exploratorio

str(vivienda4) 
## 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

Distribuciones por tipo de vivienda

pie(table(vivienda4$tipo), col=c("blue", "grey"), main="Distribuciones por tipo de vivienda")

summary(vivienda4)
##            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

area = vivienda4$areaconst
precio = vivienda4$preciom

grafica de precio

hist(precio, main = "precio vivienda FincaRaiz", xlab = "valor en millones", col="blue")

Grafica del area construida

hist(area, main = "Area construida vivienda FincaRaiz", xlab="Medida en metros cuadrados", col="red")

Punto 2

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.

Punto 3

model=lm(precio ~ area)
summary(model)
## 
## 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.

Punto 4

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

confint(model, level = 0.95)
##                   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%.

Punto 5

summary(model)
## 
## 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.

Punto 6

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.

Punto 7

residuals = model$residuals
hist(residuals, main = "Histograma de residuos del modelo",col="green" )

qqnorm(residuals)
qqline(residuals,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.

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

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.

lmtest::dwtest(model)
## 
##  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

library(lmtest)
bptest(model)
## 
##  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.

Punto 8

area_log <- log(area)
modelo2 <- lm(precio ~ area_log)
summary(modelo2)
## 
## 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

Punto 9

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.test(residuos2)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos2
## W = 0.99721, p-value = 0.003935
bptest(modelo2)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo2
## BP = 18.932, df = 1, p-value = 1.354e-05
dwtest(modelo2)
## 
##  Durbin-Watson test
## 
## data:  modelo2
## DW = 1.8858, p-value = 0.008885
## alternative hypothesis: true autocorrelation is greater than 0

Punto 10

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

modelo3 <- lm(precio2 ~ log(area2))
summary(modelo3)
## 
## 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.test(residuos3)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos3
## W = 0.99854, p-value = 0.1952
bptest(modelo3)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo3
## BP = 0.32862, df = 1, p-value = 0.5665

Punto 11

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.