Instituto Brasileiro de Ensino, Desenvolvimento e Pesquisa - IDP

Curso: Doutorado Profissional em Economia
Disciplina: Introdução à Estatística e Econometria
Professor: Alexandre Xavier Ywata de Carvalho
Tema: Lista 4 - Modelos de Regressão Logística

---

Introdução

Esta atividade apresenta a aplicação de modelos de regressão logística para modelar o churn (portabilidade) de clientes, com base na base de dados “Churn_Modelling.csv”. O objetivo é estimar diversos modelos de regressão logística, compará-los por meio dos critérios de informação AIC e BIC, analisar a capacidade preditiva por meio da curva ROC e da área sob a curva (AUC), e calcular intervalos de confiança para os coeficientes do melhor modelo.

Questão 1: Modelos de Regressão Logística para Churn

1.1 Carregar e Explorar os Dados

# Definir diretório de trabalho
setwd("F:\\IDP_DOUTORADO EM ECONOMIA\\Estatística e Econometria\\Lista 4")

# Carregar dados
ChurnData <- read.csv2("Churn_Modelling.csv", header=T, sep=",", dec=".", 
                       encoding="latin1", stringsAsFactors = F)

# Tabela 1: Descrição das Variáveis
desc_churn <- data.frame(
  Variavel = c("Exited", "CreditScore", "Age", "Tenure", "Balance", 
               "NumOfProducts", "HasCrCard", "EstimatedSalary", "Geography", 
               "Gender", "IsActiveMember"),
  Descricao = c("Indica se o cliente deixou o banco (1 = sim, 0 = não)",
                "Pontuação de crédito do cliente",
                "Idade do cliente",
                "Número de anos que o cliente está no banco",
                "Saldo da conta",
                "Número de produtos que o cliente adquiriu",
                "Indica se o cliente possui cartão de crédito (1 = sim, 0 = não)",
                "Salário estimado do cliente",
                "Geografia do cliente (França, Espanha, Alemanha)",
                "Gênero do cliente (Masculino, Feminino)",
                "Indica se o cliente é ativo (1 = sim, 0 = não)")
)

