Actividad 3

Con base en los datos de ofertas de vivienda descargadas del portal Fincaraiz para apartamento de estrato 4 con área construida menor a 200 m^2 (vivienda4.RDS) la inmobiliaria A&C requiere el apoyo de un cientifico de datos en la construcción de un modelo que lo oriente sobre los precios de inmuebles.

Con este propósito el equipo de asesores a diseñado los siguientes pasos para obtener un modelo y así poder a futuro determinar los precios de los inmuebles a negociar

Solución

Primero instalamos los packages y librerías necesarias para obtener los datos # Instalación de datos

#install.packages('devtools') # solo una vez
#devtools::install_github('dgonxalex80/paqueteMETODOS')
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
## 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 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ lubridate 1.9.2     ✔ tibble    3.2.1
## ✔ purrr     1.0.1     ✔ tidyr     1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%()    masks ggplot2::%+%()
## ✖ psych::alpha()  masks ggplot2::alpha()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ dplyr::select() masks MASS::select()
## ✖ tibble::view()  masks summarytools::view()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
data(vivienda4)

Análisis exploratorio

Realice un análisis exploratorio de las variables precio de vivienda (millones de pesos COP) y área de la vivienda (metros cuadrados) - incluir gráficos e indicadores apropiados interpretados.

#Obtenemos los apartamentos
viviendas <- vivienda4[vivienda4$tipo == 'Apartamento',]
dim(viviendas)[1]
## [1] 1363

Limpieza de datos y eliminación de duplicados

Eliminamos los datos duplicados:

dataDuplicada <- duplicated(viviendas)
viviendas <- viviendas[!dataDuplicada,]
dim(viviendas)[1]
## [1] 932

De 1363 datos, al eliminar la data duplicada quedamos con 932.

Ahora bien, de la data nos dicen que el estudio es para apartamento, estrato 4 y con 200 metros cuadrados:

viviendas = subset(viviendas, tipo == "Apartamento" & areaconst<= 200 & estrato==4)

head(viviendas)
## # A tibble: 6 × 5
##   zona       estrato preciom areaconst tipo       
##   <fct>      <fct>     <dbl>     <dbl> <fct>      
## 1 Zona Norte 4           220        52 Apartamento
## 2 Zona Norte 4           320       108 Apartamento
## 3 Zona Sur   4           290        96 Apartamento
## 4 Zona Norte 4           220        82 Apartamento
## 5 Zona Norte 4           220        75 Apartamento
## 6 Zona Norte 4           162        60 Apartamento

Análisis exploratorio de una variable construida

Estadisticos básicos

# Análisis descriptivo de las variables precio y area construida

summary(viviendas$preciom)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    78.0   155.0   197.5   210.0   248.0   645.0

Se puede observar un sesgo positivo en los datos. Dado que la mediana es menor que la media.

summary(viviendas$areaconst)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   40.00   61.00   73.00   78.93   90.00  200.00

El promedio de área construida promedio es de 78.93 metros cuadrados.

Distribución de los datos

#Histograma Precio Viviendas
hist(
  x = viviendas$preciom,
  main = "Histograma de Precio"
)

En dicho histograma se puede ver que hay mas viviendas con precios bajos que con precios altos.

#Histograma área construida
hist(
  x = viviendas$areaconst,
  main = "Histograma de Área"
)

#install.packages('e1071', dependencies=TRUE)
library(e1071)
asim <- skewness(viviendas$areaconst)
sprintf("Coeficiente asimetría: %.2f", asim)
## [1] "Coeficiente asimetría: 1.82"

Dado que el coeficiente de asimetría es mayor que cero, se confirma el sesgo que hay en los datos a la derecha.

# Gráfico de densidad para el precio de las viviendas
ggplot(viviendas, aes(x = preciom)) +
  geom_density() + labs(x = "Precio de Vivienda (COP)", y = "Densidad")

Se observa que el precio promedio de viviendas es de 200 millones de pesos y el área construida es de aproximadamente 70 metros cuadrados.

