Inserción del Conjunto de Datos

library(readr)
seguro <- read_delim("seguro.csv", delim = ";")
seguro

## # A tibble: 200 × 7
##      age sex      bmi children smoker region    charges
##    <dbl> <chr>  <dbl>    <dbl> <chr>  <chr>       <dbl>
##  1    19 female  27.9        0 yes    southwest    7.59
##  2    18 male    33.8        1 no     southeast   20.9 
##  3    28 male    33          3 no     southeast   18.5 
##  4    33 male    22.7        0 no     northwest    3.33
##  5    32 male    28.9        0 no     northwest   12.6 
##  6    31 female  25.7        0 no     southeast    9.76
##  7    46 female  33.4        1 no     southeast    9.26
##  8    37 female  27.7        3 no     northwest   20.0 
##  9    37 male    29.8        2 no     northeast   19.5 
## 10    60 female  25.8        0 no     northwest   19.7 
## # … with 190 more rows

1. Ejecute las siguientes tareas de preprocesamiento de datos:

library(dplyr)
library(tidyverse)
seguro <- seguro %>% select(-region)

seguro <- seguro %>% rename("edad"="age","sexo"="sex","imc"="bmi","nhijos"="children",
                              "fuma"="smoker","gastos"="charges")

seguro1 <- seguro %>% mutate(sexo=if_else(sexo=="female", "femenino", "masculino"))
seguro1 <- seguro1 %>% mutate(fuma=if_else(fuma=="yes", "si", "no"))
seguro1

## # A tibble: 200 × 6
##     edad sexo        imc nhijos fuma  gastos
##    <dbl> <chr>     <dbl>  <dbl> <chr>  <dbl>
##  1    19 femenino   27.9      0 si      7.59
##  2    18 masculino  33.8      1 no     20.9 
##  3    28 masculino  33        3 no     18.5 
##  4    33 masculino  22.7      0 no      3.33
##  5    32 masculino  28.9      0 no     12.6 
##  6    31 femenino   25.7      0 no      9.76
##  7    46 femenino   33.4      1 no      9.26
##  8    37 femenino   27.7      3 no     20.0 
##  9    37 masculino  29.8      2 no     19.5 
## 10    60 femenino   25.8      0 no     19.7 
## # … with 190 more rows

2. Obtenga la matriz de correlaciones de las variables cuantitativas y presente un gráfico que permita visualizarla.

# Seleccionamos las variables predictoras cuanti
corr1 <- seguro1 %>% select(c("edad","imc","nhijos","gastos"))
corr1 %>% cor

##              edad        imc     nhijos     gastos
## edad   1.00000000 0.10037859 0.03553105 0.55979388
## imc    0.10037859 1.00000000 0.04210715 0.25051181
## nhijos 0.03553105 0.04210715 1.00000000 0.07908431
## gastos 0.55979388 0.25051181 0.07908431 1.00000000

# Gráfico
library(ggcorrplot)
graf1 <- corr1 %>% cor() %>%  ggcorrplot()
graf1

3. Construya un intervalo del 97.5% de confianza para la correlación entre la edad y el imc.

library(confintr)
attach(seguro1)
# El nivel de significacia del 2.5% se reparte a los extremos
ci_cor(edad,imc,method = "pearson", type = "normal", probs = c(0.0125,0.9875))

## 
##  Two-sided 97.5% normal confidence interval for the true Pearson
##  correlation coefficient
## 
## Sample estimate: 0.1003786 
## Confidence interval:
##       1.25%      98.75% 
## -0.05890727  0.25468002

4. Pruebe si la correlación entre el imc y el número de hijos es significativamente distinta de cero. En caso lo sea, interprete su valor.

cor(imc,nhijos)

## [1] 0.04210715

Correlación próxima a cero.

5. Se desea estudiar la influencia lineal de la edad sobre los gastos. Presente el modelo de regresión lineal simple estimado.

\[Y_i = \beta_0+\beta_1X_i+\epsilon_i \qquad i=1,...,n\]

• \(Y_i\) : i-ésima registro del pago mensual.

• \(X_i\) : i-ésimo registro de edad.

• \(β_0\) y \(β_1\): Coeficientes de regresión.

