TALLER REGRESION MULTIPLE ECONOMETRIA

1)

#regresion con todas las variables explicativas

RLM.Completo<-lm(formula = Y~.,datos_rl)

RLM.Completo
Call:
lm(formula = Y ~ ., data = datos_rl)

Interpretación: el intercepto es el valor para cuando X vale 0, los siguientes valores corresponden
a las pendientes para cada 1 de las variables predictoras del modelo.

En general, un coeficiente de regresión representa el cambio promedio en la variable respuesta (Y)

cuando la variable independiente (X) correspondiente se incrementa una unidad adicional,

asumiendo que las otras variables independientes permanecen fijas.
β0 =134,9670. Representa las horas mensuales hombre cuando el valor de
las demás variables es cero.
β1 =-1,2838. Significa que las horas mensuales hombre disminuyen en -1,28
horas por cada unidad que aumenta la ocupación diaria promedio, asumiendo
que las demás variables se mantengan fijas.
β2 =1,8035. Significa que las horas mensuales hombre aumentan en 1,80
horas por cada unidad que aumenta el numero promedio mensual de
registros, asumiendo que las demás variables se mantengan fijas.
β3 =0,6692. Significa que las horas mensuales hombre aumentan en 0,66
horas por cada unidad que aumenta el horario semanal de operación de la
mesa de servicio, asumiendo que las demás variables se mantengan fijas.
β4 =-21,4226. Significa que las horas mensuales hombre disminuyen en -
1,28 horas por cada unidad que aumenta la ocupación diaria promedio,
asumiendo que las demás variables se mantengan fijas.
β5 =5,6192. Significa que las horas mensuales hombre aumentan en
5,62horas por cada unidad que aumenta el numero de alas de construcción,
asumiendo que las demás variables se mantengan fijas.

β6 =-14,48. Significa que las horas mensuales hombre disminuyen en -14,48

horas por cada unidad que aumenta la capacidad operativa de atraque,
asumiendo que las demás variables se mantengan fijas.
β7 =29,3248. Significa que las horas mensuales hombre aumentan en
29,33horas por cada unidad que aumenta el numero habitaciones, asumiendo
que las demás variables se mantengan fijas.

Para las variables X2,X3,X5 y X7. El efecto de las respectivas variables tiene efecto directamente
proporcional en el valor de la variable Y, mientras que las variables X1, X4 y X6 tienen un efecto
inverso sobre la variable Y, a medida que aumentan su valores restan efecto o valor a la variable Y.

#regresion stepwise con base a los criterios de AKAIKE (AIC)

RLM.STEPWISE<-step(RLM.Vacio,
+ scope
=list(lower=RLM.Vacio,upper=RLM.Completo),direction = "both" )
Start: AIC=379.66
Y ~ 1

Df Sum of Sq RSS AIC

+ X7 1 80864843 10044358 326.59
+ X2 1 74351754 16557447 339.09
+ X6 1 72437083 18472118 341.82
+ X5 1 49171646 41737555 362.20
+ X1 1 37280870 53628332 368.47
+ X4 1 29710184 61199017 371.77
+ X3 1 21861795 69047406 374.79
<none> 90909201 379.66

Step: AIC=326.59
Y ~ X7

Df Sum of Sq RSS AIC

+ X2 1 3005141 7039217 319.70
+ X6 1 1887411 8156948 323.39
<none> 10044358 326.59
+ X4 1 447340 9597018 327.45
+ X3 1 95113 9949245 328.35
+ X5 1 82914 9961444 328.38
+ X1 1 1060 10043298 328.59
- X7 1 80864843 90909201 379.66

Step: AIC=319.7
Y ~ X7 + X2

Df Sum of Sq RSS AIC

+ X6 1 2254232 4784985 312.05
+ X5 1 732357 6306860 318.96
<none> 7039217 319.70
+ X4 1 56636 6982581 321.50
+ X1 1 19413 7019804 321.63
+ X3 1 13331 7025887 321.66
- X2 1 3005141 10044358 326.59
- X7 1 9518230 16557447 339.09

