1

Los ahorros y los ingresos Y mensuales en cientos de euros de una muestra de 10 familias de una determinada región se presentan en la siguiente tabla.

ahorros<-c(1.9,1.8,2.0,2.1,1.9,2.0,2.2,2.3,2.7,3.0)
Ingresos<-c(20.5,20.8,21.2,21.7,22.1,22.3,22.2,22.6,23.1,23.5)
Resultado <- data.frame(ahorros,Ingresos)

en el grafico de QQ se observa que las observaciones caen cerca de la diagonal por lo que habria sospecha de Normalidad en los residuos.

1

Ajustar los datos anteriores a un modelo lineal que explique lo ahorros familiares en función de los ingresos de la región dada.Modelo lienal. \[Y=-5.26+0.33_{x}\].

g <- lm(ahorros ~ Ingresos,data=Resultado)
summary(g)             # Importante en el curso de RL
## 
## Call:
## lm(formula = ahorros ~ Ingresos, data = Resultado)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.32389 -0.08445  0.01418  0.12319  0.30165 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept) -5.26585    1.62809  -3.234  0.01198 * 
## Ingresos     0.33890    0.07394   4.583  0.00179 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.214 on 8 degrees of freedom
## Multiple R-squared:  0.7242, Adjusted R-squared:  0.6897 
## F-statistic: 21.01 on 1 and 8 DF,  p-value: 0.001794
plot(g)

# Pruebas estadisticas para determinar si se cumple el supuesto de normalidad
# H0: Los errores tienen DN vs H1: Los errores NO tienen DN
# Se rechaza H0 si p < .05
library(tseries)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

shapiro.test (g$res)
## 
##  Shapiro-Wilk normality test
## 
## data:  g$res
## W = 0.96052, p-value = 0.7918
# H0: La varianza de los residuos es constante
# Se rechaza H0 si p < .05

car::ncvTest(g )                                 #  car   
## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 0.66049, Df = 1, p = 0.41639
lmtest::bptest(g)     # Breusch-Pagan test
## 
##  studentized Breusch-Pagan test
## 
## data:  g
## BP = 1.1199, df = 1, p-value = 0.2899

RESULTADO En este caso, alrededor del \[72.42\%\] de la variabilidad en los ahorros familiares se explica por la relación lineal con los ingresos.

El valor p asociado con el test BP es 0.41, lo que sugiere que no hay suficiente evidencia para rechazar la hipótesis nula de homogeneidad de varianza de los residuos.

El test de normalidad de Shapiro Wilk arroja un valor p de 0.79, lo que indica que no hay suficiente evidencia para rechazar la hipótesis nula de normalidad. Se puede decir que los residuos se distribuyen aproximadamente de manera normal.

2

Ajustar los datos anteriores a un modelo lineal parabólico que explique los ahorros familiares en función de los ingresos para la región dada. \[Y=-5.26+0.33_{x}\] donde \(x=Ingresos\) Si el Ingrenso incrementa (disminuye) una unidad, entonces el ahorra incrementa (disminuye) en promedio 0.33.

# Crear una nueva variable con términos cuadráticos
Resultado$Ingresos_cuadrados <- Resultado$Ingresos^2
# Ajustar un modelo lineal con términos cuadráticos
modelo_cuadratico <- lm(ahorros ~ Ingresos + Ingresos_cuadrados, data = Resultado)
# Mostrar resumen del modelo
summary(modelo_cuadratico)
## 
## Call:
## lm(formula = ahorros ~ Ingresos + Ingresos_cuadrados, data = Resultado)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.169187 -0.065071 -0.000143  0.079809  0.157439 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)   
## (Intercept)        85.56813   22.82759   3.748  0.00718 **
## Ingresos           -7.94851    2.08132  -3.819  0.00655 **
## Ingresos_cuadrados  0.18870    0.04738   3.983  0.00531 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1266 on 7 degrees of freedom
## Multiple R-squared:  0.9156, Adjusted R-squared:  0.8914 
## F-statistic: 37.95 on 2 and 7 DF,  p-value: 0.000175

