Análisis de Apartamentos de Estrato 4
Juan Fernando Gutiérrez Ayala
Informe analítico
Introducción
El presente documento hace un análisis de precios para apartamentos de estrato 4 con áreas construidas menores a 200\(m^2\). Para esto, se analizarán las dos variables (área y precio) de manera separada y, posteriormente, conjunta con el fin de caracterizar, de manera apropiada, los apartamentos seleccionados y establecer una correlación de ambas variables que lleve a la inmobiliaria a comprender el sector del mercado. Así, se divide en dos partes, una primera en la que se establecen recomendaciones de negocio concretas a la inmobiliaria A&S y otra, en la que se hacen los análisis cuantitativos de los datos suministrados y que servirá como anexo y soporte.
1. Objetivos
El reporte tiene como principales objetivos:
Objetivo General:
• Plantear recomendaciones de negocio a la inmobiliaria A&S frente a los apartamentos de estrato 4 de la ciudad.
Objetivos específicos:
• Caracterizar la relación que tiene el área construida y el precio de apartamentos estrato 4.
• Generar hallazgos frente a los datos que levanta y registra la inmobiliaria frente a los inmuebles priorizados.
2. Resultados del análisis.
2.1. Relación entre el área construida y el precio del inmueble.
Al adelantar un análisis de cada variable, se encuentra que el precio promedio de las viviendas es de 237.5 millones de pesos, siendo el precio mínimo 207.4 y el máximo 300.5 millones de pesos donde entre el tercer y cuarto cuartil se concentran apartamentos que denotan cierta desproporción de precios frente a las tendencias de toda la muestra, ya que en el resto de apartamentos los precios tienden a concentrarse un poco más en torno a la media.
Por su parte, respecto al área de los apartamentos analizados, el promedio de es de 75.2\(m^2\) y oscilan entre los 40\(m^2\) y 198\(m^2\) distribuidos, en general, de manera dispersa, que en gran parte se explica por valores extremos en el último cuartil de la muestra, de manera que mientras que el 75% de apartamentos está entre los 40\(m^2\) y 83\(m^2\) (43\(m^2\) de diferencia) el 25% está entre los 83\(m^2\) y 198\(m^2\) (diferencia de 115\(m^2\) ).
Ahora, en cuanto a la relación de ambas variables, se encuentra que el precio por metro cuadrado promedio de los inmuebles estudiados es de 3.3 millones de pesos, siendo un indicador esencial en la comprensión del mercado inmobiliario de una ciudad. Sin embargo, al aplicar una regresión lineal entre ambas variables, la cual revela una correlación positiva entre ellas, se encuentra que por cada metro cuadrado adicional que tiene un apartamento, su valor se incrementa entre 479 mil pesos y 514 mil pesos.
2.2. Evaluación del modelo utilizado
Para realizar el anterior análisis, se llevó a cabo la aplicación de una regresión lineal entre ambas variables, en la que el área construida es la independiente y el precio la dependiente. Es decir, se planteó un análisis de la variación de precios en función del área construida, la cual se explica en un 70% según el indicador de bondad R2.
En este sentido, se validaron los supuestos del modelo diseñado y se tuvo como resultado que se cumplen todos, por lo que, en principio, la ecuación lineal ofrece un poder explicativo satisfactorio pero no concluyente frente a la relación de ambas variables. No obstante, como ejercicio exploratorio, se adelantaron transformaciones Box-Cox del mismo, a decir:
- Modelo Original (lin-lin): \(Y= \beta_0 + \beta_1 X + e\)
- Modelo log-lin: $ log(Y)= _0 + _1 X + e$
- Modelo lin-log: \(Y= \beta_0 + log(\beta_1) X + e\)
- Modelo log-log: \(log(Y)= \beta_0 + log(\beta_1) X + e\)
- Modelo Inverso: \(1/Y= \beta_0 + \beta_1 X + e\)
Este proceso permitió corroborar la pertinencia de este modelo frente a potenciales transformaciones al ser el que mejores resultados presentó en el cumplimiento de los supuestos y con indicador de bondad R2 más alto.
3. Conclusiones y Recomendaciones
Como se pudo observar, el modelo plantea una herramienta válida para la caracterización y predicción de los precios de los apartamentos según su área construida, permitiendo predecir posibles valores apropiados y atractivos en función de las características de los inmuebles que permitan llevar a cabo decisiones de negocio por parte de A&S. No obstante, para enriquecer, ajustar y/o descartar el modelo, se hace necesario:
• Levantar información en relación a más variables, ya que, como se pudo ver, el área construida, por sí misma, no explica de manera determinante las variaciones en el precio. En este sentido, se hace necesario registrar datos en torno a la ubicación específica del inmueble (ya que el entorno urbano del inmueble también determina su atractivo y demanda) y la configuración del inmueble (número de baños, parqueaderos, piso, habitaciones etc.)
• Promover el levantamiento de información respecto a más apartamentos con el fin de agrandar la muestra y encontrar patrones frente a la mayor cantidad de inmuebles posible.
Anexo: construcción, aplicación y comparación del modelo
1. Análisis exploratorio de variables
A partir del abordaje de medidas de tendencia central, forma, dispersión y posición se plantea el análisis del comportamiento de las variables precio y área construida para la muestra seleccionada.
1.1. Precios de las viviendas
Cómo se puede ver, los datos de precio de vivienda para la muestra seleccionada, revelan una distribución normal, de manera que la media (237.5 millones de pesos) y la mediana (236.1 millones de pesos) tienen valores similares, dándole simetría a la muestra, con un ligero sesgo hacia la derecha en razón de valores atípicos en la cola derecha de la muestra, es decir los más caros.
## Skipping install of 'paqueteMETODOS' from a github remote, the SHA1 (69a119e2) has not changed since last install.
## Use `force = TRUE` to force installation## 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## Loading required package: ggplot2## 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##
## 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##
## Attaching package: 'patchwork'## The following object is masked from 'package:MASS':
##
## area## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ lubridate 1.9.3 ✔ stringr 1.5.1
## ✔ purrr 1.0.2 ✔ tibble 3.2.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%() masks ggplot2::%+%()
## ✖ psych::alpha() masks ggplot2::alpha()
## ✖ purrr::compose() masks flextable::compose()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ rapportools::n() masks dplyr::n()
## ✖ 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##
## Please cite as:
##
## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.
## R package version 5.2.3. https://CRAN.R-project.org/package=stargazerlibrary("nortest")
library("ggfortify")
library("tidyverse")
# Limpieza de datos (filtro solo para apartamentos con un área menor a
# 200 metros cuadrados)
data("vivienda4")
v4<-subset(vivienda4, tipo=="Apartamento" & areaconst<200)# Histograma (precio)
v4 %>% ggplot(aes(x=preciom))+
geom_histogram(color="black", fill="#43766C", bins=30) +
geom_vline(xintercept = mean(v4$preciom),
col = "#B19470",
lwd = 1) +
labs(title = "Histograma variable Precio",
x = "Precio (millones de pesos COP)",
y = "Frecuencia")+
theme(plot.title = element_text(hjust = 0.5))+
annotate("text",
x = mean(v4$preciom)*1.05,
y = mean(v4$preciom)*1,
label = paste("Media =", round(mean(v4$preciom), 1)),
col = "#B19470",
size = 3)+
geom_vline(xintercept = median(v4$preciom),
col = "#76453B",
lwd = 1) +
annotate("text",
x = median(v4$preciom)*0.95,
y = median(v4$preciom)*1,
label = paste("Mediana =", round(median(v4$preciom),1)),
col = "#76453B",
size = 3)
Así, en cuanto a otros indicadores frente a la variable precios, se identifican:
# Tabla resumen (precio)
resumen_muestra_p<-psych::describe(v4$preciom)
tabla_resumen_p<-matrix(c(resumen_muestra_p$min,resumen_muestra_p$max,
resumen_muestra_p$mean,resumen_muestra_p$median,
resumen_muestra_p$sd,
((sd(v4$preciom)/mean(v4$preciom))*100),
resumen_muestra_p$skew,resumen_muestra_p$kurtosis),
ncol=8, byrow=TRUE)
tabla_resumen_p<-as.data.frame (tabla_resumen_p)
colnames(tabla_resumen_p) = c("Valor mínimo", "Valor máximo","Media", "Mediana", "Desviación estándar", "Coeficiente de Variación","Sesgo (Skewness)", "Curtosis")
rownames(tabla_resumen_p) <- c('Precio')
tabla_resumen_p<-format(round(tabla_resumen_p, 2), nsmall = 2)
tabla_resumen_pLos valores oscilan entre los 207.4 y 300.5 millones de pesos con una desviación estándar de 12.95 millones de pesos, lo que significa que el 95% de los casos tienen un valor entre los 211.6 y 263.4 millones de pesos, mientras que el 68% de los casos entre los 224.6 y 250.5 millones de pesos. De esta manera, con un coeficiente de variación de 5.45%, se observa que los precios de las viviendas analizadas fluctúan poco alrededor de la media.
En este sentido, al tener un sesgo de 1.14 se corrobora la tendencia a ser una distribución normal con pocos valores mucho mayores a la media. Además, con un valor de curtosis de 2.53, se logra identificar que se trata de una muestra en la que, si bien los precios se concentran alrededor de la media, hay presencia de valores de apartamentos que son ligeramente más caros frente a la tendencia general de los datos y que hacen que la distribución tenga la cola de la derecha más larga, sin que necesariamente muchos valores se ubiquen en este espectro de la gráfica.
Esto se refuerza al analizar los cuartiles, ya que como se observa que entre el Q1 y el valor mínimo hay 21.3 millones de pesos, entre el Q2 y Q1 7.2 millones, entre el Q3 y Q2 7.5 millones y entre el valor máximo y el Q3 56.8 millones de pesos, lo que revela la existencia de valores extremos en el último 25% de datos observados.
# Cuartiles (precio)
cuartiles_p1<-quantile(v4$preciom, prob=c(0,0.25,0.5,0.75,1))
cuartiles_p <- as.data.frame(cuartiles_p1)
rownames(cuartiles_p) <- c('Valor mínimo','Q1 (25%)', 'Q2 (50%)',
'Q3 (75%)', 'Q4 (100%)')
colnames(cuartiles_p)<-'Valor'
cuartiles_p<-format(round(cuartiles_p, 2), nsmall = 2)
cuartiles_pLa existencia de estos valores atípicos frente a la muestra (puntos rojos), se refuerza gráficamente al plantearlo en un diagrama de cajas:
boxplot_p<-ggplot(data=v4)+
geom_boxplot(aes(x=preciom), col= "#43766C", outlier.color = "red")+
labs(title = "Diagrama de cajas - Variable precio",
x = "Precio (millones de pesos COP)")+
theme(plot.title = element_text(hjust = 0.5))
boxplot_p
1.2. Áreas construidas de las viviendas
Al igual que los valores de precio, el área construida de los apartamentos seleccionados muestra una distribución normal con un sesgo hacia la derecha, aunque con una dispersión de datos mucho más visible en la medida que se presenta una mayor cantidad de muestras con valores alejados de la media.
# Histograma (Área)
v4 %>% ggplot(aes(x=areaconst))+
geom_histogram(color="black", fill="#43766C", bins=30) +
geom_vline(xintercept = mean(v4$areaconst),
col = "#B19470",
lwd = 1) +
labs(title = "Histograma variable Área",
x = "Área (millones de pesos COP)",
y = "Frecuencia")+
theme(plot.title = element_text(hjust = 0.5))+
annotate("text",
x = mean(v4$areaconst)*1.2,
y = mean(v4$areaconst)*3,
label = paste("Media =", round(mean(v4$areaconst), 1)),
col = "#B19470",
size = 3)+
geom_vline(xintercept = median(v4$areaconst),
col = "#76453B",
lwd = 1) +
annotate("text",
x = median(v4$areaconst)*0.80,
y = median(v4$areaconst)*4.4,
label = paste("Mediana =", round(median(v4$areaconst),1)),
col = "#76453B",
size = 3)
Con una mediana de 70\(m^2\) y una media de 75.2\(m^2\), las áreas oscilan entre los 40\(m^2\) y los 198\(m^2\) con una desviación estándar de 21.8\(m^2\) y un coeficiente de variación del 29%, mostrando una dispersión mucho mayor a los datos de precio. Así mismo, tiene un sesgo relativamente mayor con un valor de 1.94 que revela un comportamiento similar frente a las colas de la gráfica y un valor curtosis de 5.45, lo cual explica la mayor longitud de la cola derecha de la misma compuesta por datos extremos.
# tabla resumen (Área)
resumen_muestra_a<-psych::describe(v4$areaconst)
tabla_resumen_a<-matrix(c(resumen_muestra_a$min,resumen_muestra_a$max,
resumen_muestra_a$mean,resumen_muestra_a$median,
resumen_muestra_a$sd,
((sd(v4$areaconst)/mean(v4$areaconst))*100),
resumen_muestra_a$skew,resumen_muestra_a$kurtosis),
ncol=8, byrow=TRUE)
tabla_resumen_a<-as.data.frame (tabla_resumen_a)
colnames(tabla_resumen_a) = c("Valor mínimo", "Valor máximo", "Media",
"Mediana", "Desviación estándar",
"Coeficiente de Variación","Sesgo (Skewness)",
"Curtosis")
rownames(tabla_resumen_a) <- c('Área')
tabla_resumen_a<-format(round(tabla_resumen_a, 2), nsmall = 2)
tabla_resumen_aEn cuanto a la observación de los cuartiles, se confirma este comportamiento de los datos, ya que el 75% de los datos son iguales o menores a los 83\(m^2\), revelando un 25% restante que muestran tendencia a ser valores extremos, donde la diferencia entre el Q4 y Q3 es marcadamente mayor a las distancias entre los valores de los demás cuartiles.
# Cuartiles (area)
cuartiles_a1<-quantile(v4$areaconst, prob=c(0,0.25,0.5,0.75,1))
cuartiles_a <- as.data.frame(cuartiles_a1)
rownames(cuartiles_a) <- c('Valor mínimo','Q1 (25%)', 'Q2 (50%)',
'Q3 (75%)', 'Q4 (100%)')
colnames(cuartiles_a) <- 'Valor'
cuartiles_a<-format(round(cuartiles_a, 2), nsmall = 2)
cuartiles_aLo anterior, se comprueba al identificar la cantidad de valores atípicos hacia la derecha en el siguiente diagrama de cajas:
#Cajas (area)
boxplot_a<-ggplot(data=v4)+
geom_boxplot(aes(x=areaconst), col= "#43766C", outlier.color = "red")+
labs(title = "Diagrama de cajas - Variable área construida",
x = "Área construida")+
theme(plot.title = element_text(hjust = 0.5))
boxplot_a
2. Análisis Bivariado
Teniendo en cuenta que el promedio de precio por metro cuadrado es de 3.33 millones de pesos, se observa un comportamiento de los datos que revela que, a medida que aumenta el área construida de los apartamentos, aumenta su precio:
#precio por metro cuadrado (promedio)
pr_pxm<-mean((v4$preciom/v4$areaconst))
#Gráfica
relacion_pxa <- ggplot(data = v4) +
geom_point(mapping = aes(x = areaconst, y = preciom), color = "#43766C") +
geom_smooth(mapping = aes(x = areaconst, y = preciom), method = "lm", se = FALSE, color = "#112630") +
labs(title = "Gráfico de dispersión Precio - Área construida", x = "Área construida en m²", y = "Precio") +
theme(plot.title = element_text(hjust = 0.5))
relacion_pxa ## `geom_smooth()` using formula = 'y ~ x'
Para corroborar dicha correlación se usará el coeficiente de Pearson, por lo que será necesario, como ejercicio preliminar, comprobar la normalidad de ambas variables a través de las pruebas Shapiro-Wilk y Kolmogorov-Smirnov a partir de las siguientes hipótesis:
\(H_0\)= La distribución es normal.
\(H_a\)= La distribución no es normal.
##
## Shapiro-Wilk normality test
##
## data: v4$preciom
## W = 0.93957, p-value < 2.2e-16##
## Shapiro-Wilk normality test
##
## data: v4$areaconst
## W = 0.83913, p-value < 2.2e-16##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: v4$areaconst
## D = 0.13138, p-value < 2.2e-16##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: v4$preciom
## D = 0.081757, p-value < 2.2e-16A partir de la prueba Shapiro – Wilk, dado el p-valor arrojado para ambas variables (2.2e-16) se rechazaría la hipótesis nula, y se asumiría que ninguna de las distribuciones es normal.
Ahora, como se trata de una muestra relativamente grande y, teniendo en cuenta que la prueba Shapiro – Wilk se recomienda para tamaños muestrales menores a 50, se complementará con la prueba Kolmogorov-Smirnov usando las mismas hipótesis, la cual, según la literatura, es más apta para este tipo de muestras.
Como se puede ver, a partir de la aplicación de ambas pruebas, contrario a las intuiciones que sugieren los histogramas presentados, ninguna de las dos variables muestra una distribución normal. Esto, de manera gráfica, se observa a través de un gráfico normal (Q-Q), dónde en ninguno de los dos casos los datos tienden a ajustarse a la línea roja:
# Gráfico Q-Q
par(mfrow = c(1, 2))
qqnorm(v4$preciom)
qqline(v4$preciom, col = 2)
qqnorm(v4$areaconst)
qqline(v4$areaconst, col = 2)
Por esta razón, el coeficiente de Pearson se aplicará con un objetivo netamente académico, ya que para este tipo de distribuciones se requiere aplicar el de Spearman, al ser no paramétrico.
## Warning in cor.test.default(v4$preciom, v4$areaconst, method = "spearman"):
## Cannot compute exact p-value with ties##
## Spearman's rank correlation rho
##
## data: v4$preciom and v4$areaconst
## S = 109351031, p-value < 2.2e-16
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.7391699##
## Pearson's product-moment correlation
##
## data: v4$preciom and v4$areaconst
## t = 56.37, df = 1358, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.8203549 0.8522488
## sample estimates:
## cor
## 0.8370114Si bien se hace como un ejercicio exploratorio, el coeficiente de Pearson, con un valor de 0.74, revela una correlación positiva débil. Es decir, a medida que aumenta el área construida, aumenta el precio del inmueble. Ahora, el coeficiente Spearman sustenta que una alta correlación (0.84) entre ambas variables.
3. Estimación del modelo de regresión lineal
El modelo de regresión lineal se lleva a cabo a partir de la siguiente ecuación:
\(Y= \beta_0 + \beta_1 X + e\)
Donde:
\(X\): Variable dependiente.
\(Y\): Variable independiente.
\(\beta_0\): Intercepto.
\(\beta_1\): Pendiente.
\(e\): Error.
##
## Call:
## lm(formula = preciom ~ areaconst, data = v4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.4010 -5.0783 -0.0175 4.6173 24.3353
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.002e+02 6.899e-01 290.15 <2e-16 ***
## areaconst 4.967e-01 8.811e-03 56.37 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.087 on 1358 degrees of freedom
## Multiple R-squared: 0.7006, Adjusted R-squared: 0.7004
## F-statistic: 3178 on 1 and 1358 DF, p-value: < 2.2e-16Con esto, se plantea que cuando el apartamento, en un escenario hipotético, tiene 0\(m^2\), tiene un valor de 200.2 millones de pesos y, por otro lado, a por cada metro cuadrado de área construida, el valor del apartamento aumenta 500 mil pesos (0.5 millones), lo que contrasta con el valor promedio por metro cuadrado de la muestra (3.3 millones de pesos). Dando resultado al modelo:
\(Y= 200.2 + 0.497 X + e\)
4. Construcción de un intervalo de confianza
## 2.5 % 97.5 %
## (Intercept) 198.8328481 201.5398110
## areaconst 0.4794099 0.5139806De acuerdo a esto, se puede afirmar con un 95% de confianza que cuando el valor del área construida es 0, el precio del apartamento estará entre 198.8 y 201.5 millones de pesos y que por cada metro cuadrado adicional en los inmuebles, el valor aumenta entre 479 mil pesos y 514 mil pesos.
Ahora, a partir de la prueba de hipótesis:
\(H_0=\beta_1 = 0\)
\(H_a=\beta_1 \neq 0\)
Como el p-valor es menor que 0.05, por la regla de decisión, se rechaza la hipótesis nula al nivel del 5%. Por consiguiente, con una confianza del 95%, se puede afirmar que la línea de regresión no pasa por el origen (ya que el intercepto poblacional es diferente de cero).
5. Indicador de Bondad R2
## [1] 0.700588Del análisis del indicador de bondad \(R^2\), se puede interpretar que la variabilidad del precio se puede explicar en un 70% por los cambios en la variable de área construida, de manera que el restante responde al comportamiento de otras variables que no se contemplan en este análisis. Así, debido a que el indicador \(R^2\), desde una perspectiva teórica ideal, debería oscilar entre el 80% y 90%, será necesario validar el cumplimiento de supuestos del modelo para corroborar su validez (punto 7).
6. Modelo estimado para un apartamento de 110 metros cuadrados.
Definido el modelo, se establecerá el valor que un apartamento de 110\(m^2\) tendría a partir del mismo. Esto, con el objetivo de establecer la pertinencia y oportunidad que implica una oferta de 200 millones de pesos por un apartamento de estrato 4 con esta área.
## fit lwr upr
## 1 254.8228 254.113 255.5326## fit lwr upr
## 1 254.8228 240.9025 268.7431De esta forma, con un intervalo de confianza de 95%, se puede afirmar que, en promedio, un apartamento de 110 metros estaría entre los 254.1 y 255.5 millones de pesos. Bajo esta misma lógica, se espera que, al seleccionar un apartamento con esta área construida, tenga un valor de 254.8 millones de pesos.
Esto quiere decir que una oferta de 200 millones de pesos por un apartamento con estas características resulta ser, desde la perspectiva del vendedor, una mala opción. Sin embargo, deben considerarse otras variables como la zona en la que se encuentra, el estado y años de construcción, entre otras, las cuales también pueden incidir en el precio.
De esta forma, desde la perspectiva del comprador no necesariamente es una buena opción si el inmueble requiere mejoras o se encuentra en una zona o estado poco llamativo.
7. Validación de supuestos
Como se afirmó anteriormente, es necesario adelantar la validación de supuestos con el fin de evaluar de manera más integral el modelo resultante. Para esto, se estudia el comportamiento de los errores a partir de pruebas específicas y la observación de gráficas concretas que explican las características de cada supuesto en relación al modelo.
7.1. Normalidad
Como se puede ver en el gráfico del cuadrante superior derecho, los residuales responden a una distribución normal, de manera que los puntos tienden a ajustarse a la línea.
Esto se refuerza al aplicar la prueba Shapiro - Wilk y Anderson-Darling. Se cumple el supuesto.
##
## Shapiro-Wilk normality test
##
## data: modelo_rl$residuals
## W = 0.99883, p-value = 0.5243##
## Anderson-Darling normality test
##
## data: modelo_rl$residuals
## A = 0.43494, p-value = 0.29957.2. Homoscedasticidad
Según el recuadro izquierdo inferior y el resultado de la prueba Breusch-Pagan, se puede establecer que cumple con el supuesto de homoscedasticidad, de manera que la línea del gráfico denota que la varianza de los errores frente a los valores reales de \(y\) es constante.
##
## studentized Breusch-Pagan test
##
## data: modelo_rl
## BP = 0.47718, df = 1, p-value = 0.48977.3. Linealidad
A partir del gráfico superior izquierdo, la horizontalidad de la línea azul permite observar que la relación entre los residuos y valores reales tiende a ser lineal, de manera que el promedio de los residuos es muy cercano a 0. Se cumple el supuesto.
## [1] -2.311717e-167.4. No autocorrelación
La aplicación de la prueba Durbin-Watson permite entender que no existe autocorrelación en la muestra estudiada, ya que este estadístico toma valores entre 0 y 4, donde un valor cercano a 2, como en este caso (2.02), sugiere que no la hay. Se cumple el supuesto.
##
## Durbin-Watson test
##
## data: modelo_rl
## DW = 2.0219, p-value = 0.6536
## alternative hypothesis: true autocorrelation is greater than 07.5. Outliers
A partir del análisis de la distancia de Cook, se plantea la identificación de valores atípicos que puedan estar influyendo el análisis, de manera que, según su aplicación, se encuentra que no hay valores de esta naturaleza en esta muestra. Se cumple el supuesto.
## [1] 08. Transformaciones del modelo
Si bien el modelo muestra un buen poder predictivo y el cumplimiento de los supuestos, a continuación, se realiza, a partir de la herramienta Box-Cox, la identificación de posibles transformaciones del modelo que permitan mejorarlo.
## [1] 1Con un valor de lamda = 1, se plantea que el modelo aplicado es el más apto para el análisis de las variables estudiadas. No obstante, como ejercicio académico, se planteará el análisis de todas las transformaciones posibles.
9. Comparación de modelos
Las transformaciones del modelo que se trabajarán son:
- Modelo Original (lin-lin): \(Y= \beta_0 + \beta_1 X + e\)
- Modelo log-lin: $ log(Y)= _0 + _1 X + e$
- Modelo lin-log: \(Y= \beta_0 + log(\beta_1) X + e\)
- Modelo log-log: \(log(Y)= \beta_0 + log(\beta_1) X + e\)
- Modelo Inverso: \(1/Y= \beta_0 + \beta_1 X + e\)
#Transformaciones
# Lin- Lin / Modelo Inicial
m_lineal <- lm(formula = preciom ~ areaconst, data = v4)
# Modelo Log -Lin
m_log_lin <- lm(formula = log(preciom) ~ areaconst, data = v4)
# Modelo Lin-Log
m_lin_log <- lm(formula = preciom ~ log10(areaconst), data = v4)
# Modelo Log - Log
m_log_log <- lm(formula = log10(preciom) ~ log10(areaconst), data = v4)
# Modelo Inverso
m_inverso <- lm(formula = (1/preciom) ~ areaconst, data = v4)
modelos<- list(m_lineal,
m_log_lin,
m_lin_log,
m_log_log,
m_inverso)
stargazer(modelos, type = "text", df = FALSE)##
## ======================================================================================
## Dependent variable:
## ------------------------------------------------------------------
## preciom log(preciom) preciom log10(preciom) (1/preciom)
## (1) (2) (3) (4) (5)
## --------------------------------------------------------------------------------------
## areaconst 0.497*** 0.002*** -0.00001***
## (0.009) (0.00004) (0.00000)
##
## log10(areaconst) 96.966*** 0.172***
## (1.844) (0.003)
##
## Constant 200.186*** 5.318*** 57.054*** 2.055*** 0.005***
## (0.690) (0.003) (3.437) (0.006) (0.00001)
##
## --------------------------------------------------------------------------------------
## Observations 1,360 1,360 1,360 1,360 1,360
## R2 0.701 0.682 0.671 0.663 0.661
## Adjusted R2 0.700 0.681 0.671 0.662 0.660
## Residual Std. Error 7.087 0.030 7.432 0.013 0.0001
## F Statistic 3,177.556*** 2,906.067*** 2,766.449*** 2,667.104*** 2,642.150***
## ======================================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01Como se puede ver, el modelo inicial trabajado tiene el indicador de bondad \(R^2\) más alto, por lo que confirma el resultado del ejercicio Box-Cox, al ser el más óptimo para el análisis de las dos variables estudiadas con un valor de 0.7, seguido del modelo “log-lin”, con 0.681.
En este sentido, para soportar el análisis de la pertinencia de cada modelo, será necesario observar el cumplimiento de los supuestos por parte de cada uno de ellos.
Normalidad
#Pruebas de normalidad
p_shapiro <- c(shapiro.test(m_lineal$residuals)$p.value,
shapiro.test(m_log_lin$residuals)$p.value,
shapiro.test(m_lin_log$residuals)$p.value,
shapiro.test(m_log_log$residuals)$p.value,
shapiro.test(m_inverso$residuals)$p.value)
p_shapiro<- as.data.frame(p_shapiro)
p_ad <- c(ad.test(m_lineal$residuals)$p.value,
ad.test(m_log_lin$residuals)$p.value,
ad.test(m_lin_log$residuals)$p.value,
ad.test(m_log_log$residuals)$p.value,
ad.test(m_inverso$residuals)$p.value)
p_ad<- as.data.frame(p_ad)
normalidad_modelos<-cbind(p_shapiro, p_ad)
rownames(normalidad_modelos) = c("Lin- Lin / Modelo Inicial", "Modelo Log -Lin ",
"Modelo Lin-Log","Modelo Log - Log",
"Modelo Inverso")
colnames(normalidad_modelos) <- c('Prueba Shapiro - Wilk',
'Prueba Anderson - Darling')
normalidad_modelos<-format(round(normalidad_modelos, 4), nsmall = 4)
normalidad_modelosSegún los resultados de la prueba Shapiro – Wilk y Anderson - Darling, se deduce que todos los modelos, a excepción del Lin-Log cumplen con el criterio de normalidad de errores. Lo anterior, a pesar de que gráficamente todos los modelos denotan un comportamiento normal en sus errores.
#Gráficos de normalidad
par(mfrow=c(3,2))
title(plot(m_lineal, which = 2), main = "Modelo Lineal - Inicial")
title(plot(m_log_lin, which = 2), main = "Modelo Log - Lin")
title(plot(m_lin_log, which = 2), main = "Modelo Lin - Log")
title(plot(m_log_log, which = 2), main = "Modelo Log - Log")
title(plot(m_inverso, which = 2), main = "Modelo Inverso")
Linealidad
Cómo se puede observar gráficamente, los errores muestran una tendencia a ser lineales para todos los modelos:
par(mfrow=c(3,2))
title(plot(m_lineal, which = 1), main = "Modelo Lineal - Inicial")
title(plot(m_log_lin, which = 1), main = "Modelo Log - Lin")
title(plot(m_lin_log, which = 1), main = "Modelo Lin - Log")
title(plot(m_log_log, which = 1), main = "Modelo Log - Log")
title(plot(m_inverso, which = 1), main = "Modelo Inverso")
Esto se soporta a al observar los promedios de los errores en cada uno de ellos, ya que en todos se tiene como resultado valores muy cercanos a 0.
promedio_errores <- c(mean(modelo_rl$residuals), mean(m_log_lin$residuals),
mean(m_lin_log$residuals), mean(m_log_log$residuals),
mean(m_inverso$residuals))
promedio_errores<- as.data.frame(promedio_errores)
rownames(promedio_errores) = c("Lin- Lin / Modelo Inicial",
"Modelo Log -Lin ",
"Modelo Lin-Log","Modelo Log - Log",
"Modelo Inverso")
colnames(promedio_errores) <- c('Promedio de errores')
promedio_errores<-format(round(promedio_errores, 4), nsmall = 4)
promedio_erroresHomocedasticidad
par(mfrow=c(3,2))
title(plot(m_lineal, which = 3), main = "Modelo Lineal - Inicial")
title(plot(m_log_lin, which = 3), main = "Modelo Log - Lin")
title(plot(m_lin_log, which = 3), main = "Modelo Lin - Log")
title(plot(m_log_log, which = 3), main = "Modelo Log - Log")
title(plot(m_inverso, which = 3), main = "Modelo Inverso")
Al observar la gráfica, la varianza de los errores en los modelos tiende a ser constante, a excepción de los modelos Lin – Log y Log – Log. Sin embargo, para corroborar este resultado, se aplica la prueba Breusch-Pagan:
p_bp <- c(lmtest::bptest(m_lineal)$p.value,
lmtest::bptest(m_log_lin)$p.value,
lmtest::bptest(m_lin_log)$p.value,
lmtest::bptest(m_log_log)$p.value,
lmtest::bptest(m_inverso)$p.value)
p_bp<- as.data.frame(p_bp)
rownames(p_bp) = c("Lin- Lin / Modelo Inicial", "Modelo Log -Lin ",
"Modelo Lin-Log","Modelo Log - Log",
"Modelo Inverso")
colnames(p_bp) <- c('Prueba Breusch-Pagan')
p_bp<-format(round(p_bp, 4), nsmall = 4)
p_bpComo se puede ver, el modelo Log-Log si cumple con el criterio, pero como se confirmó anteriormente, el Lin-Log no, al que se suman el modelo inverso y Log-Lin.
No autocorrelación
A partir de la prueba Durbin-Watson, se encuentra que todos los modelos estudiados cumplen con el criterio.
p_dw <- c(lmtest::dwtest(m_lineal)$p.value,
lmtest::dwtest(m_log_lin)$p.value,
lmtest::dwtest(m_lin_log)$p.value,
lmtest::dwtest(m_log_log)$p.value,
lmtest::dwtest(m_inverso)$p.value)
p_dw<- as.data.frame(p_dw)
rownames(p_dw) = c("Lin- Lin / Modelo Inicial", "Modelo Log -Lin ",
"Modelo Lin-Log","Modelo Log - Log",
"Modelo Inverso")
colnames(p_dw) <- c('Prueba Durbin-Watson')
p_dw<-format(round(p_dw, 4), nsmall = 4)
p_dwResumen de validación de supuestos
Así, se encuentra que, respecto al cumplimiento de los criterios, se establecen los criterios que cada uno cumple.
resumen_supuestos<-matrix(c("Sí", "Sí", "Sí", "Sí",
"Sí", "No", "Sí", "Sí",
"Sí", "No" , "Sí", "No",
"Sí", "Sí", "Sí", "Sí",
"Sí", "No", "Sí", "Sí"), ncol=4, byrow=TRUE)
rownames(resumen_supuestos) = c("Lin- Lin / Modelo Inicial", "Modelo Log -Lin ",
"Modelo Lin-Log","Modelo Log - Log",
"Modelo Inverso")
colnames(resumen_supuestos) <- c('Linealidad', 'Homocedasticidad',
'No Autocorrelación', 'Normalidad')De manera que, a partir de la aplicación de la distancia Cook, ninguno de los modelos presenta outliers que puedan afectar el cálculo de los distintos coeficientes.