library(tidyverse)
library(rsample)
library(yardstick)
library(ranger)
library(rpart)
library(ISLR)
library(shiny)
library(kableExtra)
theme_set(theme_bw())
Introdução
A curva de ganho é uma ferramenta importante na avaliação de modelos de Aprendizado de Máquina, especialmente em aplicações como a detecção de fraude. Ela nos ajuda a entender como o modelo se comporta em diferentes níveis de cobertura da população e permite comparar o desempenho de uma busca dirigida em relação à uma busca aleatória. A curva de ganho é particularmente útil em cenários onde o desbalanceamento de classes é uma preocupação, como é comum em problemas de detecção de fraude.
Dados Default
Primeiramente, vamos carregar os pacotes necessários e um conjunto de dados como exemplo.
O conjunto de dados utilizado como exemplo é o Default
do pacote ISLR. Nesse arquivo de dados, estamos interessados em identificar os casos de default, ou seja, dos clientes que não farão o pagamento do débito do cartão de crédito.
<- ISLR::Default
df
head(df)
default student balance income
1 No No 729.5265 44361.625
2 No Yes 817.1804 12106.135
3 No No 1073.5492 31767.139
4 No No 529.2506 35704.494
5 No No 785.6559 38463.496
6 No Yes 919.5885 7491.559
Note que, como esperado nesse contexto, o banco de dados é desbalanceado. Há uma proporção muito maior de quem honrou a dívida em relação à quem não honrou a dívida (default).
%>%
df count(default) %>%
mutate(prop = n / sum(n))
default n prop
1 No 9667 0.9667
2 Yes 333 0.0333
O desbalanceamento é um desafio comum em modelos de classificação, pois pode levar a um viés na avaliação do desempenho do modelo. Isso ocorre porque a classe majoritária pode dominar a métrica de desempenho, fazendo com que o modelo pareça mais preciso do que realmente é.
Identificação dos defaults
Se você quiser identificar os defaults, você poderia selecionar alguns dados aleatoriamente e observar qual a porcentagem dos casos (lembre que foram observados 333 no total) coletados. Como estamos trabalhando com uma amostragem aleatória simples, se coletamos 70% da população, esperamos coletar 70% das fraudes e 70% das transações corretas. Assim, se quisermos coletar 50% das fraudes a partir de uma amostragem sem direcionamento, precisamos coletar 50% dos dados.
Nesse exemplo temos 10.000 observações com 333 casos de default. Se coletarmos 50% dos dados, ou seja, 5000 usuários, esperamos observar 166 defaults e 4833 pagamentos corretos, ou seja, 50% das fraudes (166 de 333) e 50% das transações corretas (4833 de 9667). A partir dessa ideia consideramos o modelo sem direcionamento, ou seja, o modelo “sem inteligência”.
A seguir você pode fazer algumas simulações com essas proporções.
#| standalone: true
#| viewerHeight: 600
library(tidyverse)
# UI
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
width = 3,
numericInput("n_samples", "Número de Replicações:", value = 1000, min = 0, max = 10000),
numericInput("proportion", "Proporção amostral (%):", value = 50, min = 0, max = 100),
actionButton("executar", "Executar")
),
mainPanel(
plotOutput("plot")
)
)
)
# Server
server <- function(input, output, session) {
observeEvent(input$executar, {
df <- ISLR::Default
total_cases <- sum(df$default == "Yes")
simulation <- reactive({
tibble(id = 1:input$n_samples) %>%
mutate(cases = map_dbl(id, ~sum(sample(df$default,
size = (input$proportion/100) * nrow(df)) == "Yes")))
})
# Gráfico principal
output$plot <- renderPlot({
simulation() %>%
ggplot(aes(100 * cases/total_cases, after_stat(density))) +
geom_histogram(color = "black", fill = "grey") +
geom_vline(xintercept = mean(100*simulation()$cases/total_cases), color = "red", linewidth = 1.3, linetype = 2) +
labs(x = "proporção das fraudes observadas (%)",
y = "densidade",
title = paste0("Média da proporção das fraudes observadas: ", round(mean(100*simulation()$cases/total_cases), 1),
"%\nMédia de casos observados:", round(mean(simulation()$cases, 1)),
"\nTotal de casos:", total_cases)) +
theme_bw()
})
})
}
# Executar o aplicativo Shiny
shinyApp(ui, server)
Nesse ponto, deve estar claro que a proporção de casos identificados de acordo com a proporção dos dados coletada deve ter esse formato:
No eixo x temos a porcentagem da população observada/testada e no eixo y a porporção de defaults encontrada.
Modelo Preditivo
Vamos considerar uma floresta aleatória para identificar os casos de default. Inicialmente, separaremos os dados em treinamento e teste e faremos o ajuste do modelo.
set.seed(1)
<- initial_split(df, prop = .7, strata = "default")
splits
<- training(splits)
tr <- testing(splits)
test
<- rpart(default ~ ., data = tr)
tree
<- ranger(default ~ ., probability = TRUE, data = tr) rf
Curva de Ganho
Uma situação ideal de classificação seria ordenar os dados de acordo com a probabilidade de default
probabilidade | default | found | tested |
---|---|---|---|
0.95 | 1 | 25 | 10 |
0.90 | 1 | 50 | 20 |
0.84 | 1 | 75 | 30 |
0.82 | 1 | 100 | 40 |
0.80 | 0 | 100 | 50 |
0.70 | 0 | 100 | 60 |
0.60 | 0 | 100 | 70 |
0.50 | 0 | 100 | 80 |
0.40 | 0 | 100 | 90 |
0.30 | 0 | 100 | 100 |
Note que os casos de default estão perfeitamente separados dos casos de não default e com maiores probabilidades. Essa situação seria o que chamamos de modelo ótimo. Já uma situação intermediária seria dada por
probabilidade | churn | found | tested |
---|---|---|---|
0.95 | 1 | 33.33333 | 10 |
0.90 | 0 | 33.33333 | 20 |
0.84 | 1 | 66.66667 | 30 |
0.82 | 1 | 100.00000 | 40 |
0.80 | 0 | 100.00000 | 50 |
0.70 | 0 | 100.00000 | 60 |
0.60 | 0 | 100.00000 | 70 |
0.50 | 0 | 100.00000 | 80 |
0.40 | 0 | 100.00000 | 90 |
0.30 | 0 | 100.00000 | 100 |
Note que agora, para as maiores probabilidades, não temos uma separação perfeita, ou seja, temos casos de default e não default misturados.
Para interpretação, a curva de ganho colocará o nosso modelo entre dois extremos:
modelo sem direcionamento: como explicado anteriormente, ou seja, um modelo sem inteligência, que buscará aleatoriamente e
modelo ótimo: esse modelo indicaria que a ordenação da probabilidade de forma descrescente separaria perfeitamente os casos de default dos casos de não default.
Para obter a curva de ganho, podemos utilizar a função gain_curve
do pacote yardstick.
tibble(probabilidade = predict(rf, test)$predictions[,2],
default = test$default) %>%
gain_curve(default, probabilidade, event_level = "second") %>%
autoplot() +
geom_vline(xintercept = 100 * mean(test$default == "Yes"),
linetype = 2, color = "red") +
annotate("text",
x = 100 * mean(test$default == "Yes") + 3,
y = 20,
label = "incidência",
color = "red",
angle = -90)
Caso se queira avaliar o desempenho de dois modelos, podemos considerar
tibble(probabilidade = predict(rf, test)$predictions[,2],
default = test$default,
model = "random forest") %>%
bind_rows(tibble(probabilidade = predict(tree, test)[,2],
default = test$default,
model = "tree")) %>%
group_by(model) %>%
gain_curve(default, probabilidade, event_level = "second") %>%
autoplot() +
scale_linewidth_manual(values = 4) +
theme(legend.position = c(.8, .25))
Interpretação dos Resultados
A curva de ganho mostra a eficácia do modelo em identificar os casos de default em diferentes proporções da população. Uma curva mais acima e à esquerda indica um modelo mais eficiente. Neste exemplo, podemos observar que o modelo tem um desempenho melhor do que a seleção sem direcionamento (parte inferior sombreada, definida pela reta \(y = x\)), especialmente nas primeiras frações da população.
A interpretação da curva de ganho é intuitiva: quanto mais a curva se afasta da linha de base (seleção sem direcionamento), maior é a capacidade do modelo de identificar corretamente os casos positivos (defaults, neste contexto). Isso é particularmente importante em aplicações como detecção de fraude, onde identificar corretamente os casos positivos pode ter um impacto significativo na redução de perdas financeiras.
Conclusão
A curva de ganho é uma ferramenta útil para avaliar modelos de detecção de eventos/casos, permitindo que os analistas identifiquem rapidamente a eficácia do modelo em capturar casos de fraude em diferentes níveis de cobertura da população. É importante ressaltar que, embora a curva de ganho seja uma métrica valiosa, ela não deve ser usada isoladamente. Outras métricas e considerações contextuais devem ser levadas em conta para uma avaliação abrangente do desempenho do modelo.