• \(ϵ_i\): Error.

modelo1 <- lm(gastos~edad)
modelo1

## 
## Call:
## lm(formula = gastos ~ edad)
## 
## Coefficients:
## (Intercept)         edad  
##      3.1881       0.2811

library(broom)
modelo1 %>% tidy()

## # A tibble: 2 × 5
##   term        estimate std.error statistic  p.value
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)    3.19     1.21        2.64 8.86e- 3
## 2 edad           0.281    0.0296      9.51 6.85e-18

• \(β_0\) = 3.1881
• \(β_1\) = 0.2811

# Gráfica de regresión lineal simple
graf2 <- plot(edad, gastos, col = "green", 
      xlab = "Edad", ylab = "Gastos")

6. Verifique si se cumple la siguiente igualdad:

\[{\hat{B_1} = \frac{S_y}{S_x}R}\]

Donde \(S_y\) y \(S_x\) son las desviaciones estándar de la variable respuesta y predictora, respectivamente, y \(R\) es el coeficiente de correlación entre estas variables.

Valores de \(S^2_x\) y \(S^2_y\)

a <- edad
b <- gastos
n <- length(a)

ma <- mean(a)
mb <- mean(b)
n <- length(a)

S2x <- (sum((a-ma)^2))/n
S2y <- (sum((b-mb)^2))/n

Sx <- sqrt(S2x)
Sy <- sqrt(S2y)
Sx

## [1] 14.45361

Sy

## [1] 7.258318

Valor de \(\hat{\beta}_1\):

\[\hat{\beta}_1=\frac{S_{xy}}{S^2_{x}}\qquad S^2_x=\frac{\sum_{i=1}^{n}{(x_i-\overline{x})^2}}{n} \qquad S_{xy}=\frac{\sum_{i=1}^{n}{(x_i-\overline{x})(y_i-\overline{y})}}{n}\]

Sxy <- (sum((a-ma)*(b-mb)))/n
b1 <- Sxy/S2x
b1.2 <- Sy/Sx*cor(a,b)
b1

## [1] 0.2811175

b1.2

## [1] 0.2811175

Concluimos que los valores son los mismos

7. Utilizando las fórmulas de error estándar, construya un intervalo del 92% de confianza para el intercepto y uno de 98% para la pendiente.

Procedemos a hallar el valor de \(\hat{\beta}_0\), \(S_{\hat{\beta}_0}\) y \(S_{\hat{\beta}_1}\).

\[s_{\hat{\beta}_0}=\sqrt{\sigma^{2}\left [ \frac{1}{n}+\frac{\bar{x}^{2}}{\sum_{i=1}^{n}(x_{i}-\bar{x})^{2}} \right ]}\]

b0 <- mean(b)-b1*mean(a)
summary(modelo1)$sigma -> sigma
sb0 <- sqrt(sigma**2*(1/n+mean(a)**2/sum((a-mean(a))^2)))
sb0

## [1] 1.206033

\[s_{\hat{\beta}_1}=\sqrt{\left [\frac{\sigma ^{2}}{\sum_{i=1}^{n}(x_{i}-\bar{x})^{2}} \right ]}\]

sb1 <- sqrt(sigma**2/sum((a-mean(a))^2))
sb1

## [1] 0.02957255

Intervalo de confianza de 92% del intercepto.

ICI0 <- b0-qt(1-0.08/2,n-2)*sb0
ICS0 <- b0+qt(1-0.08/2,n-2)*sb0
ICI0

## [1] 1.065807

ICS0

## [1] 5.310361

Intervalo de confianza de 98% de la pendiente.

ICI1 <- b1-qt(1-0.02/2,n-2)*sb1
ICS1 <- b1+qt(1-0.02/2,n-2)*sb1
ICI1

## [1] 0.2117602

ICS1

## [1] 0.3504749

8. Calcule las sumas de cuadrados para el análisis de varianza.

# Suma de cuadrados del total:
SumaCT=sum((gastos-mean(gastos))**2)
SumaCT

## [1] 10536.64

# Suma de cuadrados de la regresion:
y_est=b0+b1*edad
SumaR=sum((gastos-y_est)**2)
SumaR

## [1] 7234.78