Step: AIC=312.05
Y ~ X7 + X2 + X6

Df Sum of Sq RSS AIC

+ X4 1 627934 4157051 310.54
<none> 4784985 312.05
+ X1 1 341094 4443891 312.20
+ X5 1 18433 4766552 313.96
+ X3 1 2330 4782655 314.04
- X6 1 2254232 7039217 319.70
- X2 1 3371962 8156948 323.39
- X7 1 6720685 11505670 331.99

Step: AIC=310.54
Y ~ X7 + X2 + X6 + X4

Df Sum of Sq RSS AIC

+ X1 1 576823 3580228 308.80
<none> 4157051 310.54
+ X5 1 87046 4070006 312.01
- X4 1 627934 4784985 312.05
+ X3 1 21663 4135388 312.41
- X2 1 2520244 6677296 320.38
- X6 1 2825530 6982581 321.50
- X7 1 6873416 11030467 332.93

Step: AIC=308.8
Y ~ X7 + X2 + X6 + X4 + X1

Df Sum of Sq RSS AIC

<none> 3580228 308.80
- X1 1 576823 4157051 310.54
+ X5 1 31004 3549224 310.58
+ X3 1 28130 3552098 310.60
- X4 1 863663 4443891 312.20
- X2 1 2684091 6264319 320.79
- X6 1 3376520 6956748 323.41
- X7 1 7251300 10831528 334.48
> summary(RLM.STEPWISE)

Call:
lm(formula = Y ~ X7 + X2 + X6 + X4 + X1, data = datos_rl)

Residuals:
Min 1Q Median 3Q Max
-854.72 -199.76 -53.76 230.44 845.37

Coefficients:
 Estimate Std. Error t value Pr(>|t|)
(Intercept) 201.3625 138.2240 1.457 0.16150
X7 30.7609 4.9587 6.203 5.85e-06 ***
X2 1.7789 0.4713 3.774 0.00128 **
X6 -15.1956 3.5897 -4.233 0.00045 ***
X4 -20.3421 9.5017 -2.141 0.04546 *
X1 -1.3249 0.7573 -1.750 0.09632 .
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 434.1 on 19 degrees of freedom

Multiple R-squared: 0.9606, Adjusted R-squared: 0.9503
F-statistic: 92.69 on 5 and 19 DF, p-value: 1.135e-12
summary(RLM.STEPWISE)

Con base a método stepwize) podemos ver que el modelo con las variables significativas
propuesto es: Y ~ β7X7 + β2X2 + β6X6 + β4X4 + β1X1+ β0

Y= 30,76*X7+1,7789X2-15,1956X6 -20,4321X4 -1,3249X1 + 201,3265. Las variables X5( NUMERO

DE ALAS DE CONSTRUCCIÓN ) y X3(HORARIO SEMANALD E OPERACIÓN DE LA MESA DE SERVICIO)
no son significativa en el modelo.

Usando el ANOVA del modelo completo tenemos:

Anova(RLM.Completo)
Anova Table (Type II tests)

Response: Y
Sum Sq Df F value Pr(>F)
X1 527298 1 2.5452 0.1290542
X2 2528613 1 12.2051 0.0027825 **
X3 27211 1 0.1313 0.7215132
X4 918986 1 4.4358 0.0503592 .
X5 30084 1 0.1452 0.7078750
X6 2439118 1 11.7731 0.0031852 **
X7 4396333 1 21.2202 0.0002515 ***
Residuals 3522013 17
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Aquí nuevamente no son significativas las variables X1,X3,X5, EL MODELO QUEDARIA

fit1 <- lm(Y ~ X2 + + X4+X6+X7, data=datos_rl)

summary(fit1)

Call:
lm(formula = Y ~ X2 +X4 + X6 + X7, data = datos_rl)

Residuals:
Min 1Q Median 3Q Max
-869.46 -190.69 -25.68 223.71 877.33

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 198.8280 145.1639 1.370 0.18597
X2 1.7192 0.4937 3.482 0.00235 **
X4 -16.9887 9.7742 -1.738 0.09756 .
X6 -13.1181 3.5579 -3.687 0.00146 **
X7 27.0176 4.6983 5.751 1.26e-05 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 455.9 on 20 degrees of freedom