kable(desc_churn, 
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 1: Descrição das Variáveis - Churn de Clientes</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 1: Descrição das Variáveis - Churn de Clientes

Variavel	Descricao
Exited	Indica se o cliente deixou o banco (1 = sim, 0 = não)
CreditScore	Pontuação de crédito do cliente
Age	Idade do cliente
Tenure	Número de anos que o cliente está no banco
Balance	Saldo da conta
NumOfProducts	Número de produtos que o cliente adquiriu
HasCrCard	Indica se o cliente possui cartão de crédito (1 = sim, 0 = não)
EstimatedSalary	Salário estimado do cliente
Geography	Geografia do cliente (França, Espanha, Alemanha)
Gender	Gênero do cliente (Masculino, Feminino)
IsActiveMember	Indica se o cliente é ativo (1 = sim, 0 = não)

1.2 Estimação dos Modelos 1 a 4

# Modelo 1: sem fatores geográficos e de gênero
mod1 <- glm(formula = Exited ~ CreditScore + Age + Tenure + Balance +
                               NumOfProducts + HasCrCard + EstimatedSalary, 
            family = binomial(link = "logit"), data = ChurnData)

# Modelo 2: com fatores geográficos, de gênero e IsActiveMember
mod2 <- glm(formula = Exited ~ CreditScore + Age + Tenure + Balance +
                NumOfProducts + HasCrCard + EstimatedSalary + 
                as.factor(Geography) + as.factor(Gender) + IsActiveMember, 
            family = binomial(link = "logit"), data = ChurnData)

# Modelo 3: excluindo HasCrCard e EstimatedSalary (a partir de mod2)
mod3 <- update(mod2, . ~ . - HasCrCard - EstimatedSalary)

# Modelo 4: excluindo HasCrCard, EstimatedSalary e Tenure (a partir de mod2)
mod4 <- update(mod2, . ~ . - HasCrCard - EstimatedSalary - Tenure)

### 1.2 Estimação dos Modelos 1 a 4


# Resumo dos coeficientes do Modelo 2
coef_mod2 <- summary(mod2)$coefficients

# Corrigir a criação do data frame - remover duplicação
coef_mod2_df <- data.frame(
  Variável = c("(Intercept)", "CreditScore", "Age", "Tenure", "Balance", 
               "NumOfProducts", "HasCrCard", "EstimatedSalary", 
               "Geography [Germany]", "Geography [Spain]", "Gender [Male]", 
               "IsActiveMember")[1:min(10, nrow(coef_mod2))],
  Coeficiente = round(coef_mod2[1:10, 1], 4),
  Erro_Padrão = round(coef_mod2[1:10, 2], 4),
  Valor_z = round(coef_mod2[1:10, 3], 4),
  P_Valor = round(coef_mod2[1:10, 4], 4),
  Significância = ifelse(coef_mod2[1:10, 4] < 0.01, "***",
                        ifelse(coef_mod2[1:10, 4] < 0.05, "**",
                              ifelse(coef_mod2[1:10, 4] < 0.1, "*", "")))
)

kable(coef_mod2_df,
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 2: Coeficientes do Modelo 2 (10 primeiras variáveis)</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 2: Coeficientes do Modelo 2 (10 primeiras variáveis)

	Variável	Coeficiente	Erro_Padrão	Valor_z	P_Valor	Significância
(Intercept)	(Intercept)	-3.3923	0.2448	-13.8569	0.0000	***
CreditScore	CreditScore	-0.0007	0.0003	-2.3840	0.0171	**
Age	Age	0.0727	0.0026	28.2298	0.0000	***
Tenure	Tenure	-0.0159	0.0094	-1.7049	0.0882
Balance	Balance	0.0000	0.0000	5.1284	0.0000	***
NumOfProducts	NumOfProducts	-0.1015	0.0471	-2.1539	0.0312	**
HasCrCard	HasCrCard	-0.0447	0.0593	-0.7529	0.4515
EstimatedSalary	EstimatedSalary	0.0000	0.0000	1.0149	0.3102
as.factor(Geography)Germany	Geography [Germany]	0.7747	0.0677	11.4477	0.0000	***
as.factor(Geography)Spain	Geography [Spain]	0.0352	0.0706	0.4986	0.6181

Especificação dos Modelos 1 a 4:

• Modelo 1: Exited ~ CreditScore + Age + Tenure + Balance + NumOfProducts + HasCrCard + EstimatedSalary
• Modelo 2: Modelo 1 + as.factor(Geography) + as.factor(Gender) + IsActiveMember
• Modelo 3: Modelo 2 - HasCrCard - EstimatedSalary
• Modelo 4: Modelo 2 - HasCrCard - EstimatedSalary - Tenure

Estes modelos formam a base para as comparações subsequentes nos itens iii e iv.

1.3 Comparação dos Modelos 1 a 4 por AIC e BIC

comparison_1_4 <- data.frame(
  Modelo = c("Modelo 1", "Modelo 2", "Modelo 3", "Modelo 4"),
  AIC = c(AIC(mod1), AIC(mod2), AIC(mod3), AIC(mod4)),
  BIC = c(BIC(mod1), BIC(mod2), BIC(mod3), BIC(mod4))
)

kable(comparison_1_4, 
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 3: Comparação dos Modelos 1 a 4 por AIC e BIC</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50") %>%
  row_spec(which.min(comparison_1_4$AIC), bold = TRUE, background = "#d2d5d6") %>%
  row_spec(which.min(comparison_1_4$BIC), bold = TRUE, background = "#d2d5d6")

Tabela 3: Comparação dos Modelos 1 a 4 por AIC e BIC

Modelo	AIC	BIC
Modelo 1	9215.944	9273.626
Modelo 2	8585.355	8671.879
Modelo 3	8582.953	8655.056
Modelo 4	8583.866	8648.759

Respostas Detalhadas (itens i a iv):

iii. Melhor modelo segundo AIC (modelos 1 a 4): Modelo Modelo 3 com AIC = 8582.9526964.

iv. Melhor modelo segundo BIC (modelos 1 a 4): Modelo Modelo 4 com BIC = 8648.7589284.

1.4 Modelos com Dummies Excluídas (itens v e vi)

# PASSO 1: Criar a base de dados com dummies
# Verificar se já existe, se não, criar
if(!exists("ChurnData_dummies")) {
  ChurnData_dummies <- dummy_cols(ChurnData, 
                                  select_columns = c("Geography", "Gender"),
                                  remove_selected_columns = FALSE)
}

# PASSO 2: Modelo 5 (a partir do mod3, excluindo HasCrCard e EstimatedSalary, excluindo dummy Spain)
mod5 <- glm(formula = Exited ~ CreditScore + Age + Tenure + Balance + NumOfProducts +
              Geography_France + Geography_Germany +  # Excluímos Spain (categoria de referência)
              Gender_Female + Gender_Male + IsActiveMember,
            family = binomial(link = "logit"), 
            data = ChurnData_dummies)

# PASSO 3: Modelo 6 (a partir do mod4, excluindo HasCrCard, EstimatedSalary e Tenure, excluindo dummy Spain)
mod6 <- glm(formula = Exited ~ CreditScore + Age + Balance + NumOfProducts +
              Geography_France + Geography_Germany +  # Excluímos Spain (categoria de referência)
              Gender_Female + Gender_Male + IsActiveMember,
            family = binomial(link = "logit"), 
            data = ChurnData_dummies)

# PASSO 4: Tabela das dummies criadas
dummies_table <- data.frame(
  Variável_Original = c("Geography", "Geography", "Geography", "Gender", "Gender"),
  Dummy_Criada = c("Geography_France", "Geography_Germany", "Geography_Spain", 
                   "Gender_Female", "Gender_Male"),
  Categoria_Referência = c("Não", "Não", "Sim (excluída nos modelos 5 e 6)", 
                           "Não", "Sim (categoria base)")
)

kable(dummies_table,
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 4: Dummies Criadas para Variáveis Categóricas</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 4: Dummies Criadas para Variáveis Categóricas

Variável_Original	Dummy_Criada	Categoria_Referência
Geography	Geography_France	Não
Geography	Geography_Germany	Não
Geography	Geography_Spain	Sim (excluída nos modelos 5 e 6)
Gender	Gender_Female	Não
Gender	Gender_Male	Sim (categoria base)

# PASSO 5: Coeficientes dos modelos 5 e 6 para comparação
coef_mod5 <- summary(mod5)$coefficients
coef_mod6 <- summary(mod6)$coefficients

# Tabela comparativa dos coeficientes de Geography
geo_coef_comparison <- data.frame(
  Variável = c("Geography_France", "Geography_Germany"),
  Modelo5_Coeficiente = c(round(coef_mod5["Geography_France", "Estimate"], 4),
                          round(coef_mod5["Geography_Germany", "Estimate"], 4)),
  Modelo6_Coeficiente = c(round(coef_mod6["Geography_France", "Estimate"], 4),
                          round(coef_mod6["Geography_Germany", "Estimate"], 4))
)

kable(geo_coef_comparison,
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 5: Comparação dos Coeficientes de Geography nos Modelos 5 e 6</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 5: Comparação dos Coeficientes de Geography nos Modelos 5 e 6

Variável	Modelo5_Coeficiente	Modelo6_Coeficiente
Geography_France	-0.0359	-0.0366
Geography_Germany	0.7382	0.7365

# PASSO 6: Resumo de Confirmação (em formato de tabela)
resumo_modelos <- data.frame(
  Item = c("Modelo 5", "Modelo 6"),
  Descrição = c("Inclui todas as variáveis de mod3, com dummies explícitas (excluindo Spain)",
                "Inclui todas as variáveis de mod4, com dummies explícitas (excluindo Spain)"),
  AIC = c(round(AIC(mod5), 2), round(AIC(mod6), 2)),
  BIC = c(round(BIC(mod5), 2), round(BIC(mod6), 2))
)

kable(resumo_modelos,
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 6: Resumo dos Modelos 5 e 6</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 6: Resumo dos Modelos 5 e 6

Item	Descrição	AIC	BIC
Modelo 5	Inclui todas as variáveis de mod3, com dummies explícitas (excluindo Spain)	8582.95	8655.06
Modelo 6	Inclui todas as variáveis de mod4, com dummies explícitas (excluindo Spain)	8583.87	8648.76

Explicação do Processo (itens v e vi):

1. Criação das Dummies: Usamos dummy_cols() para criar explicitamente todas as dummies das variáveis categóricas Geography e Gender.
2. Exclusão da Dummy Spain: Nos modelos 5 e 6, excluímos Geography_Spain intencionalmente, tornando-a a categoria de referência para interpretação dos coeficientes.
3. Especificação dos Modelos:
   • Modelo 5: Baseado no modelo 3 (sem HasCrCard e EstimatedSalary), mas com dummies explícitas - AIC = 8582.95, BIC = 8655.06
   • Modelo 6: Baseado no modelo 4 (sem HasCrCard, EstimatedSalary e Tenure), mas com dummies explícitas - AIC = 8583.87, BIC = 8648.76
4. Interpretação: Os coeficientes na Tabela 5 mostram o efeito de ser da França ou Alemanha em comparação com a Espanha (categoria de referência).

1.5 Comparação dos Seis Modelos (itens vii a ix)

comparison_all <- data.frame(
  Modelo = c("Modelo 1", "Modelo 2", "Modelo 3", "Modelo 4", "Modelo 5", "Modelo 6"),
  AIC = c(AIC(mod1), AIC(mod2), AIC(mod3), AIC(mod4), AIC(mod5), AIC(mod6)),
  BIC = c(BIC(mod1), BIC(mod2), BIC(mod3), BIC(mod4), BIC(mod5), BIC(mod6))
)

kable(comparison_all, 
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 7: Comparação dos Seis Modelos por AIC e BIC</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50") %>%
  row_spec(which.min(comparison_all$AIC), bold = TRUE, background = "#d2d5d6") %>%
  row_spec(which.min(comparison_all$BIC), bold = TRUE, background = "#d2d5d6")

Tabela 7: Comparação dos Seis Modelos por AIC e BIC

Modelo	AIC	BIC
Modelo 1	9215.944	9273.626
Modelo 2	8585.355	8671.879
Modelo 3	8582.953	8655.056
Modelo 4	8583.866	8648.759
Modelo 5	8582.953	8655.056
Modelo 6	8583.866	8648.759

Respostas Detalhadas (itens vii a ix):

vii. Melhor modelo segundo AIC (seis modelos): Modelo Modelo 3 com AIC = 8582.9526964.

viii. Melhor modelo segundo BIC (seis modelos): Modelo Modelo 4 com BIC = 8648.7589284.

ix. Diferença entre os critérios: Sim, há diferença entre os critérios.

1.6 Probabilidades Preditas e Comparação de Dummies (itens x a xi)

# Item x: Probabilidades preditas para o melhor modelo segundo AIC
best_model_aic <- list(mod1, mod2, mod3, mod4, mod5, mod6)[[which.min(comparison_all$AIC)]]
ChurnData_dummies$pred_prob_best <- predict(best_model_aic, type = "response")

# Item xi: Modelo  - excluindo dummy male, mantendo apenas female
mod6b <- glm(Exited ~ CreditScore + Age + Balance + NumOfProducts +
               Geography_France + Geography_Germany + Gender_Female + IsActiveMember,
             family = binomial(link = "logit"), data = ChurnData_dummies)

# Comparação AIC/BIC
comparison_6_6b <- data.frame(
  Modelo = c("Modelo 6", "Modelo 6b"),
  AIC = c(AIC(mod6), AIC(mod6b)),
  BIC = c(BIC(mod6), BIC(mod6b))
)

kable(comparison_6_6b, 
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 8: Comparação entre Modelo 6 e Modelo 6b</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 8: Comparação entre Modelo 6 e Modelo 6b

Modelo	AIC	BIC
Modelo 6	8583.866	8648.759
Modelo 6b	8583.866	8648.759

# Coeficientes de gênero
coef_mod6 <- summary(mod6)$coefficients
coef_mod6b <- summary(mod6b)$coefficients

# Identificar qual dummy de gênero está presente em cada modelo
gender_coef_mod6 <- rownames(coef_mod6)[grep("Gender", rownames(coef_mod6))]
gender_coef_mod6b <- rownames(coef_mod6b)[grep("Gender", rownames(coef_mod6b))]

Respostas Detalhadas (itens x a xi):

x. Probabilidades preditas: Foram calculadas para o melhor modelo (AIC) e armazenadas na coluna ‘pred_prob_best’.

xi. Comparação Modelo 6 vs 6b:

• AIC: Modelo 6 = 8583.865865, Modelo 6b = 8583.865865.
• BIC: Modelo 6 = 8648.7589284, Modelo 6b = 8648.7589284.
• Coeficientes de gênero: - Modelo 6: Gender_Female = 0.5307 (z = 9.7437, p = 0). - Modelo 6b: Gender_Female = 0.5307 (z = 9.7437, p = 0).

Interpretação: A mudança na categoria de referência (de male para female) não altera a qualidade do modelo (AIC/BIC muito próximos), mas inverte o sinal do coeficiente. As estatísticas z e p-values são equivalentes, indicando que a escolha da categoria de referência não afeta a significância estatística.

Questão 2: Intervalos de Confiança para o Melhor Modelo (AIC)

# Identificar melhor modelo pelo AIC
best_model <- list(mod1, mod2, mod3, mod4, mod5, mod6)[[which.min(comparison_all$AIC)]]

# Calcular intervalos de confiança (95%)
conf_int_95 <- confint(best_model, level = 0.95)

# Combinar com coeficientes
coef_summary <- cbind(
  Coeficiente = coef(best_model),
  conf_int_95
)
colnames(coef_summary) <- c("Coeficiente", "IC 2.5%", "IC 97.5%")
coef_summary_rounded <- round(coef_summary, 4)

kable(coef_summary_rounded, 
      caption = paste0("<p style='text-align: center; color: black; font-weight: bold;'>Tabela 9: Intervalos de Confiança (95%) para Coeficientes - ", 
                       comparison_all$Modelo[which.min(comparison_all$AIC)], "</p>")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 9: Intervalos de Confiança (95%) para Coeficientes - Modelo 3

	Coeficiente	IC 2.5%	IC 97.5%
(Intercept)	-3.3767	-3.8408	-2.9158
CreditScore	-0.0007	-0.0012	-0.0001
Age	0.0727	0.0677	0.0778
Tenure	-0.0160	-0.0343	0.0024
Balance	0.0000	0.0000	0.0000
NumOfProducts	-0.1007	-0.1934	-0.0086
as.factor(Geography)Germany	0.7741	0.6416	0.9069
as.factor(Geography)Spain	0.0359	-0.1031	0.1738
as.factor(Gender)Male	-0.5291	-0.6361	-0.4225
IsActiveMember	-1.0754	-1.1889	-0.9629

Principais Resultados:

• Seleção de Modelos: Os critérios AIC e BIC podem apontar modelos diferentes, refletindo suas penalizações distintas pela complexidade (BIC penaliza mais).
• Dummies Categóricas: A exclusão de categorias de referência (como Spain) não altera a capacidade preditiva, apenas a interpretação dos coeficientes.
• Gênero como Variável: Quando incluímos ambas as dummies de gênero, o R remove automaticamente uma devido à multicolinearidade (dummy variable trap).
• Intervalos de Confiança: Foram calculados para o melhor modelo (AIC), permitindo inferência sobre a precisão das estimativas.

Questão 3: Análise AUC dos Seis Modelos

# Questão 3: Análise AUC

### 3.1 Cálculo da AUC para cada modelo

# Calcular probabilidades preditas para todos os modelos
ChurnData_dummies$pred_mod1 <- predict(mod1, type = "response")
ChurnData_dummies$pred_mod2 <- predict(mod2, type = "response")
ChurnData_dummies$pred_mod3 <- predict(mod3, type = "response")
ChurnData_dummies$pred_mod4 <- predict(mod4, type = "response")
ChurnData_dummies$pred_mod5 <- predict(mod5, type = "response")
ChurnData_dummies$pred_mod6 <- predict(mod6, type = "response")

# Calcular AUC para cada modelo
auc_mod1 <- roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod1)$auc
auc_mod2 <- roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod2)$auc
auc_mod3 <- roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod3)$auc
auc_mod4 <- roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod4)$auc
auc_mod5 <- roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod5)$auc
auc_mod6 <- roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod6)$auc

# Tabela de comparação AUC, AIC e BIC
comparison_auc <- data.frame(
  Modelo = c("Modelo 1", "Modelo 2", "Modelo 3", "Modelo 4", "Modelo 5", "Modelo 6"),
  AUC = round(c(auc_mod1, auc_mod2, auc_mod3, auc_mod4, auc_mod5, auc_mod6), 4),
  AIC = round(c(AIC(mod1), AIC(mod2), AIC(mod3), AIC(mod4), AIC(mod5), AIC(mod6)), 2),
  BIC = round(c(BIC(mod1), BIC(mod2), BIC(mod3), BIC(mod4), BIC(mod5), BIC(mod6)), 2)
)

kable(comparison_auc,
      caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 10: Comparação dos Modelos por AUC, AIC e BIC</p>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50") %>%
  row_spec(which.max(comparison_auc$AUC), bold = TRUE, background = "#d2d5d6") %>%
  row_spec(which.min(comparison_auc$AIC), bold = TRUE, background = "#d2d5d6") %>%
  row_spec(which.min(comparison_auc$BIC), bold = TRUE, background = "#d2d5d6")

Tabela 10: Comparação dos Modelos por AUC, AIC e BIC

Modelo	AUC	AIC	BIC
Modelo 1	0.7370	9215.94	9273.63
Modelo 2	0.7674	8585.36	8671.88
Modelo 3	0.7673	8582.95	8655.06
Modelo 4	0.7672	8583.87	8648.76
Modelo 5	0.7673	8582.95	8655.06
Modelo 6	0.7672	8583.87	8648.76

Respostas Questão 3(i a iii):

i. Medidas AUC calculadas: Ver Tabela 10 acima.

ii. Gráficos das curvas AUC: Veja abaixo.

iii. Melhor modelo segundo AUC: Modelo Modelo 2 com AUC = 0.7674.

iv. Comparação dos critérios: - Melhor AIC: Modelo Modelo 3 - Melhor BIC: Modelo Modelo 4 - Melhor AUC: Modelo Modelo 2

3.2 Gráficos das Curvas ROC

# Configurar layout dos gráficos
par(mfrow = c(2, 3), mar = c(4, 4, 2, 1))

# Função para plotar curva ROC 
plot_roc_curve <- function(model_name, pred_prob, actual, main_title) {
  roc_obj <- roc(actual, pred_prob)
  plot(roc_obj, main = main_title, col = "blue", lwd = 2,
       print.auc = TRUE, auc.polygon = FALSE, grid = TRUE,
       legacy.axes = TRUE)
  text(0.6, 0.2, paste("AUC =", round(roc_obj$auc, 4)), 
       col = "red", font = 2, cex = 0.9)
  abline(a = 0, b = 1, col = "gray", lty = 2)
}

# Plotar curvas para cada modelo
plot_roc_curve("Modelo 1", ChurnData_dummies$pred_mod1, ChurnData_dummies$Exited, "Curva ROC - Modelo 1")
plot_roc_curve("Modelo 2", ChurnData_dummies$pred_mod2, ChurnData_dummies$Exited, "Curva ROC - Modelo 2")
plot_roc_curve("Modelo 3", ChurnData_dummies$pred_mod3, ChurnData_dummies$Exited, "Curva ROC - Modelo 3")
plot_roc_curve("Modelo 4", ChurnData_dummies$pred_mod4, ChurnData_dummies$Exited, "Curva ROC - Modelo 4")
plot_roc_curve("Modelo 5", ChurnData_dummies$pred_mod5, ChurnData_dummies$Exited, "Curva ROC - Modelo 5")
plot_roc_curve("Modelo 6", ChurnData_dummies$pred_mod6, ChurnData_dummies$Exited, "Curva ROC - Modelo 6")

# Resetar layout
par(mfrow = c(1, 1))

3.3 Gráfico Comparativo das Curvas ROC

# Gráfico comparativo com todas as curvas
roc_objects <- list(
  roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod1),
  roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod2),
  roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod3),
  roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod4),
  roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod5),
  roc(ChurnData_dummies$Exited, ChurnData_dummies$pred_mod6)
)

