El Objetivo de este trabajo es encontrar un modelo para estimar el costo del seguro medico para lo cual utilizamos la base del portal https://www.kaggle.com/datasets/mirichoi0218/insurance?ref=hackernoon.com que tiene informaciónes personales y de salud.

#rm(list=ls(all=TRUE))
#Librerias a ser utilizadas
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(conflicted)
conflict_scout()
## 2 conflicts
## • `filter()`: dplyr and stats
## • `lag()`: dplyr and stats
conflict_prefer("filter", "dplyr")
## [conflicted] Will prefer dplyr::filter over any other package.
conflict_prefer("select", "dplyr")
## [conflicted] Will prefer dplyr::select over any other package.
library(magrittr)
library(readxl)
library(rstatix)
library(modelr)
options(na.action = na.warn)
library(patchwork)
library(moderndive)
library(broom)
library(nortest)

Importarmos los datos

#Importamos la base de datos
seguro<-read_excel("Base Modelos.xlsx")
str(seguro)
## tibble [1,338 × 6] (S3: tbl_df/tbl/data.frame)
##  $ age     : num [1:1338] 19 18 28 33 32 31 46 37 37 60 ...
##  $ sex     : chr [1:1338] "female" "male" "male" "male" ...
##  $ children: num [1:1338] 0 1 3 0 0 0 1 3 2 0 ...
##  $ smoker  : chr [1:1338] "yes" "no" "no" "no" ...
##  $ bmi     : num [1:1338] 27.9 33.8 33 22.7 28.9 ...
##  $ charges : num [1:1338] 16885 1726 4449 21984 3867 ...
seguro$sex=factor(seguro$sex,labels = c("female","male"))
seguro$smoker=factor(seguro$smoker,labels = c("yes","no"))
summary(seguro)
##       age            sex         children     smoker          bmi       
##  Min.   :18.00   female:662   Min.   :0.000   yes:1064   Min.   :15.96  
##  1st Qu.:27.00   male  :676   1st Qu.:0.000   no : 274   1st Qu.:26.30  
##  Median :39.00                Median :1.000              Median :30.40  
##  Mean   :39.21                Mean   :1.095              Mean   :30.66  
##  3rd Qu.:51.00                3rd Qu.:2.000              3rd Qu.:34.69  
##  Max.   :64.00                Max.   :5.000              Max.   :53.13  
##     charges     
##  Min.   : 1122  
##  1st Qu.: 4740  
##  Median : 9382  
##  Mean   :13270  
##  3rd Qu.:16640  
##  Max.   :63770

##Podemos observar que la edad de la población se encuentra entre 18 y 64 años con una media de 39 años, se tiene una distribución por sexo bastante simétrica , una importante cantidad de personas que fuman casi forma el 80% de los datos ,también podemos notar que la cantidad de hijos que están cubiertos por el seguro no es mayor a 5 hijos y el índice de masa corporal tiene una media de 30.66 que está por encima del valor deseable que se encuentra entre 18.5 y 24.9 como se había definido en el comienzo del trabajo.

Descripcion de variables

#Variable de respuesta y=Charges “Costo del seguro medico” ###Variables explicativas(X) Age(edad) sex(sexo) smoker(fuma,no fuma) BMI(indice de masa corporal)

Análisis Exploratorio (Analisis univariado)

#Y:charges(Variable de respuesta)
#Histograma
hist(seguro$charges, main="Costo del seguro", ylab= "Frecuencia absoluta", xlab= "Costo",cex.axis=0.8)

###Los datos arrojados por la grafica que indican la distribucion de la variable de respuesta presenta una asimetria positiva. # Análisis bivariado - Cuantitativo

library(ggplot2)
library(psych)
corPlot(seguro[,c(6,5,1)],cex = 1.25)

Los datos muestran una correlacion entre la variables explicativas y la variable de respuesta que estan entre 0.20 y 0.30 respectivamente.

ANALISIS BIVARIADO Cualitativo

boxplot(charges~smoker, data = seguro)

boxplot(charges~sex, data = seguro)

##La grafica nos muestra que la relacion entre los que fuman y no fuman con la variable de respuesta costo del seguro medico,los fumadores presentan una mayor concentarcion de los datos y el de no fumadores es mas disperso.

ggplot(seguro, aes(x=age, y=charges,color=sex)) + 
  geom_point() + theme_light()

