library(tidyverse)
library(PerformanceAnalytics)

El objetivo de este análisis es utilizar datos de pacientes para estimar los gastos promedio de atención médica para ciertos segmentos de población. Estas estimaciones se pueden usar para crear tablas que fijen el precio de las primas anuales, dependiendo de los costes de tratamiento esperados.

Recolección de los datos

archivo = "https://raw.githubusercontent.com/stedy/Machine-Learning-with-R-datasets/master/insurance.csv"
file <- download.file(archivo, destfile = "insurance.csv")
data <- read.csv("insurance.csv", stringsAsFactors = T)

En primer lugar vamos a constatar la normalidad de la distribución de la variable aleatoria respuesta, que en este caso es charges. Aunque no la requiere estrictamente, el modelo se ajustará mejor si es así.

ggplot(data=data, aes(x = data$charges)) + 
  geom_histogram() +
  labs(title = "Distribución del gasto sanitario",
       y = "Número de individuos",
       x = "Gasto($)") +
  theme(plot.title = element_text(hjust = 0.5),
        legend.position = "right")

Podemos observar cómo la mayoría del gasto se concentra bajo los 15.000 dólares.

Exploración de las relaciones entre características

A continuación tenemos la matriz de correlaciones entre todas las variables numéricas

tabla_correlacion <- data %>%
  select(age, bmi, children, charges)
chart.Correlation(tabla_correlacion, histogram=TRUE)

Tenemos una correlación estadísticamente significativa entre los gastos y el bmi y la edad. Es decir, a medida que aumenta la edad y el bmi, aumentan los gastos. Además, existe también una correlación positiva entre edad y bmi.

Aplicación del modelo

regmodel <- lm(charges ~ ., data = data)
summary(regmodel)
## 
## Call:
## lm(formula = charges ~ ., data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11304.9  -2848.1   -982.1   1393.9  29992.8 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -11938.5      987.8 -12.086  < 2e-16 ***
## age                256.9       11.9  21.587  < 2e-16 ***
## sexmale           -131.3      332.9  -0.394 0.693348    
## bmi                339.2       28.6  11.860  < 2e-16 ***
## children           475.5      137.8   3.451 0.000577 ***
## smokeryes        23848.5      413.1  57.723  < 2e-16 ***
## regionnorthwest   -353.0      476.3  -0.741 0.458769    
## regionsoutheast  -1035.0      478.7  -2.162 0.030782 *  
## regionsouthwest   -960.0      477.9  -2.009 0.044765 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6062 on 1329 degrees of freedom
## Multiple R-squared:  0.7509, Adjusted R-squared:  0.7494 
## F-statistic: 500.8 on 8 and 1329 DF,  p-value: < 2.2e-16

  • Resíduos: dado que un residuo es igual al valor verdadero menos el valor predicho, el error máximo de 29992.8 sugiere que el modelo subestimó los gastos en casi 30,000 dólare para al menos una observación. Por otro lado, el 50% de los errores caen dentro de los valores 1Q y 3Q (el primer y tercer cuartil), por lo que la mayoría de las predicciones fueron entre 2,850.90 sobre el valor verdadero y 1,383.90 dólares por debajo del valor verdadero.

  • Significación estadística: Para cada coeficiente de regresión estimado, el valor p proporciona una estimación de la probabilidad de que el coeficiente verdadero sea cero dado el valor de la estimación. Los valores p pequeños sugieren que es muy poco probable que el coeficiente verdadero sea cero, lo que significa que es extremadamente improbable que la característica no tenga relación con la variable dependiente.

  • Coeficiente de determinación: proporciona una medida de cómo nuestro modelo en su conjunto explica los valores de la variable dependiente. Dado que el valor \(R^2\) es 0.7494, sabemos que el modelo explica casi el 75 por ciento de la variación en la variable dependiente.

Mejora del modelo

  • BMI: creemos que la variable BMI podría ser predictora del aumento de gasto sanitario, así que vamos a convertir tal variable en dicotómica, y ver la diferencia de gasto entre aquellos usuarios que superan el índice de 30 y los que no
data <- mutate(data, 
               bmigreater30 = 1 * (data$bmi >= 30))
data$bmigreater30 <- factor(data$bmigreater30)
data$bmigreater30 = fct_recode(data$bmigreater30,
                         "Yes" = "1",
                         "No" = "0")
modelbmi <- lm(charges ~ bmigreater30, data)
summary(modelbmi)
## 
## Call:
## lm(formula = charges ~ bmigreater30, data = data)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -14421  -8132  -3963   4236  48218 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      10713.7      472.6  22.671  < 2e-16 ***
## bmigreater30Yes   4838.7      650.1   7.443 1.76e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11870 on 1336 degrees of freedom
## Multiple R-squared:  0.03981,    Adjusted R-squared:  0.03909 
## F-statistic:  55.4 on 1 and 1336 DF,  p-value: 1.759e-13

Las personas con un índice de masa corporal mayor que 30 tienen un gasto medio de casi 5000 dólares más que los que no.

  • Interacción BMI y consumo de tabaco:
## Podemos utilizar indistintamente las siguientes fórmulas
interaction_bmi_smk <- lm(charges ~ bmigreater30 * smoker, data)
summary(interaction_bmi_smk)
## 
## Call:
## lm(formula = charges ~ bmigreater30 * smoker, data = data)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -19414  -4336  -1055   2987  28068 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                 7977.0      263.6  30.267   <2e-16 ***
## bmigreater30Yes              865.7      362.6   2.387   0.0171 *  
## smokeryes                  13386.2      582.9  22.965   <2e-16 ***
## bmigreater30Yes:smokeryes  19329.1      801.4  24.119   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5905 on 1334 degrees of freedom
## Multiple R-squared:  0.7628, Adjusted R-squared:  0.7622 
## F-statistic:  1430 on 3 and 1334 DF,  p-value: < 2.2e-16
interaction_bmi_smk <- lm(charges ~ bmigreater30 + smoker + bmigreater30:smoker, data)
summary(interaction_bmi_smk)
## 
## Call:
## lm(formula = charges ~ bmigreater30 + smoker + bmigreater30:smoker, 
##     data = data)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -19414  -4336  -1055   2987  28068 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                 7977.0      263.6  30.267   <2e-16 ***
## bmigreater30Yes              865.7      362.6   2.387   0.0171 *  
## smokeryes                  13386.2      582.9  22.965   <2e-16 ***
## bmigreater30Yes:smokeryes  19329.1      801.4  24.119   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5905 on 1334 degrees of freedom
## Multiple R-squared:  0.7628, Adjusted R-squared:  0.7622 
## F-statistic:  1430 on 3 and 1334 DF,  p-value: < 2.2e-16