Regresion Lineal COn R Comander

REGRESIÓN LINEAL MÚLTIPLE.

En esta oportunidad, continuaremos relacionando el costo de los días de incapacidad pero ya no en función de una variable sino en función de varias, las cuales son el número de días de incapacidad, la edad, el sueldo, la antigüedad, el tiempo oficial del trabajador de la institución universitaria, esto de acuerdo a la información proporcionada en la base de datos Salud_Ocupacional y los resultado arrojados por el programa estadístico R.

Ajuste del modelo (Anova):

Esperamos obtener un modelo de la forma:

Y=  + 1*X1 + 2X2+ …+iXi + 

Procediendo en el R obtenemos los siguientes resultados:

> RegModel.1 <-lm(COSTOS~Antiguedad1+Edad1+NRO_DIAS+Sueldo+SUELDO.FP+TIEM_OFIC,

+ data=Prueba)

> summary(RegModel.1)

Call:

lm(formula = COSTOS ~ Antiguedad1 + Edad1 + NRO_DIAS + Sueldo +

SUELDO.FP + TIEM_OFIC, data = Prueba)

Residuals:

Min 1Q Median 3Q Max

-2850761 -95098 55208 96466 3838074

Coefficients: (1 not defined because of singularities)

Estimate Std. Error t value Pr(>|t|)

(Intercept) -3.170e+05 8.850e+04 -3.582 0.000363 ***

Antiguedad1 1.368e+03 2.362e+03 0.579 0.562647

Edad1 1.001e+03 2.518e+03 0.398 0.691101

NRO_DIAS 6.051e+04 1.391e+03 43.495 < 2e-16 ***

Sueldo 5.251e-01 5.391e-01 0.974 0.330304

SUELDO.FP -1.945e-01 3.404e-01 -0.571 0.567881

TIEM_OFIC NA NA NA NA

---

Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 331000 on 755 degrees of freedom

(1 observation deleted due to missingness)

Multiple R-squared: 0.7653, Adjusted R-squared: 0.7637

F-statistic: 492.3 on 5 and 755 DF, p-value: < 2.2e-16

Del anterior anova observamos que la variable independiente TIEM_OFIC no está participando en el modelo pero si puede estar alterando los resultados de predicción del modelo, al igual que el intercepto que para algunos casos no tiene sentido. Lo mejor es proceder a eliminarlos:

> RegModel.1 <-lm(COSTOS~Antiguedad1+Edad1+NRO_DIAS+Sueldo+SUELDO.FP-1,data=Prueba)

> summary(RegModel.1)

Call:

lm(formula = COSTOS ~ Antiguedad1 + Edad1 + NRO_DIAS + Sueldo +

SUELDO.FP - 1, data = Prueba)

Residuals:

Min 1Q Median 3Q Max

-2842044 -92626 44312 87534 3858071

Coefficients:

Estimate Std. Error t value Pr(>|t|)

Antiguedad1 6801.7336 1823.8750 3.729 0.000206 ***

Edad1 -7086.0228 1122.8787 -6.311 4.73e-10 ***

NRO_DIAS 59836.0705 1389.1193 43.075 < 2e-16 ***

Sueldo 1.3284 0.4940 2.689 0.007328 **

SUELDO.FP -0.6967 0.3127 -2.228 0.026146 *

---

Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 333600 on 756 degrees of freedom

(1 observation deleted due to missingness)

Multiple R-squared: 0.7968, Adjusted R-squared: 0.7955

F-statistic: 593 on 5 and 756 DF, p-value: < 2.2e-16

Al eliminar el intercepto y la otra variable se observa cómo mejora considerablemente el porcentaje de predicción para el modelo pasando de un R cuadrado ajustado de 0.7637 a 0. 7955, y también cómo algunas variables que antes parecían poco significativas para el modelo cambian su valor P haciéndose más significativas. Es tentativo eliminar otras variables como el SUELDO.FP o la Antiguedad1 por ser las variables con el nivel de significancia mas bajo de las 5 variables que se tienen; pero esta operación en lugar de mejorar el modelo sólo ocasiona que la precisión del modela decrezca un poco. Por ejemplo:

Call:

lm(formula = COSTOS ~ Edad1 + NRO_DIAS + Sueldo + SUELDO.FP -

1, data = Prueba)

Residuals:

Min 1Q Median 3Q Max

-2829430 -106926 44311 86906 3841870

Coefficients:

Estimate Std. Error t value Pr(>|t|)

Edad1 -4754.1360 940.5841 -5.054 5.42e-07 ***

NRO_DIAS 59411.1499 1396.1915 42.552 < 2e-16 ***