colors <- c("red", "blue", "green", "orange", "purple", "brown")
model_names <- paste("Modelo", 1:6, "(AUC:", round(c(auc_mod1, auc_mod2, auc_mod3, auc_mod4, auc_mod5, auc_mod6), 3), ")")

plot(roc_objects[[1]], col = colors[1], lwd = 2, main = "Comparação das Curvas ROC - Todos os Modelos")
for(i in 2:6) {
  lines(roc_objects[[i]], col = colors[i], lwd = 2)
}

legend("bottomright", legend = model_names, col = colors, lwd = 2, cex = 0.8)
abline(a = 0, b = 1, col = "gray", lty = 2)
grid()

Análise Comparativa dos Critérios (Questão 3.iv):

Com base nos resultados da Tabela 10 e dos gráficos ROC, observamos:

• AIC (Critério de Informação de Akaike): Penaliza a complexidade do modelo, preferindo modelos com bom ajuste mas parcimoniosos. No nosso caso, seleciona o Modelo Modelo 3.
• BIC (Critério de Informação Bayesiano): Penaliza mais fortemente a complexidade que o AIC, tendendo a selecionar modelos mais simples. Seleciona o Modelo Modelo 4.
• AUC (Área Sob a Curva ROC): Mede a capacidade discriminatória do modelo, sem considerar a parcimônia. Seleciona o Modelo Modelo 2.