El modelo ajustado es: \[ahorros = 85.57−7.94(ingresos) + 0.18(ingresoscuadrados)\] Los valores de p valor para los coeficientes son bajos (0.00718 para el intercepto,0.00655 para ingresos y 0.00531 para ingresos cuadrados), lo que sugiere que estos coeficientes son significativamente diferentes de cero. El coeficiente de determinación el \(R^2\) es 0.9156, lo que indica que el modelo explica alrededor del \[91.56\%\] de la variabilidad en los datos.

3

Qué ahorro se puede prever para una familia de la región que ingrese 2500 euros mensuales? 819.74 mensuales.

Nuevo_ingreso <- data.frame(Ingresos = c(2500))
names(Nuevo_ingreso) <- "Ingresos"
prediccion <- predict(g, Nuevo_ingreso)
prediccion
##        1 
## 841.9895
Y<--5.26+0.33*2500
Y
## [1] 819.74

2

Se realizó un estudio a 12 estudiantes para ver cómo influyen las calificaciones del examen y el número de clases que los estudiantes pierden en a calificación de la materia de estadística. Los datos completos se registran a continuación.

Estudiante<-c(1,2,3,4,5,6,7,8,9,10,11,12)
Calificación_Estadistica<-c(85,74,76,90,85,87,94,98,81,91,76,74)
calificacion_del_examen<-c(65,50,55,65,55,70,65,70,55,70,50,55)
clases_perdidas<-c(1,7,5,2,6,3,2,5,4,3,1,4)

Resultado1<-data.frame(Estudiante,Calificación_Estadistica,calificacion_del_examen,clases_perdidas)

Determine el modelo del problema.

Modelo \[ Y=27.4+0.92(Calificación del Examen)+0.28(Clases Perdidas)\] Si la calificación del examen es cero, entonces la calificación estadistica 27.4 Si la calificación estadistica incrementa (disminuye) una unidad, entonces la calificación estadistica incrementa (disminuye) en promedio 0.92.

Si las clases perdidas incrementa (disminuye) una unidad, entonces la calificación estadistica incrementa (disminuye) en promedio 0.28.

h <- lm(Calificación_Estadistica ~ calificacion_del_examen + clases_perdidas,data=Resultado1)
summary(h)  
## 
## Call:
## lm(formula = Calificación_Estadistica ~ calificacion_del_examen + 
##     clases_perdidas, data = Resultado1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.9169 -2.9701  0.0018  2.6925  5.9757 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              27.5467    12.4981   2.204 0.054975 .  
## calificacion_del_examen   0.9217     0.1858   4.960 0.000781 ***
## clases_perdidas           0.2842     0.7536   0.377 0.714772    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.517 on 9 degrees of freedom
## Multiple R-squared:  0.7478, Adjusted R-squared:  0.6918 
## F-statistic: 13.34 on 2 and 9 DF,  p-value: 0.002031
step(h)
## Start:  AIC=38.74
## Calificación_Estadistica ~ calificacion_del_examen + clases_perdidas
## 
##                           Df Sum of Sq    RSS    AIC
## - clases_perdidas          1       2.9 186.56 36.926
## <none>                                 183.65 38.738
## - calificacion_del_examen  1     502.0 685.65 52.546
## 
## Step:  AIC=36.93
## Calificación_Estadistica ~ calificacion_del_examen
## 
##                           Df Sum of Sq    RSS    AIC
## <none>                                 186.56 36.926
## - calificacion_del_examen  1    541.69 728.25 51.269
## 
## Call:
## lm(formula = Calificación_Estadistica ~ calificacion_del_examen, 
##     data = Resultado1)
## 
## Coefficients:
##             (Intercept)  calificacion_del_examen  
##                 30.0433                   0.8972

