Dados

Os dados utilizados nesta análise foram obtidos no Kaggle, eles dizem respeito a gastos com plano de saúde, utilizaremos as seguintes colunas (os nomes foram traduzidos para o português):

ins <- read_csv("data/insurance.csv", col_types = cols_only(
  age = col_double(),
  sex = col_character(),
  bmi = col_double(),
  children = col_double(),
  smoker = col_character(),
  charges = col_double()
))

colnames(ins) <- c("idade", "genero", "imc", "filhos", "fumante", "gastos")

Iniciaremos com uma análise exploratória dos dados.

Variável idade

É possível ver que existe uma relação linear entre as variáveis, considerando a escala adotada. Ao observarmos o valor mínimo do gasto ao longo das idades é possível ver que apresenta uma relação forte e bem definida, porém é possível ver que indepente da idade temos gastos que podem chegar a passar dos USD 40.000. Esta dispersão faz com que a relação seja mediana, conforme corroborado pelo valor da correlação de Pearson: 0.54.

ins %>%
  ggplot(aes(x = idade, y = gastos)) +
  geom_point() +
  scale_y_log10(breaks = c(1250, 2500, 5000, 10000, 20000, 40000)) +
  scale_x_log10() +
  labs(title = "Gráfico de dispersão da gastos pela idade",
       subtitle = "Ambas as variáveis em escala logarítimica",
       x = "Idade",
       y = "Gastos (USD)")

Variável gênero

Ambas as distribuições são parecidas (mediana e 1º quartis são muito próximos), as duas principais diferenças se dão:

  • pelo valor mínimo enquanto o das mulheres fica em torno de USD 1600, o dos homens é próximo a USD 1100, indicando assim que ser homem pode representar um menor gasto com saúde.
  • e pelo 3º quartil dos homens que é um pouco maior que o das mulheres, indicando uma frequência maior de homens que gastam mais que mulheres.
ins <- ins %>% mutate(genero = ifelse(genero == "male", "masculino", "feminino"))

ins %>%
  ggplot(aes(x = genero, y = gastos)) +
  geom_boxplot() +
  geom_jitter(alpha = .3) +
  scale_y_log10(breaks = c(1250, 2500, 5000, 10000, 20000, 40000)) +
  labs(title = "Distribuição dos gastos agrupado pelo gênero",
       x = "Gênero",
       y = "Gastos (USD)")

Variável IMC

Iremos avaliar a variável IMC de duas formas: pelo valor propriamente dito (Gráfico I) e pela classificação (Gráfico II).

Gráfico I - IMC

Não é possível ver nenhuma relação clara entre as variáveis.

ins %>%
  ggplot(aes(x = imc, y = gastos)) +
  geom_point() +
  scale_y_log10(breaks = c(1250, 2500, 5000, 10000, 20000, 40000)) +
  labs(title = "Gráfico de dispersão gastos por IMC",
       x = "IMC",
       y = "Gastos (USD)")

Gráfico II - Obesidade

Considerando a classificação do IMC para obesidade (IMC >= 30) geramos o gráfico abaixo. É possível ver que, no grupo de pessoas classificadas como obesas (TRUE), o 3º quartil e o máximo dos gastos são maiores que no outro. Dessa forma, utilizaremos essa variável no modelo e descartaremos a do IMC.

ins <- ins %>% mutate(obeso = ifelse(imc >= 30, "Sim", "Não")) %>% select(-imc)

ins %>%
  ggplot(aes(x = obeso, y = gastos)) +
  geom_boxplot() +
  scale_y_log10(breaks = c(1250, 2500, 5000, 10000, 20000, 40000)) +
  labs(title = "Distribuição dos gastos agrupado pela obesidade",
       x = "Obesidade",
       y = "Gastos (USD)")

Variável número de filhos/dependentes

É possível ver um claro aumento nos gastos mínimos conforme o número de filhos aumenta, apesar do valor máximo gasto ser sempre próximo, com exceção dos dois últimos casos (4 e 5 filhos), porém neles temos bem menos dados que nos demais.

ins %>%
  ggplot(aes(x = as.factor(filhos), y = gastos)) +
  geom_boxplot() +
  geom_jitter(alpha = .3) +
  scale_y_log10(breaks = c(1250, 2500, 5000, 10000, 20000, 40000)) +
  labs(title = "Gráfico de dispersão gastos por nº de filhos/dependentes",
       x = "Nº de filhos/dependentes",
       y = "Gastos (USD)")

Variável fumante

Das variáveis vistas até então está apresenta a diferença mais gritante. Ser fumante eleva o gasto mínimo para além do 3º quartil dos não fumantes, além de ter um gasto máximo maior que tal grupo.

ins <- ins %>% mutate(fumante = ifelse(fumante == "yes", "Sim", "Não"))