Conclusão: A escolha do “melhor” modelo depende do objetivo da análise. Para previsão, pode-se priorizar a AUC; para inferência causal e interpretabilidade, AIC ou BIC podem ser mais apropriados.

Questão 4: Odds-Ratio e Intervalos de Confiança

# Questão 4: Odds-Ratio para o melhor modelo (menor AIC)
# Identificar o melhor modelo pelo AIC
best_model_aic <- list(mod1, mod2, mod3, mod4, mod5, mod6)[[which.min(comparison_auc$AIC)]]
best_model_name <- comparison_auc$Modelo[which.min(comparison_auc$AIC)]

4.1 Estimativas de Odds-Ratio

# Calcular odds-ratio para o melhor modelo
odds_ratio_best <- exp(coef(best_model_aic))

# Criar tabela de odds-ratio
odds_ratio_table <- data.frame(
  Variável = names(odds_ratio_best),
  Coeficiente_Logit = round(coef(best_model_aic), 4),
  Odds_Ratio = round(odds_ratio_best, 4),
  Interpretação = ifelse(odds_ratio_best > 1, 
                        paste0("Aumento de ", round((odds_ratio_best-1)*100, 1), "% na chance de churn"),
                        paste0("Redução de ", round((1-odds_ratio_best)*100, 1), "% na chance de churn"))
)