Multiple R-squared: 0.9543, Adjusted R-squared: 0.9451
F-statistic: 104.3 on 4 and 20 DF, p-value: 4.214e-13

El Rcuadrado de este modelo es muy bueno 0,9451, lo que significa que el 94,5% de la variable Y
se explica por este modelo. Este es el modelo seleccionado.
Y = β0 + β2X2 + β4X4+ β6X6 + β7X7 + error
Y= 198,8280 + (1,7192)X1 -16,9887(X4) -13,1181(X6) +27,0176(X7)

gvlma(x = fit1)

Value p-value Decision

Global Stat 9.46411 0.050490 Assumptions acceptable.
Skewness 0.13580 0.712488 Assumptions acceptable.
Kurtosis 0.01049 0.918439 Assumptions acceptable.
Link Function 2.02830 0.154394 Assumptions acceptable.
Heteroscedasticity 7.28952 0.006936 Assumptions NOT satisfied!

Como no se cumple con el supuesto de igualdad de varianzas, podríamos optar por ajustar el
modelo aplicando logaritmo natural a las variables del modelo, en este caso a la que mas baja
correlación tenga y analizar el nuevo modelo ajustado.

fit1 <- lm(Y ~ X2 + + X4+X6+X7, data=datos_rl)

fit2 <- lm(log(Y) ~ log(X2) + log(X4)+log(X6)+log(X7), data=datos_rl)

En el modelo FIt2 solo son significativas las variables X2,X6 Y X7, eliminamos las otras y nos queda:
Y = β0 + β2X2 + β6X6 + β7X7 + error
> # Assessing Outliers
> outlierTest(fit1) # Bonferonni p-value for most extreme obs
No Studentized residuals with Bonferroni p < 0.05
Largest |rstudent|:
rstudent unadjusted p-value Bonferroni p
24 3.118255 0.0056599 0.1415

Hay un outlier en el registro número 24.

qqPlot(fit1, main="QQ Plot") #qq plot for studentized resid

[1] 20 24

Los residuos estudentizados del modelo dan cuenta de u buen ajuste, el outlier 24 no parece tener
mucho impacto en el modelo ya que su residuo esta en el rango de las bandas de dicho modelo.
Los anteriores plots no muestran ninguna tendencia y se ven claramente distribuidos al azar. El
modelo es bueno.
En este grafico si podemos observar el efecto en la distancia de cook para el dato numero 24, su
efecto es significativo ya que esta pro fuera del rango de COOK, por ello seria bueno correr el
modelo omitiendo el dato numero 24.
La distribuciónd elos residuos estudentizados tiene una distribución normal, lo cual es bueno para
el modelo.
ncvTest(fit1)
Non-constant Variance Score Test
Variance formula: ~ fitted.values
Chisquare = 3.96589, Df = 1, p = 0.046431
> # plot studentized residuals vs. fitted values
> spreadLevelPlot(fit1)

Suggested power transformation: 0.3379158

Punto 2

# Comparing Models:

# You can compare nested models with the anova( ) function. The following code provides a
simultaneous test that x3 and x4 add to linear prediction

# above and beyond x1 and x2.

# compare models

fit1 <- lm(formula = Y~.,datos_rl)

fit2 <- lm(log(datos_rl$Y) ~log(datos_rl$L)+ log(datos_rl$K),datos_rl)

> anova(fit1)
Analysis of Variance Table
Response: Y
Df Sum Sq Mean Sq F value Pr(>F)
L 1 2469637045 2469637045 1096.41 3.649e-13 ***
K 1 194569420 194569420 86.38 7.852e-07 ***
Residuals 12 27029805 2252484
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> anova(fit2)
Analysis of Variance Table

Response: log(datos_rl$Y)
Df Sum Sq Mean Sq F value Pr(>F)
log(datos_rl$L) 1 4.2996 4.2996 648.89 8.148e-12 ***
log(datos_rl$K) 1 0.1105 0.1105 16.67 0.001518 **
Residuals 12 0.0795 0.0066
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> summary(fit1)