# Gráfico de dispersión para precio de vivienda vs área construida
ggplot(viviendas, aes(x = areaconst, y = preciom)) +
    geom_point() + labs(x = "Area Construida (metros cuadrados)", y = "Precio Vivienda (COP)")

La distribución de datos es asimétrica a la derecha, por lo que traduce en que hay más viviendas con precios bajos que con precios altos.

# Correlación previo y área
cor(viviendas$preciom, viviendas$areaconst)
## [1] 0.7314873

La correlación es de 0.73, lo que indica una relación positiva y fuerte entre las 2 variables. Las viviendas de mayor área tienen un precio mayor.

Valores atípicos

boxplot(
  x = viviendas$preciom,
  main = "Diagrama Boxplot Variable/Precio"
)

Análisis exploratorio bivariado

Realice un análisis exploratorio bivariado de datos, enfocado en la relación entre la variable respuesta (precio) en función de la variable predictora (area construida) - incluir gráficos e indicadores apropiados interpretados.

# Gráfica de relación entre variables área y precio
plot(
  x = viviendas$areaconst,
  y = viviendas$preciom,
  main = "Gráfico dispersión Precio - Área Construida",
  ylab = 'Precio',
  xlab = 'Área'
)

Coeficiente de correlación de spearman

cor(
  x = viviendas$areaconst,
  y = viviendas$preciom,
  method = "pearson"
)
## [1] 0.7314873

Haciendo uso de la gráfica de relación y el coeficiente de correlación de spearman se puede concluir que existe una correlación lineal positiva entre las variables precio y área construida. Aunque es una relación cuyo coeficiente es igual a 0.73

ggplot(viviendas, aes(x = areaconst, y = preciom)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE, color = "red") +
  labs(x = "Área Construida (metros cuadrados)", y = "Precio de Vivienda (COP)")
## `geom_smooth()` using formula = 'y ~ x'

En este gráfico se muestra la relación entre el precio y el área construida, la línea de regresión (la roja) representa la tendencia general de la relación entre las variables. Se observa que entre mayor el área construida, el precio de la vivienda aumenta

Estime el modelo de regresión lineal simple entre precio=f(area)+εInterprete los coeficientes del modelo β0, β1 en caso de ser correcto.

modelo1 <- lm(preciom ~ areaconst, data = viviendas)
summary(modelo1)
## 
## Call:
## lm(formula = preciom ~ areaconst, data = viviendas)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -218.237  -28.758   -5.133   29.776  216.955 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 46.17974    5.25478   8.788   <2e-16 ***
## areaconst    2.07536    0.06344  32.716   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 48.68 on 930 degrees of freedom
## Multiple R-squared:  0.5351, Adjusted R-squared:  0.5346 
## F-statistic:  1070 on 1 and 930 DF,  p-value: < 2.2e-16

La ecuación quedaría como 46.17974 + 2.07536 ∗ área + 48.68

El coeficiente de β0 es de 46.1 millones de pesos. Lo cual representa el precio esperado de una vivienda con un área construida de 0 metros cuadrados. El valor t en dicha intersacción es de 8.788, lo cual representa que es poco probable que el valor sea igual a cero.

De igual forma el valor t para el coefiniciente de la pendiente β1 es 32.716, lo que sugiere que es un valor que tampoco sea probable que sea igual a 0. El valor β1 toma un valor aproximado de 2.1 millones de pesos le cual representa el aumento en el precio de una vivienda por metro cuadrado adicional al área construida.

El modelo indica que las viviendas con mayor área construida tienen un precio mayor. Específicamente el precio por un área construida con 0 metros cuadrados es de 46.1 millones, cada metro adicional construido le suma 2.1 millones aproximadamente al valor.

Construir un intervalo de confianza (95%) para el coeficiente β1, interpretar y concluir si el coeficiente es igual a cero o no. Compare este resultado con una prueba de hipótesis t.

# Intervalo de confianza para el coeficiente de área construida

confint(modelo1, parm = "areaconst", level = 0.95)
##              2.5 %   97.5 %
## areaconst 1.950862 2.199851

Según los resultados, el intervalo β1 está entre 1.95 y 2.19 millones de pesos. Lo cual indica que la pendiente no es cero.