# Suma de cuadrados del error:
SumaE=sum((y_est-mean(gastos))**2)
SumaE

## [1] 3301.857

modelo1 %>% aov() %>% summary()

##              Df Sum Sq Mean Sq F value Pr(>F)    
## edad          1   3302    3302   90.36 <2e-16 ***
## Residuals   198   7235      37                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

9. Presente el análisis de varianza, redacte sus conclusiones con un nivel de significancia del 5%.

De la matriz anterior:

• \(H_0: β_1=0\)
• \(H_1:β_1= 0\)
• \(α = 0.05\)

Dado que el \(P_{valor}\) < 0.05, se rechaza la hipótesis nula. Existe suficiente evidencia estadística para para indicar que existe una relación lineal de dependencia de los gastos en función a la edad.

10. ¿A cuánto asciende el valor estimado de σ²? ¿En qué unidades se encuentra establecida esta estimación?

summary(modelo1)$sigma**2

## [1] 36.53929

\[σ² = CME\] donde: \(CME = \frac{SCE}{n-2}\) y \(SCE =\displaystyle\sum_{i=1}^{n}(y_i-\hat{y}_i)^2\)

• \(Variable\hspace{0.1cm}dependiente:\) = gastos(dolares).
• \(σ²\) = ($²)

11. Se desea estudiar la influencia lineal de las variables sobre los gastos. Presente el modelo de regresión lineal múltiple estimado.

\[Y_i = \beta_0+\beta_1X_{1,i}+...+\beta_pX_{p,i} + \epsilon_i \qquad i=1,...,n\]

• \(Y_i\) : es el monto mensual de la i-ésima persona.
• \(X_{1,i}\) : es la cantidad de años de la i-ésima persona.
• \(X_{2,i}\) : es el indice de masa corporal de la i-ésima persona.
• \(X_{3,i}\) : es el numero de hijos de la i-esima persona.

modelo2 <- lm(gastos ~ ., data = corr1)
modelo2

## 
## Call:
## lm(formula = gastos ~ ., data = corr1)
## 
## Coefficients:
## (Intercept)         edad          imc       nhijos  
##     -4.3869       0.2704       0.2500       0.3057

library(GGally)
corr1 %>% ggpairs(title = "Regresión lineal múltiple")

12. Interprete los coeficientes de regresión estimados.

library(broom)
modelo2 %>% tidy()

## # A tibble: 4 × 5
##   term        estimate std.error statistic  p.value
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)   -4.39     2.47      -1.77  7.77e- 2
## 2 edad           0.270    0.0290     9.33  2.34e-17
## 3 imc            0.250    0.0743     3.36  9.21e- 4
## 4 nhijos         0.306    0.339      0.901 3.69e- 1

Interpretación:

• \(β_0\) no tiene una interpretación.
• \(β_1\) por cada incremento en una unidad en la edad, el monto promedio mensual de paga aumentara en 0.2704 dolares, manteniendo constantes las demás variables.
• \(β_2\) por cada punto adicional del indice de masa corporal, el monto promedio mensual aumentara en 0.24998 dolares, manteniendo constantes las demás variables.
• \(β_3\) por cada hijo adicional, el monto promedio mensual aumentara en 0.30572 dolares, manteniendo constantes las demás variables.

13. ¿Qué sucedió con el valor del coeficiente de regresión de la edad cuando se trabajó con un modelo de regresión lineal múltiple en vez de uno simple?

sim <- modelo1 %>% tidy()
sim[2,c(1,2)]

## # A tibble: 1 × 2
##   term  estimate
##   <chr>    <dbl>
## 1 edad     0.281

mul <- modelo2 %>% tidy()
mul[2,c(1,2)]

## # A tibble: 1 × 2
##   term  estimate
##   <chr>    <dbl>
## 1 edad     0.270

El valor del coeficiente de regresión de lineal se redujo de 0.281 a 0.270.

14. Presente el análisis de varianza, redacte sus conclusiones con un nivel de significancia del 5%.

library(broom)
lm(gastos~ ., data = seguro1) -> modelo_variables
modelo_variables %>%  summary()