odds_ratio_table_sem_intercepto <- subset(odds_ratio_table, Variável != "(Intercept)")

kable(odds_ratio_table_sem_intercepto,
      caption = paste0("<p style='text-align: center; color: black; font-weight: bold;'>Tabela 11: Odds-Ratio para o ", 
                       best_model_name, " (sem intercepto)</p>")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 11: Odds-Ratio para o Modelo 3 (sem intercepto)

	Variável	Coeficiente_Logit	Odds_Ratio	Interpretação
CreditScore	CreditScore	-0.0007	0.9993	Redução de 0.1% na chance de churn
Age	Age	0.0727	1.0754	Aumento de 7.5% na chance de churn
Tenure	Tenure	-0.0160	0.9842	Redução de 1.6% na chance de churn
Balance	Balance	0.0000	1.0000	Aumento de 0% na chance de churn
NumOfProducts	NumOfProducts	-0.1007	0.9042	Redução de 9.6% na chance de churn
as.factor(Geography)Germany	as.factor(Geography)Germany	0.7741	2.1686	Aumento de 116.9% na chance de churn
as.factor(Geography)Spain	as.factor(Geography)Spain	0.0359	1.0365	Aumento de 3.7% na chance de churn
as.factor(Gender)Male	as.factor(Gender)Male	-0.5291	0.5891	Redução de 41.1% na chance de churn
IsActiveMember	IsActiveMember	-1.0754	0.3412	Redução de 65.9% na chance de churn

4.2 Intervalos de Confiança para Odds-Ratio

# Calcular intervalos de confiança para os odds-ratio em diferentes níveis
conf_levels <- c(0.90, 0.95, 0.99)

# Função para calcular IC para odds-ratio
calculate_or_ci <- function(model, level) {
  ci_logit <- confint(model, level = level)
  ci_or <- exp(ci_logit)
  return(ci_or)
}

# Criar tabela com ICs para odds-ratio
or_ci_results <- data.frame()
for (level in conf_levels) {
  ci_or <- calculate_or_ci(best_model_aic, level)
  
  # Remover o intercepto
  ci_or_sem_intercepto <- ci_or[rownames(ci_or) != "(Intercept)", ]
  
  for (i in 1:nrow(ci_or_sem_intercepto)) {
    var_name <- rownames(ci_or_sem_intercepto)[i]
    or_ci_results <- rbind(or_ci_results, 
                           data.frame(
                             Variável = var_name,
                             Nível_Confiança = paste0(level*100, "%"),
                             OR_Inferior = round(ci_or_sem_intercepto[i, 1], 4),
                             OR_Superior = round(ci_or_sem_intercepto[i, 2], 4),
                             Intervalo = paste0("[", round(ci_or_sem_intercepto[i, 1], 3), "; ", 
                                                round(ci_or_sem_intercepto[i, 2], 3), "]")
                           ))
  }
}
kable(or_ci_results,
      caption = paste0("<p style='text-align: center; color: black; font-weight: bold;'>Tabela 12: Intervalos de Confiança para Odds-Ratio - ", 
                       best_model_name, "</p>")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")

Tabela 12: Intervalos de Confiança para Odds-Ratio - Modelo 3

Variável	Nível_Confiança	OR_Inferior	OR_Superior	Intervalo
CreditScore	90%	0.9989	0.9998	[0.999; 1]
Age	90%	1.0709	1.0800	[1.071; 1.08]
Tenure	90%	0.9691	0.9994	[0.969; 0.999]
Balance	90%	1.0000	1.0000	[1; 1]
NumOfProducts	90%	0.8366	0.9769	[0.837; 0.977]
as.factor(Geography)Germany	90%	1.9404	2.4242	[1.94; 2.424]
as.factor(Geography)Spain	90%	0.9225	1.1638	[0.922; 1.164]
as.factor(Gender)Male	90%	0.5386	0.6443	[0.539; 0.644]
IsActiveMember	90%	0.3102	0.3750	[0.31; 0.375]
CreditScore	95%	0.9988	0.9999	[0.999; 1]
Age	95%	1.0700	1.0809	[1.07; 1.081]
Tenure	95%	0.9663	1.0024	[0.966; 1.002]
Balance	95%	1.0000	1.0000	[1; 1]
NumOfProducts	95%	0.8241	0.9914	[0.824; 0.991]
as.factor(Geography)Germany	95%	1.8996	2.4766	[1.9; 2.477]
as.factor(Geography)Spain	95%	0.9020	1.1898	[0.902; 1.19]
as.factor(Gender)Male	95%	0.5294	0.6554	[0.529; 0.655]
IsActiveMember	95%	0.3045	0.3818	[0.305; 0.382]
CreditScore	99%	0.9986	1.0001	[0.999; 1]
Age	99%	1.0683	1.0826	[1.068; 1.083]
Tenure	99%	0.9607	1.0082	[0.961; 1.008]
Balance	99%	1.0000	1.0000	[1; 1]
NumOfProducts	99%	0.8004	1.0204	[0.8; 1.02]
as.factor(Geography)Germany	99%	1.8223	2.5824	[1.822; 2.582]
as.factor(Geography)Spain	99%	0.8632	1.2422	[0.863; 1.242]
as.factor(Gender)Male	99%	0.5118	0.6777	[0.512; 0.678]
IsActiveMember	99%	0.2938	0.3955	[0.294; 0.395]

4.3 Gráfico de Odds-Ratio com Intervalos de Confiança

# Preparar dados para gráfico (primeiras 8 variáveis)
plot_data <- data.frame(
  Variável = names(odds_ratio_best)[2:9],  # Excluir intercepto
  Odds_Ratio = odds_ratio_best[2:9],
  CI_95_lower = calculate_or_ci(best_model_aic, 0.95)[2:9, 1],
  CI_95_upper = calculate_or_ci(best_model_aic, 0.95)[2:9, 2]
)

# Ordenar por odds-ratio
plot_data <- plot_data[order(plot_data$Odds_Ratio), ]

# Gráfico de odds-ratio com intervalos
ggplot(plot_data, aes(x = reorder(Variável, Odds_Ratio), y = Odds_Ratio)) +
  geom_point(size = 3, color = "blue") +
  geom_errorbar(aes(ymin = CI_95_lower, ymax = CI_95_upper), 
                width = 0.2, color = "darkblue", linewidth = 0.8) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "red", linewidth = 0.8) +
  labs(title = paste("Odds-Ratio com Intervalos de Confiança 95% -", best_model_name),
       x = "Variável",
       y = "Odds-Ratio (escala log)") +
  scale_y_log10() +
  coord_flip() +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    axis.title = element_text(face = "bold"),
    panel.grid.major = element_line(color = "gray90"),
    panel.grid.minor = element_blank()
  )