Calcule e interprete el indicador de bondad R^2

summary(modelo1)$r.squared
## [1] 0.5350736

El valor R2 es de 0.53, lo que nos dice que en promedio, el modelo puede predecir el precio de una vivienda, con un error de aproximadamente el 45%

¿Cuál sería el precio promedio estimado para un apartamento de 110 metros cuadrados? Considera entonces con este resultado que un apartamento en la misma zona con 110 metros cuadrados en un precio de 200 millones sería una atractiva esta oferta? ¿Qué consideraciones adicionales se deben tener?.

estimado <- coef(modelo1)[1] + coef(modelo1)[2] * 110
estimado
## (Intercept) 
##     274.469

Para el resultado obtenido de nuestra estimación es de aproximadamente 274.4 millones de pesos. Es una oferta que llama la atención dado el área. Pero se deben tener en cuenta otras consideraciones como el estrato del lugar, si se cuenta con alcantarillado, el estado del apartamento. Estas características pueden hacer que el precio fluctue.

Realice la validación de los supuestos del modelo por medio de gráficos apropiados, interpretarlos y sugerir posibles soluciones si se violan algunos de ellos. Utilice las pruebas de hipótesis para la validación de supuestos y compare los resultados con lo observado en los gráficos asociados.

# Residuos del modelo
residuos <- residuals(modelo1)
par(mfrow=c(2,2))

# Dispersión entre residuos y predicciones
plot(modelo1$fitted.values, residuos,
     xlab= "Predicciones", ylab = "Residuales",
     main = "Residuos VS Predicciones")

Como se puede ver en la gráfica los resituos son distribuidos de forma aleatoria por la linea 0. Por ende se cumple el principio de linealidad.

Ahora vamos a validar el supuesto de homocedastidad

# Dispersión entre residuos estandarizados y predicciones
plot(modelo1$fitted.values, rstandard(modelo1),
     xlab= "Predicciones", ylab = "Residuos estandarizados",
     main = "Residuos Estandarizados VS Predicciones")

Como se puede ver en el gráfico, la varianza de los residuales es constante para todos los valores predictorios. Así que este supuesto se cumple

Normalidad de los errores:

# Grafico Q-Q
qqnorm(residuos)
qqline(residuos)

shapiro.test(residuos)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.97322, p-value = 4.511e-12
hist(
  residuos,
  breaks = 20,
  main = "Histograma de residuos"
)

Con estas pruebas se puede ver que los residuos se distribuyen de forma normal aproximadamente.

El supuesto de la independencia o la no correlación:

# Dispersión entre residuos estandarizados y predicciones
plot(modelo1$fitted.values, rstandard(modelo1),
     xlab= "Predicciones", ylab = "Residuos estandarizados",
     main = "Residuos Estandarizados VS Predicciones")

Como se puede ver en el gráfico, la varianza de los residuales es constante para todos los valores predictorios. Así que este supuesto se cumple

Normalidad de los errores:

plot(
  1:length(residuos),
  residuos,
  xlab = "Orden de Observación",
  ylab = "Residuales",
  main = "Gráfico de Residuales VS Orden de Observación"
)

Como se puede ver en la gráfica no existe una correlación entre los resultados. Por ende este principio también se cumple.

Se puede concluir que el modelo es bueno dado que cumple los supuestos. Almenos para el ejercicio de la muestra dada, el modelo es bueno.

De ser necesario realice una transformación apropiada para mejorar el ajuste y supuestos del modelo

Como el modelo cumplio los supuestos, este paso no es necesario

De ser necesario compare el ajuste y supuestos del modelo inicial y el transformado.

Este paso tampoco es necesario dado que no se transformó el modelo.

Estime varios modelos y compare los resultados obtenidos. En el mejor de los modelos, ¿se cumplen los supuestos sobre los errores?

# Modelo logaritmico
modelo2 <- lm(log(preciom) ~ log(areaconst), data = viviendas)

# Modelo cuadrático
modelo3 <- lm(preciom ~ areaconst + I(areaconst^2), data = viviendas)