ins %>%
  ggplot(aes(x = fumante, y = gastos)) +
  geom_boxplot() +
  scale_y_log10(breaks = c(1250, 2500, 5000, 10000, 20000, 40000)) +
  labs(title = "Gráfico de dispersão gastos pela condição de fumante",
       x = "Fumante",
       y = "Gastos (USD)")

O modelo

mod1 <- lm(log10(gastos) ~ ., ins)
 
r2 <- glance(mod1) %>% pull(adj.r.squared)

Após a análise exploratória, sigamos para a construção e análise do modelo, lembrando que usaremos as variáveis IDADE, GENERO, FILHOS, FUMANTE e OBESO como variáveis independentes e GASTOS como nossa variável alvo (em escala logarítimica).

O modelo construído nos dá a seguinte equação:

\[ \log_{10}{gastos} = 3.16 + 0.02 \cdot idade - 0.03 \cdot masculino + 0.04 \cdot filhos + 0.67 \cdot fumante + 0.06 \cdot obeso \]

Como nossa variável está em termos logarítimicos podemos exponenciar a equação e removê-lo:

\[ gastos = 10^{3.16 + 0.02 \cdot idade - 0.03 \cdot masculino + 0.04 \cdot filhos + 0.67 \cdot fumante + 0.06 \cdot obeso} \\ gastos = 10^{3.16} \cdot 10^{0.02 \cdot idade} \cdot 10^{-0.03 \cdot masculino} \cdot 10^{0.04 \cdot filhos} \cdot 10^{0.67 \cdot fumante} \cdot 10^{0.06 \cdot obeso} \]

Podemos ainda substituir os coeficientes pelos coeficientes exponenciados que podem ser visto abaixo, junto aos não exponenciados na tabela abaixo:

tidymod <-
  tidy(mod1, conf.int = T) %>%
  mutate(
    estimate_exp = 10 ** estimate,
    conf.low_exp = 10 ** conf.low,
    conf.high_exp = 10 ** conf.high
  ) %>%
  select(term,
         estimate,
         estimate_exp,
         conf.low,
         conf.low_exp,
         conf.high,
         conf.high_exp)

tidymod %>%
  knitr::kable(
    digits = 2,
    col.names = c(
      "Termo",
      "Estimativa",
      "Estimativa Exp.",
      "IC Inf.",
      "IC Inf. Exp.",
      "IC Sup.",
      "IC Sup. Exp."
    )
  )
Termo Estimativa Estimativa Exp. IC Inf. IC Inf. Exp. IC Sup. IC Sup. Exp.
(Intercept) 3.16 1435.40 3.12 1323.92 3.19 1556.26
idade 0.02 1.04 0.01 1.03 0.02 1.04
generomasculino -0.03 0.93 -0.05 0.88 -0.01 0.97
filhos 0.04 1.11 0.04 1.09 0.05 1.13
fumanteSim 0.67 4.72 0.65 4.44 0.70 5.01
obesoSim 0.06 1.15 0.04 1.10 0.08 1.21

Sendo assim, nossa equação final é:

\[ gastos = 1435.40 \cdot 1.04^{idade} \cdot 0.93^{masculino} \cdot 1.11^{filhos} \cdot 4.72^{fumante} \cdot 1.15^{obeso} \] Vejamos então o gráfico dos intervalos de confiança para nossos coeficientes:

library(patchwork)

tidymod <-
  tidymod %>%
  mutate(term = c("(Intercept)", "Idade", "Masculino", "Filhos", "Fumante", "Obeso"))

(
  tidymod %>% filter(term != "(Intercept)", term != "Fumante") %>%
    ggplot(
      aes(
        x = estimate_exp,
        y = reorder(term, estimate_exp),
        xmin = conf.low_exp,
        xmax = conf.high_exp
      )
    ) +
    geom_point(color = 'coral') +
    geom_linerange() +
    geom_text(
      aes(label = paste(
        "[", round(conf.low_exp, 2), ";", round(conf.high_exp, 2), "]"
      )),
      nudge_y = -.25,
      nudge_x = .025,
      size = 3
    ) +
    labs(y = "",
         x = "",
         title = "")
) /
(
  tidymod %>% filter(term == "Fumante") %>%
     ggplot(aes(x = estimate_exp, y = reorder(term, estimate_exp), xmin = conf.low_exp, xmax = conf.high_exp)) +
     geom_point(color = 'coral') +
     geom_linerange() +
     geom_text(aes(label = paste("[", round(conf.low_exp,2), ";", round(conf.high_exp,2), "]")),
               nudge_y = -.1,
               nudge_x = .025,
               size = 3) +
     labs(
       x = "Estimativa",
       y = ""
     )
) + plot_annotation(title = 'Intervalos de confiança para os coeficientes do modelo',
                    caption = 'Devido a grande diferença no coeficiente fumante, o gráfico foi dividido para melhorar a visualização.')

Conclusões