Usando la base de datos wage1 de la librería wooldridge, se ajusta un modelo lineal de la variable salario por hora (wage) en función de educación en años (educ).
library(wooldridge)
## Warning: package 'wooldridge' was built under R version 4.0.2
data('wage1')
str(wage1)
summary(wage1)
attach(wage1)
grafica de las variables salario vs educación
library(ggplot2)
ggplot(data=wage1 , aes(x = educ, y = wage)) +
geom_point(color = 'slateblue', size = 2, alpha = 0.6) +
geom_abline(color = 'red') +
xlab('Educación (años)') +
ylab('Salario (horas)') +
ggtitle('Salario vs Educación') +
theme_minimal()
modelo lineal
modelo.lineal<-lm(wage~educ)
summary(modelo.lineal)
##
## Call:
## lm(formula = wage ~ educ)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.3396 -2.1501 -0.9674 1.1921 16.6085
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.90485 0.68497 -1.321 0.187
## educ 0.54136 0.05325 10.167 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.378 on 524 degrees of freedom
## Multiple R-squared: 0.1648, Adjusted R-squared: 0.1632
## F-statistic: 103.4 on 1 and 524 DF, p-value: < 2.2e-16
grafica del modelo lineal
ggplot(data=wage1 , aes(x = educ, y = wage)) +
geom_point(color = 'slateblue', size = 2, alpha = 0.6) +
geom_smooth(se=FALSE, method="lm", color="red") +
xlab('Educación (años)') +
ylab('Salario (horas)') +
ggtitle('Salario vs Educación') +
theme_minimal()
## `geom_smooth()` using formula 'y ~ x'
En el modelo lineal simple, encontramos con un nivel de significancia de 0.001 que el coeficiente estimado de regresión en la variable educación presenta un valor significativo,\(\beta_1 = 0.54136\), y un \(p-value = 2*10^{-16}\). la pendiente es diferente de cero y de esta manera existe una relación entre los datos que se analizaron.
Segun el modelo tenemos una ecuacion: \(\widehat{wage} = - 0.90 + 0.54 * educ\), para una persona con cero años de educación su salario sería de -0.90 unidades($), cosa que en la practica no es algo logico, pero graficamente se observa que si hay unos valores de salario positivos para estas personas, podemos concluir que este modelo no es tan eficiente con valores bajos de la variable educación.
shapiro.test(residuals(modelo.lineal))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo.lineal)
## W = 0.84606, p-value < 2.2e-16
una de las mayores desventajas que presenta este modelo es su \(R^{2} = 0.1648\), indica que este modelo explica un 16% de la varianza de la variable dependiente wage, aplicando la prueba de Shapiro-Wilk se optiene \(p-value = 2.2*10^{-16}\), que indica anormalidad en los residuales.
Usando la base de datos wage1 se estima un modelo semilogarítmico de lwage en función de edu.
modelo semi-logaritmico
modelo.semilog<-lm(lwage~educ)
summary(modelo.semilog)
##
## Call:
## lm(formula = lwage ~ educ)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.21158 -0.36393 -0.07263 0.29712 1.52339
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.583773 0.097336 5.998 3.74e-09 ***
## educ 0.082744 0.007567 10.935 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4801 on 524 degrees of freedom
## Multiple R-squared: 0.1858, Adjusted R-squared: 0.1843
## F-statistic: 119.6 on 1 and 524 DF, p-value: < 2.2e-16
ggplot(data=wage1 , aes(x = educ, y = lwage)) +
geom_point(color = 'slateblue', size = 2, alpha = 0.6) +
geom_smooth(se=FALSE, method="lm", color="red") +
xlab('Educación (años)') +
ylab('Log-salario (horas)') +
ggtitle('Log-salario vs Educación') +
theme_minimal()
## `geom_smooth()` using formula 'y ~ x'
shapiro.test(residuals(modelo.semilog))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo.semilog)
## W = 0.98008, p-value = 1.345e-06
una vez realizado el summary del modelo, se observa que con un nivel de significancia de 0.001, el coeficiente de la variable educación es significativo y con un valor \(t< 2*10^{-16}\). El \(\beta_1 = 0.083\) (pendiente positiva) indica que si los años en educación aumentan, el salario recibido aumentará. Comparado con el \(\beta_1\) del modelo lineal (0.54), la pendiente del modelo semi_log es menos pronunciada debido al cambio en la escala que se realizó en el eje y. La prueba de shapiro.test nos muestra que no se tiene normalidad en los residuales del modelo.
grafica del modelo con el salario sin log
ggplot(data=wage1 , aes(x = educ, y = wage)) +
geom_point(color = 'slateblue', size = 2, alpha = 0.6) +
stat_function(fun=function(x)exp(0.583773 + 0.082744*x),color = 'red') +
xlab('Educación (años)') +
ylab('Salario (horas)') +
ggtitle('Salario vs Educación') +
theme_minimal()
modelo semi-logaritmico 2
modelo.semilog2 <- lm(lwage ~ educ + exper + tenure)
summary(modelo.semilog2)
##
## Call:
## lm(formula = lwage ~ educ + exper + tenure)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.05802 -0.29645 -0.03265 0.28788 1.42809
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.284360 0.104190 2.729 0.00656 **
## educ 0.092029 0.007330 12.555 < 2e-16 ***
## exper 0.004121 0.001723 2.391 0.01714 *
## tenure 0.022067 0.003094 7.133 3.29e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4409 on 522 degrees of freedom
## Multiple R-squared: 0.316, Adjusted R-squared: 0.3121
## F-statistic: 80.39 on 3 and 522 DF, p-value: < 2.2e-16
shapiro.test(residuals(modelo.semilog2))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo.semilog2)
## W = 0.98946, p-value = 0.000787
Luego de incluir en el modelo semi_log las variable exper y tenure se obtuvo que son significativas y positivas, lo que indica que si una de estas aumenta, el salario aumenta. Se evidencia un cambio al incluir las variables de \(R^{2} = 0.1858\) a \(R^{2} = 0.316\), indicanco que el ajuste del modelo mejora al momento de incluir estas dos variables. Las variables con mayor nivel de significancia(0.001) son edu y tenure, la variable exper aunque tenga menos nivel de significancia(0.05) nos ayuda a mejorar el ajuste del modelo. La prueba de shapiro.test esta mostrando que los residuales del modelo no cuentan con normalidad.
detach(wage1)
Usando la base de datos ceosal1 de la librería wooldridge, se ajusta un modelo logarítmico del salario de los ejecutivos salary en función de las ventas de las compañías sales.
modelo log-log
data('ceosal1')
str(ceosal1)
summary(ceosal1)
attach(ceosal1)
modelo.log_log<-lm(lsalary~lsales)
summary(modelo.log_log)
##
## Call:
## lm(formula = lsalary ~ lsales)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.01038 -0.28140 -0.02723 0.21222 2.81128
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.82200 0.28834 16.723 < 2e-16 ***
## lsales 0.25667 0.03452 7.436 2.7e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5044 on 207 degrees of freedom
## Multiple R-squared: 0.2108, Adjusted R-squared: 0.207
## F-statistic: 55.3 on 1 and 207 DF, p-value: 2.703e-12
ggplot(data=ceosal1 , aes(x = lsales , y = lsalary)) +
geom_point(color = 'slateblue', size = 2, alpha = 0.6) +
geom_smooth(se=FALSE, method="lm", color="red") +
xlab('log-ventas')+
ylab('log-salario (MUS$)') +
ggtitle('log-salario de ejecutivos vs log-ventas de las compañias ') +
theme_minimal()
## `geom_smooth()` using formula 'y ~ x'
shapiro.test(residuals(modelo.log_log))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo.log_log)
## W = 0.9037, p-value = 2.28e-10
la formula del modelo esta dada por: \[log(salary) = \beta_0+\beta_1log(sales)+\mu\]
Para este modelo tenemos que el coeficiente estimado de ventas es significativo con un nivel de significancia de (0.001) y un valor \(t = 2.7*10^{-12}\). el shapiro.test nos indica que no hay normalidad en los residuales del modelo.
\[\%\Delta_y=\beta_1\%\Delta _x\] la pendiente de este modelo esta dada por el \(\beta_1 = 0.25667\), si comparamos este valor con el concepto de elasticidad, encontramos que el valor obtenido se encuentra entre (0 y 1); de esta manera si las ventas aumentan el 1%, el salario aumenta 0.25%, como conclusión tenemos que esta relación sería inelástica.
detach(ceosal1)
Se descarga ahora la base de datos , en este caso Hprice2 con la intención de realizar un modelo log-log de la variable price en función de las variables price, rooms y proptax, donde price se refiere a precio medio de la vivienda, crime a número de delitos denunciados per cápita, rooms sería número medio de habitaciones en casas de la comunidad y proptax serían los impuestos de propiedad.
data('hprice2')
str(hprice2)
summary(hprice2)
attach(hprice2)
modelo.4
modelo.4<-lm(lprice ~ crime + rooms + proptax)
summary(modelo.4)
##
## Call:
## lm(formula = lprice ~ crime + rooms + proptax)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.90902 -0.11593 -0.00126 0.11336 1.43835
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.4161258 0.1204255 69.887 < 2e-16 ***
## crime -0.0127759 0.0016552 -7.719 6.40e-14 ***
## rooms 0.2906488 0.0171949 16.903 < 2e-16 ***
## proptax -0.0062557 0.0008608 -7.268 1.41e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2591 on 502 degrees of freedom
## Multiple R-squared: 0.6014, Adjusted R-squared: 0.5991
## F-statistic: 252.5 on 3 and 502 DF, p-value: < 2.2e-16
Despues de analizar el summary para este modelo se tiene que todos los coeficientes son significativos con un nivel de significancia de (0.001), con un \(R^{2} = 0.6014\) el modelo explica el 60% de la varianza de la variable independiente, en este caso el precio medio de la vivienda y la significancia global del modelo es de un \(P-value = 2.2e^{-16}\) lo cual indica que el modelo es válido.
incluimos en el mismo modelo la variable relacionada con la concentración de NOx nox.
modelo.nox<-lm(lprice ~ crime + rooms + proptax + nox)
summary(modelo.nox)
##
## Call:
## lm(formula = lprice ~ crime + rooms + proptax + nox)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.89876 -0.11675 -0.01297 0.12242 1.41087
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.655011 0.136688 63.320 < 2e-16 ***
## crime -0.012516 0.001638 -7.641 1.10e-13 ***
## rooms 0.281556 0.017190 16.379 < 2e-16 ***
## proptax -0.004263 0.001019 -4.184 3.39e-05 ***
## nox -0.047579 0.013376 -3.557 0.000411 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2562 on 501 degrees of freedom
## Multiple R-squared: 0.6113, Adjusted R-squared: 0.6082
## F-statistic: 196.9 on 4 and 501 DF, p-value: < 2.2e-16
Para este caso la significancia global del modelo.nox no presenta variacion con respecto al modelo.4 , de esta manera la variable relacionada con la concentración de NOx(ppm) si presenta significancia en el ajuste del modelo, con nivel de significancia de (0.001) pasando de un \(R^{2} = 0.6014\) a un \(R^{2} = 0.6113\).
El coeficiente \(\beta_4 = -0.047579\); al ser negativo nos permite inferir, que junto con las variables crimen e impuestos (ambos coeficientes negativos), siendo estos factores que reduce el precio de la vivienda; para el coeficiente de habitaciones que si es positivo se tiene que aumenta el precio.