Call:
lm(formula = Y ~ ., data = datos_rl)

Residuals:
Min 1Q Median 3Q Max
-2413.54 -1089.94 -69.66 1074.06 2698.16

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -3.243e+04 2.879e+03 -11.261 9.78e-08 ***
L 1.782e+00 5.963e+00 0.299 0.77
K 3.482e-01 3.747e-02 9.294 7.85e-07 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1501 on 12 degrees of freedom

Multiple R-squared: 0.99, Adjusted R-squared: 0.9883
F-statistic: 591.4 on 2 and 12 DF, p-value: 1.026e-12

> summary(fit2)

Call:
lm(formula = log(datos_rl$Y) ~ log(datos_rl$L) + log(datos_rl$K),
data = datos_rl)
Residuals:
Min 1Q Median 3Q Max
-0.12734 -0.05459 0.01167 0.04833 0.13674

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -8.7070 2.6728 -3.258 0.006859 **
log(datos_rl$L) 0.6612 0.1515 4.363 0.000923 ***
log(datos_rl$K) 1.2135 0.2972 4.083 0.001518 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.0814 on 12 degrees of freedom

Multiple R-squared: 0.9823, Adjusted R-squared: 0.9793
F-statistic: 332.8 on 2 and 12 DF, p-value: 3.086e-11
ANALISIS: Al comparar ambos modelos por ANOVA nos arroja que todas las variables en cada
modelo con significativas (K y L), en cuanto al R cuadrado ajustado de ambos es bueno, pero el
summary del modelo fit1, nos arroja como no significativa la variable L. (resaltado en amarillo
arriba).

Se ajusta mejor el modelo 2, ya que tanto el intercepto como las variables L y K son significativas,
su R cuadrado ajustado es de 0,9793 y los errores estandarizados son mucho menores con
respecto al modelo 1.

> summary(fit1)

Call:
lm(formula = Y ~ ., data = datos_rl)

Residuals:
Min 1Q Median 3Q Max
-2413.54 -1089.94 -69.66 1074.06 2698.16

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -3.243e+04 2.879e+03 -11.261 9.78e-08 ***
L 1.782e+00 5.963e+00 0.299 0.77
K 3.482e-01 3.747e-02 9.294 7.85e-07 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1501 on 12 degrees of freedom

Multiple R-squared: 0.99, Adjusted R-squared: 0.9883
F-statistic: 591.4 on 2 and 12 DF, p-value: 1.026e-12

> summary(fit2)

Call:
lm(formula = log(datos_rl$Y) ~ log(datos_rl$L) + log(datos_rl$K),
data = datos_rl)

Residuals:
Min 1Q Median 3Q Max
-0.12734 -0.05459 0.01167 0.04833 0.13674

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -8.7070 2.6728 -3.258 0.006859 **
log(datos_rl$L) 0.6612 0.1515 4.363 0.000923 ***
log(datos_rl$K) 1.2135 0.2972 4.083 0.001518 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.0814 on 12 degrees of freedom

Multiple R-squared: 0.9823, Adjusted R-squared: 0.9793
F-statistic: 332.8 on 2 and 12 DF, p-value: 3.086e-11

Ambos valores de R son muy alto y en teoría buenos. Solo teniendo en cuenta este dato cualquiera
de ambos modelos sería aceptable.

Punto 3.

library(readxl)

datos <- read_excel("~/wage.xlsx")

fit1 <- lm(datos$wage~.,datos)

summary(fit1)
Call:
lm(formula = datos$wage ~ ., data = datos)

Residuals:
Min 1Q Median 3Q Max
-7.6308 -1.7372 -0.5376 1.1337 14.0868

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -2.04599 0.78084 -2.620 0.00904 **
educ 0.57947 0.05217 11.108 < 2e-16 ***
exper 0.02221 0.01230 1.805 0.07160 .
female -1.76070 0.26765 -6.578 1.16e-10 ***
married 0.45748 0.29549 1.548 0.12218
numdep 0.14678 0.10893 1.348 0.17840
tenure 0.13897 0.02121 6.552 1.37e-10 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2.959 on 519 degrees of freedom
Multiple R-squared: 0.3707, Adjusted R-squared: 0.3634
F-statistic: 50.95 on 6 and 519 DF, p-value: < 2.2e-16