ggplot(seguro, aes(x=age, y=charges,color=children)) + 
  geom_point() + theme_light()

###Proponer un modelo (que usted considere el más completo) en forma de ecuación. Indicar cuál es el rango de la matriz de ese modelo. Obtener una solución para el vector de parámetros y, en caso de ser posible, interpretarla. Obtener una estimación puntual y por intervalo de confianza de 2  . Obtener y yˆ . Graficar yˆ versus y . Indicar el software utilizado.

Generacion de modelo

## Ajuste del modelo

modelo<- lm(charges ~ age+sex+children+smoker+bmi, data = seguro)
modelo
## 
## Call:
## lm(formula = charges ~ age + sex + children + smoker + bmi, data = seguro)
## 
## Coefficients:
## (Intercept)          age      sexmale     children     smokerno          bmi  
##    -12052.5        257.7       -128.6        474.4      23823.4        322.4
summary(modelo)
## 
## Call:
## lm(formula = charges ~ age + sex + children + smoker + bmi, data = seguro)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11837.2  -2916.7   -994.2   1375.3  29565.5 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -12052.46     951.26 -12.670  < 2e-16 ***
## age            257.73      11.90  21.651  < 2e-16 ***
## sexmale       -128.64     333.36  -0.386 0.699641    
## children       474.41     137.86   3.441 0.000597 ***
## smokerno     23823.39     412.52  57.750  < 2e-16 ***
## bmi            322.36      27.42  11.757  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6070 on 1332 degrees of freedom
## Multiple R-squared:  0.7497, Adjusted R-squared:  0.7488 
## F-statistic:   798 on 5 and 1332 DF,  p-value: < 2.2e-16

###Se prueba extraer la variable sexo del modelo inicial ya que en el cuadro observamos que no es significativo.

modelo1<- lm(charges ~ age+children+smoker+bmi, data = seguro)
modelo1
## 
## Call:
## lm(formula = charges ~ age + children + smoker + bmi, data = seguro)
## 
## Coefficients:
## (Intercept)          age     children     smokerno          bmi  
##    -12102.8        257.8        473.5      23811.4        321.9
summary(modelo1)
## 
## Call:
## lm(formula = charges ~ age + children + smoker + bmi, data = seguro)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11897.9  -2920.8   -986.6   1392.2  29509.6 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -12102.77     941.98 -12.848  < 2e-16 ***
## age            257.85      11.90  21.675  < 2e-16 ***
## children       473.50     137.79   3.436 0.000608 ***
## smokerno     23811.40     411.22  57.904  < 2e-16 ***
## bmi            321.85      27.38  11.756  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6068 on 1333 degrees of freedom
## Multiple R-squared:  0.7497, Adjusted R-squared:  0.7489 
## F-statistic: 998.1 on 4 and 1333 DF,  p-value: < 2.2e-16
## Análisis de supuestos

# Obtener los residuos estandarizados
residuos <- rstandard(modelo1)
qqnorm(residuos)
qqline(residuos)

# Graficar residuos vs. valores ajustados
plot(fitted(modelo1), residuos, xlab = "Valores predichos", 
     ylab = "Residuos estandarizados", 
     main = "Gráfico de residuos vs. valores predichos")
abline(h = 0, col = "red", lty = 2)  # Agregar línea horizontal en 0

##Como los datos no cumplen los supuestos de normalidad y la garfica refleja la falta de homosedastisidad se pasa a realizar la transformacion.

############# Transformación de la respuesta #############
library(MASS)

boxcox(modelo1,lambda=seq(-1,1,length=20),plotit=T)

chargesT=log(seguro$charges)

hist(chargesT, main="Logaritmo Natural del Costo del seguro", 
     ylab= "Frecuencia absoluta", xlab= "Ln - Costo",cex.axis=0.8)

seguro2=data.frame(seguro,chargesT)
## Ajuste del modelo