El proceso de selección de variables sugiere que el modelo más simple, que incluye solo la variable calificacion examen, es preferible en términos de criterio AIC. En este caso, no se encontró evidencia convincente para incluir la variable clases perdidas en el modelo.

Breusch Pagan Test: En este caso, el p valor es 0.50, lo que indica que no hay evidencia significativa de homogeneidad de varianza. Shapiro Wilk En este caso, el p valor es 0.46, lo que sugiere que hay normalidad de los residuos.

shapiro.test (h$res)
## 
##  Shapiro-Wilk normality test
## 
## data:  h$res
## W = 0.93754, p-value = 0.4668
# H0: La varianza de los residuos es constante
# Se rechaza H0 si p < .05

car::ncvTest(h)                                 #  car   
## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 0.3679353, Df = 1, p = 0.54413
lmtest::bptest(h)  
## 
##  studentized Breusch-Pagan test
## 
## data:  h
## BP = 1.3534, df = 2, p-value = 0.5083

2

Determine la calificación de estadística para un estudiante que tiene una calificación en el examen de 60 y pierde 4 clases.

La calificación estimada de estadística para un estudiante que tiene una calificación en el examen de 60 y pierde 4 clases, según el modelo ajustado, sería aproximadamente 83.18.

# Datos para la predicción
nueva_data <- data.frame(calificacion_del_examen = 60, clases_perdidas = 4)
# Hacer la predicción usando el modelo ajustado
prediccion <- predict(h, nueva_data)
# Imprimir la predicción
print(prediccion)
##       1 
## 83.9844

3

Supongamos que se desea pesar tres objetos cuyos pesos exactos son \(\beta_x,\beta_2\) y \(\beta_3\). Se dispone de una balanza de platillos con un error de pesada que podemos considerar con distribución \(N(0,\sigma)\). Un artificio para mejorar la precisión y ahorrar pesadas consiste en repartir los objetos en uno o en los dos platillos y anotar las sumas o diferencias de pesos:\(x_1\beta_1 +x_2\beta_2 +x_3\beta_3=y\), donde y es el peso observado y$ x_i = 0, 1, -1$.

Consideremos las siguientes pesadas: \(\beta_1-\beta_2+\beta_3 = 5.0\) \(\beta_1+\beta_2+\beta_3 = 1.72\) \(\beta_1+\beta_2-beta_3 = 0.64\) \(\beta_1-\beta_2+\beta_3 = 5.0\) \(\beta_1+\beta_2+\beta_3 = 1.70\)

# Datos Matriz de coeficientes
X <- matrix(c(1, -1, 1,
1, 1, 1,
1, 1, -1,
1, -1, 1,
1, 1, 1), ncol = 3, byrow = TRUE)

# Vector de resultados
y <- c(5.0, 1.72, 0.64, 5.0, 1.70)
# Realizar regresión lineal
model <- lm(y ~ X - 1) # El "-1" elimina el intercepto
# Mostrar resultados
summary(model)
## 
## Call:
## lm(formula = y ~ X - 1)
## 
## Residuals:
##          1          2          3          4          5 
##  3.157e-16  1.000e-02  4.182e-19 -3.153e-16 -1.000e-02 
## 
## Coefficients:
##     Estimate Std. Error t value Pr(>|t|)    
## X1  2.820000   0.006124  460.50 4.72e-06 ***
## X2 -1.645000   0.005000 -329.00 9.24e-06 ***
## X3  0.535000   0.006124   87.36 0.000131 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.01 on 2 degrees of freedom
## Multiple R-squared:      1,  Adjusted R-squared:      1 
## F-statistic: 1.875e+05 on 3 and 2 DF,  p-value: 5.333e-06

Por lo tanto \[\beta_{1}=2.82\],\[\beta_{2}=-1.64\],\[\beta_{3}=0.53\]