Interpretação dos Resultados - Questão 4:

Com base no melhor modelo segundo o critério AIC (Modelo 3):

• Odds-Ratio (OR): Representa a mudança na razão de chances (odds) do evento (churn) para uma unidade de aumento na variável independente.
• Interpretação dos OR:
  • OR > 1: Aumenta a chance de churn
  • OR = 1: Sem efeito na chance de churn
  • OR < 1: Diminui a chance de churn
• Intervalos de Confiança:
  • Se o IC 95% não inclui 1, o efeito é estatisticamente significante ao nível de 5%
  • Intervalos mais estreitos indicam maior precisão da estimativa

Exemplos práticos: - Idade (Age) tem OR = 1.075, indicando que cada ano adicional de idade aumenta a chance de churn em 7.5%. - Ser da Alemanha (vs Espanha) tem OR = 2.169, indicando chance 2.2 vezes maior de churn.

Considerações Finais

Síntese dos Resultados das Questões 1 a 4:

1. Questão 1 - Modelos de Regressão Logística:
   • Foram estimados 6 modelos de regressão logística para prever churn de clientes.
   • Os Modelos 1-4 foram especificados progressivamente, excluindo variáveis conforme solicitado.
   • Os Modelos 5 e 6 utilizaram dummies explícitas, excluindo Geography_Spain como categoria de referência.
   • Comparação pelos critérios AIC e BIC:
     • Melhor AIC (4 modelos): Modelo 3
     • Melhor BIC (4 modelos): Modelo 4
     • Melhor AIC (6 modelos): Modelo 3
     • Melhor BIC (6 modelos): Modelo 4
   • A análise das dummies de gênero mostrou que a escolha da categoria de referência altera o sinal do coeficiente, mas não sua significância estatística.