## 
## Call:
## lm(formula = gastos ~ ., data = seguro1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -13.8275  -3.9415  -0.2676   4.2364  12.4101 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -5.19529    2.49684  -2.081 0.038770 *  
## edad           0.26917    0.02843   9.468  < 2e-16 ***
## sexomasculino -0.08941    0.82943  -0.108 0.914265    
## imc            0.25387    0.07271   3.492 0.000594 ***
## nhijos         0.34643    0.33221   1.043 0.298342    
## fumasi         3.27114    0.98776   3.312 0.001106 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.76 on 194 degrees of freedom
## Multiple R-squared:  0.3892, Adjusted R-squared:  0.3735 
## F-statistic: 24.73 on 5 and 194 DF,  p-value: < 2.2e-16

\(H_0:\) No hay diferencia significativa en las medias \(H_1:\) Al menos una media es diferente

• Desicion: Con un nivel de significancia del 5%, en el caso de las variables cualitativas, concluimos que debemos rechazar la hipótesis nula, dado que tiene un pvalor menor a 0.05
• Conclusion: con un nivel de confianza del 95% , existe suficiente evidencia estadistica para afirmar que hay al menos una media diferente.

15. Plantee y desarrolle una prueba de hipótesis para una de las variables predictoras cuantitativas.

cor.test(gastos,imc,method="pearson",alternative="two.sided",conf.level=0.95)

## 
##  Pearson's product-moment correlation
## 
## data:  gastos and imc
## t = 3.6411, df = 198, p-value = 0.0003465
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1157954 0.3761783
## sample estimates:
##       cor 
## 0.2505118

• Conclusion: Con un nivel de significancia del \(5%\), si al realizar la hipotesis nula se obtiene \(P_{valor} < α\), se rechaza la prueba de hipotesis.

16. Plantee y desarrolle una prueba de hipótesis para una de las variables predictoras cualitativas.

seguro_modificado <- seguro1 %>% mutate(sexo=if_else(sexo=="femenino", 0, 1),fuma=if_else(fuma=="no", 0, 1))

cor.test(seguro_modificado$gastos,seguro_modificado$sexo,method="pearson",alternative="two.sided",conf.level=0.95)

## 
##  Pearson's product-moment correlation
## 
## data:  seguro_modificado$gastos and seguro_modificado$sexo
## t = -0.51344, df = 198, p-value = 0.6082
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1743237  0.1027965
## sample estimates:
##         cor 
## -0.03646462

• Conclusion: Con un nivel de significancia del \(5%\), si al realizar la hipotesis nula se obtiene \(P_{valor} > α\), se aprueba la prueba de hipotesis.

17. Obtenga e interprete el coeficiente de determinación, así como el de determinación ajustado.

summary(modelo2)$r.squared

## [1] 0.3541869

summary(modelo2)$adj.r.squared

## [1] 0.344302

18. Plantee una situación donde el punto evaluado para una predicción NO corresponda a una extrapolación

range(seguro_modificado$edad, na.rm = T )

## [1] 18 64

range(seguro_modificado$sexo, na.rm = T )

## [1] 0 1

range(seguro_modificado$imc, na.rm = T )

## [1] 15.96 49.06

range(seguro_modificado$nhijos, na.rm = T )

## [1] 0 5

range(seguro_modificado$fuma, na.rm = T )

## [1] 0 1

model.matrix(gastos~edad+sexo+imc+nhijos+fuma,data=seguro_modificado ) -> X
x = c(1,30,0,40,4,1)
H = X%*%solve(t(X)%*%X)%*%t(X)
h = H |> diag() |> max()
t(x)%*%solve(t(X)%*%X)%*%x

##            [,1]
## [1,] 0.07528721

t(x)%*%solve(t(X)%*%X)%*%x > h

##       [,1]
## [1,] FALSE

19. Plantee una situación donde el punto evaluado para una predicción SÍ corresponda a una extrapolación

x = c(1,75,0,3,7,1)
H = X%*%solve(t(X)%*%X)%*%t(X)
h = H |> diag() |> max()
t(x)%*%solve(t(X)%*%X)%*%x

##           [,1]
## [1,] 0.3189573

t(x)%*%solve(t(X)%*%X)%*%x > h

##      [,1]
## [1,] TRUE