# Modelo cubico
modelo4 <- lm(preciom ~ areaconst + I(areaconst^3), data = viviendas)

# Resumen de los modelos
summary(modelo2)
## 
## Call:
## lm(formula = log(preciom) ~ log(areaconst), data = viviendas)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.87508 -0.13559  0.00748  0.15084  0.74297 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     1.63031    0.10812   15.08   <2e-16 ***
## log(areaconst)  0.84705    0.02494   33.97   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2113 on 930 degrees of freedom
## Multiple R-squared:  0.5537, Adjusted R-squared:  0.5532 
## F-statistic:  1154 on 1 and 930 DF,  p-value: < 2.2e-16
summary(modelo3)
## 
## Call:
## lm(formula = preciom ~ areaconst + I(areaconst^2), data = viviendas)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -199.530  -27.069   -1.812   27.433  264.050 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -31.628473  13.654952  -2.316   0.0208 *  
## areaconst        3.794546   0.286239  13.257  < 2e-16 ***
## I(areaconst^2)  -0.008436   0.001371  -6.153 1.13e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 47.74 on 929 degrees of freedom
## Multiple R-squared:  0.5533, Adjusted R-squared:  0.5523 
## F-statistic: 575.3 on 2 and 929 DF,  p-value: < 2.2e-16
summary(modelo4)
## 
## Call:
## lm(formula = preciom ~ areaconst + I(areaconst^3), data = viviendas)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -203.618  -27.096   -2.347   28.198  261.482 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -4.867e-01  9.734e+00  -0.050     0.96    
## areaconst       2.861e+00  1.522e-01  18.798  < 2e-16 ***
## I(areaconst^3) -2.285e-05  4.039e-06  -5.658 2.04e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 47.89 on 929 degrees of freedom
## Multiple R-squared:  0.5506, Adjusted R-squared:  0.5496 
## F-statistic:   569 on 2 and 929 DF,  p-value: < 2.2e-16

Ahora bien, vamos a comparar los modelos creados:

comparacion <- list(modelo1, modelo2, modelo3, modelo4)
nombres <- c("Modelo Lineal","Modelo Logaritmico","Modelo Cuadrado","Modelo Cubico")

Validaremos los supuestos de los modelos:

# R2
m1 <- summary(modelo1)$r.squared
m1
## [1] 0.5350736
m2 <- summary(modelo2)$r.squared
m2
## [1] 0.553704
m3 <- summary(modelo3)$r.squared
m3
## [1] 0.5532802
m4 <- summary(modelo4)$r.squared
m4
## [1] 0.5505621
# Homecedasticidad
h1 <- plot(modelo1, which = 1)

h2 <- plot(modelo2, which = 1)

h3 <- plot(modelo3, which = 1)

h4 <- plot(modelo4, which = 1)

# Normalidad
n1 <- shapiro.test(modelo1$residuals)
n1
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo1$residuals
## W = 0.97322, p-value = 4.511e-12
n2 <- shapiro.test(modelo2$residuals)
n2
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo2$residuals
## W = 0.99336, p-value = 0.0003656
n3 <- shapiro.test(modelo3$residuals)
n3
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo3$residuals
## W = 0.96905, p-value = 3.503e-13
n4 <- shapiro.test(modelo4$residuals)
n4
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo4$residuals
## W = 0.96962, p-value = 4.916e-13
# Independencia
i1 <- plot(modelo1, which = 2)

i2 <- plot(modelo2, which = 2)

i3 <- plot(modelo3, which = 2)

i4 <- plot(modelo4, which = 2)

Con los resultados obtenidos construya un informe para los directivos de la inmobiliaria, indicando el modelo apropiado y sus principales características. A este informe se deben añadir los anexos como evidencia de la realización de los pasos anteriores.

Tras analizar los 4 modelos anteriores se concluye que los modelos generados en su mayoría no cumplen con los criterios de aceptación. Sin embargo, segun los resultados del R2, el modelo logarítmico es el que mejores resultados tiene y cumple los supuestos. Por ende, se recomienda a los directivos de la inmobiliaria hacer uso de este modelo.