Sueldo 1.2857 0.4981 2.581 0.0100 *

SUELDO.FP -0.6676 0.3152 -2.118 0.0345 *

---

Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 336400 on 757 degrees of freedom

(1 observation deleted due to missingness)

Multiple R-squared: 0.7931, Adjusted R-squared: 0.792

F-statistic: 725.5 on 4 and 757 DF, p-value: < 2.2e-16

Matriz de correlaciones.

De la anterior matriz de correlaciones se observa que los pares de variables independientes Sueldo-SUELDO.FP y Antiguedad1-Edad1 están fuertemente correlacionadas con coeficientes de Pearson de 0.999 y 0.795 respectivamente; por lo cual se deben eliminar dos de estas variables del modelo, eliminaremos las variablesAntiguedad1 y SUELDO.FP y así se reduce lo más mínimo el valor del coeficiente de determinación R cuadrado y aumenta la significancia de las variables dependientes del modelo, y obtenemos:

> RegModel.2 <- lm(COSTOS~Edad1+NRO_DIAS+Sueldo-1,data=Prueba)

> summary(RegModel.2)

Call:

lm(formula = COSTOS ~ Edad1 + NRO_DIAS + Sueldo - 1, data = Prueba)

Residuals:

Min 1Q Median 3Q Max

-2827740 -99063 39129 84146 3847012

Coefficients:

Estimate Std. Error t value Pr(>|t|)

Edad1 -6.454e+03 4.914e+02 -13.13 <2e-16 ***

NRO_DIAS 5.930e+04 1.398e+03 42.41 <2e-16 ***

Sueldo 2.310e-01 1.293e-02 17.86 <2e-16 ***

---

Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 337200 on 758 degrees of freedom

(1 observation deleted due to missingness)

Multiple R-squared: 0.7919, Adjusted R-squared: 0.7911

F-statistic: 961.4 on 3 and 758 DF, p-value: < 2.2e-16

Al generar de nuevo la matriz de correlaciones para las variables que dejamos en el modelo, observamos que ya no hay correlaciones fuertes entre las variables independientes:

Matriz de diagramas de dispersión:

> scatterplot.matrix(~COSTOS+Edad1+NRO_DIAS+Sueldo | Riesgo, reg.line=lm,

+ smooth=TRUE, span=0.5, diagonal= 'density', by.groups=TRUE, data=Prueba)

En el anterior gráfico de dispersión, se observan que el tipo de incapacidad más común es por enfermedad general y que los valores extremos son producidos principalmente por incapacidades de maternidad, así que miraremos primero las gráficas básicas de diagnóstico para ver que valores extremos podemos eliminar para mejorar el modelo:

oldpar <- par(oma=c(0,0,3,0), mfrow=c(2,2))

plot(RegModel.2)

par(oldpar)

Al eliminar los valores extremos señalados en las anteriores gráficas y realizar de nuevo el anova para nuestro MRLM obtenemos los siguientes resultados:

> RegModel.4 <- lm(COSTOS~Edad1+NRO_DIAS+Sueldo-1, data=FiltroDatos)

> summary(RegModel.4)

Call:

lm(formula = COSTOS ~ Edad1 + NRO_DIAS + Sueldo - 1, data = FiltroDatos)

Residuals:

Min 1Q Median 3Q Max

-1022513 -85691 28709 68045 2330710

Coefficients:

Estimate Std. Error t value Pr(>|t|)

Edad1 -5.601e+03 4.095e+02 -13.68 <2e-16 ***

NRO_DIAS 5.660e+04 1.304e+03 43.42 <2e-16 ***

Sueldo 2.083e-01 1.072e-02 19.44 <2e-16 ***

---

Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 276700 on 755 degrees of freedom

(1 observation deleted due to missingness)

Multiple R-squared: 0.808, Adjusted R-squared: 0.8072

F-statistic: 1059 on 3 and 755 DF, p-value: < 2.2e-16

Con la eliminación de los datos extremos observados que las variables independientes siguen siendo muy significativas (valor P<<<<0.05), se logra mejorar el valor del coeficiente de determinación R cuadrado, el cual, al hacer una prueba de bondad al modelo arroja un porcentaje de predicción muy bueno, la prueba de bondad para este modelo es del 80.72%; esto es, se espera que aproximadamente el 81% de todas las predicciones generadas con este modelo sean acertadas.

Prueba de hipótesis de significación:

Ho: La variable respuesta (Costos) no está influenciada por las variables independientes (edad, número de días y el sueldo).

H1: La variable respuesta si está influenciada por las variables independientes.

Como el

...