2. Questão 2 - Intervalos de Confiança:
   • Foram calculados intervalos de confiança de 95% para os coeficientes do melhor modelo segundo AIC.
   • Os intervalos fornecem uma medida da precisão das estimativas, permitindo inferência estatística robusta.
   • Variáveis como Age e GeographyGermany apresentam intervalos afastados de zero, indicando significância estatística.
3. Questão 3 - Análise AUC e Curvas ROC:
   • As medidas AUC variaram de 0.737 a 0.767, indicando boa capacidade discriminatória.
   • Melhor modelo por AUC: Modelo 2 (AUC = 0.7674).
   • Os gráficos das curvas ROC visualizam o trade-off entre sensibilidade e especificidade para cada modelo.
   • Comparação dos critérios:
     • AIC equilibra ajuste e parcimônia
     • BIC penaliza mais a complexidade
     • AUC foca na capacidade preditiva
4. Questão 4 - Odds-Ratio e Intervalos de Confiança:
   • Foram calculados odds-ratio para o melhor modelo segundo AIC (Modelo 3).
   • Interpretação dos efeitos:
     • Age: OR = 1.075 - cada ano aumenta a chance de churn em 7.5%
     • GeographyGermany: OR = 2.169 - clientes alemães têm chance 2.2× maior de churn vs. espanhóis
   • Intervalos de confiança para odds-ratio (90%, 95%, 99%) mostram a precisão das estimativas e permitem testar significância (IC 95% que não inclui 1 indica efeito significante).