INTERPRETACION: El modelo de regresión línea tiene una baja linealidad o potencia de predicción
debido a su bajo R cuadrado ajustado de 0,36, solo el 36% de los datos de la variable salarios se
explican por este modelo con todas las variables. Además solo son significativas las siguientes
variables: Educación, experiencia, si es mujer y el tenure.

Primero ajustamos el modelo por método stepwize

> RLM.Vacio<-lm(formula = datos$wage~1,datos)
> RLM.Vacio

Call:
lm(formula = datos$wage ~ 1, data = datos)

Coefficients:
(Intercept)
5.909

> summary(RLM.Vacio)

Call:
lm(formula = datos$wage ~ 1, data = datos)

Residuals:
Min 1Q Median 3Q Max
-5.379 -2.609 -1.209 0.991 19.091

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.9090 0.1617 36.54 <2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.709 on 525 degrees of freedom

> #regresion con todas las variables explicativas

> RLM.Completo<-lm(formula = datos$wage~.,datos)
> RLM.Completo

Call:
lm(formula = datos$wage ~ ., data = datos)

Coefficients:
(Intercept) educ exper female married
numdep tenure
-2.04599 0.57947 0.02221 -1.76070 0.45748
0.14678 0.13897

> Summary(RLM.Completo)
Error in (function (classes, fdef, mtable) :
 unable to find an inherited method for function ‘Summary’ for signature
‘"lm"’
> #regresion stepwise
> RLM.STEPWISE<-step(RLM.Vacio,
+ scope
=list(lower=RLM.Vacio,upper=RLM.Completo),direction = "both" )
Start: AIC=1379.95
datos$wage ~ 1

Df Sum of Sq RSS AIC

+ educ 1 1194.32 6028.3 1286.9
+ tenure 1 869.84 6352.8 1314.5
+ female 1 832.29 6390.4 1317.5
+ married 1 375.13 6847.5 1353.9
+ exper 1 92.21 7130.5 1375.2
<none> 7222.7 1380.0
+ numdep 1 20.79 7201.9 1380.4

Step: AIC=1286.88
datos$wage ~ educ

Df Sum of Sq RSS AIC

+ tenure 1 991.25 5037.1 1194.4
+ female 1 676.26 5352.1 1226.3
+ exper 1 437.43 5590.9 1249.2
+ married 1 289.96 5738.4 1263.0
<none> 6028.3 1286.9
+ numdep 1 8.70 6019.6 1288.1
- educ 1 1194.32 7222.7 1380.0

Step: AIC=1194.38
datos$wage ~ educ + tenure

Df Sum of Sq RSS AIC

+ female 1 400.40 4636.7 1152.8
+ married 1 92.46 4944.6 1186.6
+ exper 1 33.21 5003.9 1192.9
<none> 5037.1 1194.4
+ numdep 1 17.78 5019.3 1194.5
- tenure 1 991.25 6028.3 1286.9
- educ 1 1315.73 6352.8 1314.5

Step: AIC=1152.82
datos$wage ~ educ + tenure + female
Df Sum of Sq RSS AIC
+ married 1 53.56 4583.1 1148.7
+ exper 1 42.78 4593.9 1149.9
+ numdep 1 19.02 4617.7 1152.7
<none> 4636.7 1152.8
- female 1 400.40 5037.1 1194.4
- tenure 1 715.39 5352.1 1226.3
- educ 1 1164.97 5801.7 1268.7

Step: AIC=1148.7
datos$wage ~ educ + tenure + female + married

Df Sum of Sq RSS AIC

+ exper 1 21.73 4561.4 1148.2
<none> 4583.1 1148.7
+ numdep 1 9.09 4574.0 1149.7
- married 1 53.56 4636.7 1152.8
- female 1 361.50 4944.6 1186.6
- tenure 1 599.81 5182.9 1211.4
- educ 1 1122.25 5705.4 1261.9
Step: AIC=1148.2
datos$wage ~ educ + tenure + female + married + exper

Df Sum of Sq RSS AIC

<none> 4561.4 1148.2
+ numdep 1 15.90 4545.5 1148.4
- exper 1 21.73 4583.1 1148.7
- married 1 32.51 4593.9 1149.9
- female 1 372.77 4934.2 1187.5
- tenure 1 379.14 4940.5 1188.2
- educ 1 1095.52 5656.9 1259.4

> summary(RLM.STEPWISE)

Call:
lm(formula = datos$wage ~ educ + tenure + female + married +
exper, data = datos)

Residuals:
Min 1Q Median 3Q Max
-7.7182 -1.8290 -0.5045 1.0919 14.0610

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -1.65682 0.72603 -2.282 0.0229 *
educ 0.55955 0.05007 11.175 < 2e-16 ***
tenure 0.13952 0.02122 6.574 1.19e-10 ***
female -1.74436 0.26759 -6.519 1.68e-10 ***
married 0.55278 0.28713 1.925 0.0547 .
exper 0.01901 0.01208 1.574 0.1161
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 2.962 on 520 degrees of freedom

Multiple R-squared: 0.3685, Adjusted R-squared: 0.3624
F-statistic: 60.68 on 5 and 520 DF, p-value: < 2.2e-16

El modelo seleccionado es este:

datos$wage ~ educ + tenure + female + married

Salario= -1.65682+0.55955(educ)+ 0.13952(tenure) -1.74436(female)+

0.55278(married)

El salario promedio para una persona casada seria=

Salario casada= -1.65682+0.55955 + 0.13952 -1.74436+ 0.55278*1

= -2,14

Salario soltero=-1.65682+0.55955+ 0.13952-1.74436 = -0,49251

> modelo_interaccion<- lm(datos$wage~datos$female+datos$married,datos)
> summary(modelo_interaccion)

Call:
lm(formula = datos$wage ~ datos$female + datos$married, data = datos)

Residuals:
Min 1Q Median 3Q Max
-5.3356 -2.1354 -0.8966 1.1040 18.1040

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 6.1966 0.2978 20.811 < 2e-16 ***
datos$female -2.3006 0.3041 -7.567 1.74e-13 ***
datos$married 1.3389 0.3112 4.303 2.01e-05 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.435 on 523 degrees of freedom

Multiple R-squared: 0.1455, Adjusted R-squared: 0.1422
F-statistic: 44.52 on 2 and 523 DF, p-value: < 2.2e-16

correlation_accuracy <- cor(datos)

> correlation_accuracy
wage educ exper female married
numdep tenure
wage 1.00000000 0.40664192 0.11299037 -0.33945912 0.22789761 -
0.05365206 0.34703356
educ 0.40664192 1.00000000 -0.29954184 -0.08502941 0.06888104 -
0.21529136 -0.05617257
exper 0.11299037 -0.29954184 1.00000000 -0.04162597 0.31698428 -
0.05631938 0.49929145
female -0.33945912 -0.08502941 -0.04162597 1.00000000 -0.16612843
0.03314798 -0.19791027
married 0.22789761 0.06888104 0.31698428 -0.16612843 1.00000000
0.15449651 0.23988874
numdep -0.05365206 -0.21529136 -0.05631938 0.03314798 0.15449651
1.00000000 -0.02703734
tenure 0.34703356 -0.05617257 0.49929145 -0.19791027 0.23988874 -
0.02703734 1.00000000

anova(modelo_interaccion)
Analysis of Variance Table

Response: datos$wage
Df Sum Sq Mean Sq F value Pr(>F)
datos$female 1 832.3 832.29 70.527 4.292e-16 ***
datos$married 1 218.5 218.47 18.513 2.014e-05 ***
Residuals 523 6171.9 11.80
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Análisis: Según la matriz de correlaciones hay una pobre correlación entre la variable female y
married. Y con base al ANOVA del modelo la variable Female es mucho mas significativa que la la
variable married, esta ultima solo es significativa al 5%. A pesar de que en el modelo ambas
variables aparecen como significativas, su interacción solo aporta el 14,22% de la explicación de
los salarios. Mientras que separadas aportan 11,35 y 5,01% respectivamente.
Como se vio anteriormente con el método stepwize El modelo seleccionado es este:

datos$wage ~ educ + tenure + female + married

Salario= -1.65682+0.55955(educ)+ 0.13952(tenure) -1.74436(female)+ 0.55278(married)

Los modelos por separado son los siguientes

> #modelos por separado
>
> fit2 <- lm(datos$wage~datos$educ,datos)
> summary(fit2)

Call:
lm(formula = datos$wage ~ datos$educ, data = datos)

Residuals:
Min 1Q Median 3Q Max
-5.3707 -2.1578 -0.9854 1.1864 16.3975

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.93389 0.68769 -1.358 0.175
datos$educ 0.54470 0.05346 10.189 <2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.392 on 524 degrees of freedom

Multiple R-squared: 0.1654, Adjusted R-squared: 0.1638
F-statistic: 103.8 on 1 and 524 DF, p-value: < 2.2e-16

>
> fit3 <- lm(datos$wage~datos$exper,datos)
> summary(fit3)

Call:
lm(formula = datos$wage ~ datos$exper, data = datos)

Residuals:
Min 1Q Median 3Q Max
-4.946 -2.474 -1.119 1.064 18.721

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.38352 0.25810 20.858 <2e-16 ***
datos$exper 0.03088 0.01186 2.603 0.0095 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 3.689 on 524 degrees of freedom
Multiple R-squared: 0.01277, Adjusted R-squared: 0.01088
F-statistic: 6.776 on 1 and 524 DF, p-value: 0.009499

>
> fit4 <- lm(datos$wage~datos$female,datos)
> summary(fit4)

Call:
lm(formula = datos$wage ~ datos$female, data = datos)

Residuals:
Min 1Q Median 3Q Max
-5.6153 -1.8153 -0.9973 1.4027 17.8847

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 7.1153 0.2110 33.727 < 2e-16 ***
datos$female -2.5180 0.3048 -8.261 1.19e-15 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.492 on 524 degrees of freedom

Multiple R-squared: 0.1152, Adjusted R-squared: 0.1135
F-statistic: 68.25 on 1 and 524 DF, p-value: 1.187e-15

>
> fit5 <- lm(datos$wage~datos$married,datos)
> summary(fit5)

Call:
lm(formula = datos$wage ~ datos$married, data = datos)

Residuals:
Min 1Q Median 3Q Max
-5.187 -2.187 -1.056 1.413 18.413

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.8565 0.2519 19.282 < 2e-16 ***
datos$married 1.7301 0.3229 5.358 1.26e-07 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 3.615 on 524 degrees of freedom
Multiple R-squared: 0.05194, Adjusted R-squared: 0.05013
F-statistic: 28.71 on 1 and 524 DF, p-value: 1.264e-07

>
> fit6 <- lm(datos$wage~datos$numdep,datos)
> summary(fit6)

Call:
lm(formula = datos$wage ~ datos$numdep, data = datos)

Residuals:
Min 1Q Median 3Q Max
-5.544 -2.574 -1.266 1.042 18.926

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 6.0736 0.2099 28.94 <2e-16 ***
datos$numdep -0.1577 0.1282 -1.23 0.219
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 3.707 on 524 degrees of freedom
Multiple R-squared: 0.002879, Adjusted R-squared: 0.0009756
F-statistic: 1.513 on 1 and 524 DF, p-value: 0.2193

>
> fit7 <- lm(datos$wage~datos$tenure,datos)
> summary(fit7)

Call:
lm(formula = datos$wage ~ datos$tenure, data = datos)

Residuals:
Min 1Q Median 3Q Max
-8.8446 -2.0712 -0.9421 1.2042 16.7533

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.99951 0.18595 26.89 < 2e-16 ***
datos$tenure 0.17817 0.02103 8.47 2.48e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.482 on 524 degrees of freedom

Multiple R-squared: 0.1204, Adjusted R-squared: 0.1188
F-statistic: 71.75 on 1 and 524 DF, p-value: 2.48e-16

Análisis:

 La variable educación por si solo solo explica el 16,38% de los resultados de salario.
 La variable experiencia por si sola, solo explica el 1,08% de los resultados de salario.
Claramente no es significativa.
 La variable female por si sola solo explica el 11,35% de los resultados de salario.
 La variable married por si solo solo explica el 5,01% de los resultados de salario.
 La variable numdep por si solo solo explica menos del 1% de los resultados de salario.
Claramente no es significativa.
 La variable tenure por si sola solo explica el 11,88% de los resultados de salario.

Usaremos el ejemplo, pero usando A para la persona blanca, B=persona negra y C= en caso
contrario.

Si se puede usar la raza como regresor, solo debe analizarse como variable categorica. Usamos los
siguientes datos ficticios para mostrar el efecto en los salarios
datos <- data.frame(Salario = c(800, 950, 1050, 350, 750, 600, 1075, 250, 700,

650, 975, 350, 950, 425, 725),

horas_trabajo = c(885, 1016, 1125, 239, 701, 641, 1228, 412, 953,

929, 1492, 419, 1010, 595, 1034),

Sexo = c("Blanco", "Blanco", "Blanco", "Blanco", "Blanco",

"Blanco", "Blanco", "Negro", "Negro",

"Negro", "Negro", "Negro", "Negro",

"Negro", "Negro"))

head(datos, 4)

datos$Sexo <- as.factor(datos$Sexo)

pairs(x = datos)
> cor.test(datos$Salario, datos$horas_trabajo, method = "pearson")

Pearson's product-moment correlation

data: datos$Salario and datos$horas_trabajo

t = 7.271, df = 13, p-value = 6.262e-06
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
0.7090393 0.9651979
sample estimates:
cor
0.8958988
library(ggplot2)

ggplot(data = datos, mapping=aes(x = Sexo, y = Salario, color=Sexo)) +

geom_boxplot() +

geom_jitter(width = 0.1) +

theme_bw() + theme(legend.position = "none")

El análisis gráfico y de correlación muestran una relación lineal significativa entre la variable salario
y horas de trabajo. La variable raza parece influir de forma significativa en el salario. Ambas
variables pueden ser buenos predictores en un modelo lineal múltiple para la variable
dependiente salario.

#Generar el modelo lineal múltiple

modelo <- lm(Salario ~ horas_trabajo + Sexo, data = datos)

summary(modelo)

Call:
lm(formula = Salario ~ horas_trabajo + Sexo, data = datos)

Residuals:
Min 1Q Median 3Q Max
-110.10 -32.32 -16.10 28.93 210.95

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 197.96284 59.19274 3.344 0.005841 **
horas_trabajo 0.71795 0.06153 11.669 6.6e-08 ***
SexoNegro -184.04727 40.49420 -4.545 0.000672 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 78.2 on 12 degrees of freedom

Multiple R-squared: 0.9275, Adjusted R-squared: 0.9154
F-statistic: 76.73 on 2 and 12 DF, p-value: 1.455e-07

confint(modelo)

## 2.5 % 97.5 %

## (Intercept) -115.6237330 143.4548774

## volumen 0.5839023 0.8520052

## tipo_tapasduras 95.8179902 272.2765525

Cuando un predictor es cualitativo, uno de sus niveles se considera de referencia (el que no
aparece en la tabla de resultados) y se le asigna el valor de 0. El valor de la pendiente de cada nivel
de un predictor cualitativo se define como el promedio de unidades que dicho nivel está por
encima o debajo del nivel de referencia. Para el predictor Raza, el nivel de referencia es negro por
lo que si el salario tiene este tipo de raza se le da a la variable el valor 0 y si es raza blanca el valor
1. Acorde al modelo generado, los salarios de los blancos son en promedio 184.04727 unidades de
salario superiores a los de raza negra

Peso libro=13.91557+0.71795 horas de trabajo +184.04727 Raza