modelo2<- lm(chargesT ~ age+children+smoker+bmi , data = seguro2)
modelo2
## 
## Call:
## lm(formula = chargesT ~ age + children + smoker + bmi, data = seguro2)
## 
## Coefficients:
## (Intercept)          age     children     smokerno          bmi  
##     6.98278      0.03478      0.10120      1.54324      0.01061
summary(modelo2)
## 
## Call:
## lm(formula = chargesT ~ age + children + smoker + bmi, data = seguro2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.11340 -0.19883 -0.04688  0.07197  2.07581 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 6.9827766  0.0697227 100.151  < 2e-16 ***
## age         0.0347826  0.0008805  39.502  < 2e-16 ***
## children    0.1011976  0.0101989   9.922  < 2e-16 ***
## smokerno    1.5432438  0.0304372  50.703  < 2e-16 ***
## bmi         0.0106096  0.0020264   5.236 1.91e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4491 on 1333 degrees of freedom
## Multiple R-squared:  0.7622, Adjusted R-squared:  0.7614 
## F-statistic:  1068 on 4 and 1333 DF,  p-value: < 2.2e-16
anova(modelo2)
## Analysis of Variance Table
## 
## Response: chargesT
##             Df Sum Sq Mean Sq  F value    Pr(>F)    
## age          1 314.96  314.96 1561.470 < 2.2e-16 ***
## children     1  21.86   21.86  108.356 < 2.2e-16 ***
## smoker       1 519.25  519.25 2574.289 < 2.2e-16 ***
## bmi          1   5.53    5.53   27.413 1.908e-07 ***
## Residuals 1333 268.88    0.20                       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
###Linealidad
plot(modelo2,1)

residuos=residuals(modelo2)
##Normalidad de los residuos
ks.test(residuos,"pnorm",mean(residuos),sd(residuos))
## Warning in ks.test.default(residuos, "pnorm", mean(residuos), sd(residuos)):
## ties should not be present for the Kolmogorov-Smirnov test
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  residuos
## D = 0.21168, p-value < 2.2e-16
## alternative hypothesis: two-sided
library(lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
##Heterocedastisidad
bptest(modelo2)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo2
## BP = 80.917, df = 4, p-value < 2.2e-16
library(carData)
library(car)
##Multicolinealidad
vif(modelo2)
##      age children   smoker      bmi 
## 1.014498 1.001950 1.000745 1.012194
###INTERVALO DE CONFIANZA DEL MODELO
confint(modelo)
##                   2.5 %      97.5 %
## (Intercept) -13918.5939 -10186.3301
## age            234.3826    281.0874
## sexmale       -782.6087    525.3290
## children       203.9730    744.8493
## smokerno     23014.1262  24632.6589
## bmi            268.5759    376.1526
confint(modelo1)
##                   2.5 %      97.5 %
## (Intercept) -13950.7019 -10254.8369
## age            234.5118    281.1872
## children       203.1902    743.8145
## smokerno     23004.6915  24618.1082
## bmi            268.1435    375.5593
confint(modelo2)
##                   2.5 %     97.5 %
## (Intercept) 6.845998471 7.11955464
## age         0.033055179 0.03650994
## children    0.081189958 0.12120525
## smokerno    1.483533835 1.60295380
## bmi         0.006634359 0.01458494
##INTERVALO DE CONFIANZA DE SIGMA 2
library(tools)
if (!require('devtools')) install.packages('devtools')
## Loading required package: devtools
## Loading required package: usethis
devtools::install_github('fhernanb/model', force=TRUE)
## Downloading GitHub repo fhernanb/model@HEAD
## 
## ── R CMD build ─────────────────────────────────────────────────────────────────
##   
   checking for file ‘/tmp/RtmpjGwO4f/remotesf3e7de750ba/fhernanb-model-82e4d09/DESCRIPTION’ ...
  
✔  checking for file ‘/tmp/RtmpjGwO4f/remotesf3e7de750ba/fhernanb-model-82e4d09/DESCRIPTION’
## 
  
─  preparing ‘model’:
##    checking DESCRIPTION meta-information ...
  
✔  checking DESCRIPTION meta-information
## 
  
─  checking for LF line-endings in source and make files and shell scripts
## 
  
─  checking for empty or unneeded directories
##    Omitted ‘LazyData’ from DESCRIPTION
## 
  
─  building ‘model_0.0.0.9001.tar.gz’
## 
  
   Warning: invalid uid value replaced by that for user 'nobody'
## 
  
   
## 
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.3'
## (as 'lib' is unspecified)
library(model)
confint_sigma2(object=modelo, level=0.95)
##           2.5 %   97.5 %
## Sigma2 34196180 39807849

###Se descarta multicolinalidad entre las variables. ##Por lo tanto el modelo final no pasa todos los supuestos sobre los que se basa un modelo regresion lineal.Se sugiere aplicar otro tipo de modelos que permitan el mejor ajuste de los datos.