Conclusões Práticas para Gestão de Clientes:

1. Fatores Críticos de Churn: Idade avançada e localização na Alemanha são os principais preditores de churn, com efeitos estatisticamente robustos.
2. Políticas de Retenção: Focar em clientes alemães e de faixa etária mais avançada pode ser mais eficaz para reduzir churn.
3. Seleção de Modelo: A escolha entre critérios (AIC, BIC, AUC) depende do objetivo:
   • Previsão: Priorizar AUC e AIC
   • Interpretabilidade: Priorizar AIC ou BIC para modelos mais parcimoniosos
   • Inferência Causal: Considerar significância estatística e intervalos de confiança
4. Limitações e Próximos Passos: A análise poderia ser expandida com validação cruzada, interações entre variáveis e análise de não-linearidades.

Recomendação Final: Para fins de política de retenção, recomenda-se o uso do Modelo 3 (selecionado por AIC) por equilibrar capacidade preditiva e parcimônia, com atenção especial às variáveis Age e Geography em estratégias de retenção segmentada.

---

Referências Bibliográficas

FÁVERO, L. P.; BELFIORE, P. Manual de análise de dados. 2. ed. Rio de Janeiro: LTC, 2025.

HOFFMANN, R.Estatística para Economistas. 3. ed. São Paulo: Editora Pioneira, 1998.

VENABLES, W. N.; SMITH, D. M.An Introduction to R. [S.l.]: R-Project, 2015. Disponível em: https://cran.r-project.org/doc/manuals/R-intro.pdf.

XIE, Yihui; DERVIEUX, Christophe; RIEDERER, Emily.R Markdown Cookbook>. [S.l.: s.n.], 2025. Disponível em: https://bookdown.org/yihui/rmarkdown-cookbook/. Acesso em: 30 out. 2025.

WOOLDRIDGE, Jeffrey M. Introductory econometrics: a modern approach. 4. ed. Mason: Cengage Learning, 2009.