In ViniciusJacobs/analisecredito: What the Package Does (One Line, Title Case)

knitr::opts_chunk$set(echo = TRUE)

Análise de Perfil: Concessão de Crédito

Objetivo

Extrair informações da base fornecida;
Apresentar as caracteristicas demograficas e financeiras dos clientes presentes na base de dados;
Identificar entre as variáveis do modelo, quais explicam um cliente ser bom ou ruim.
Elaborar um modelo de previsão para o problema de negócio.

Pacotes utilizados

library(tidyverse)
library(tidyr)
library(patchwork)
library(caret)
library(randomForest)
library(ROCR)
devtools::load_all()

Etapa 1: Análise Exploratória dos Dados

Leitura do data.frame e visualização das variáveis

df_credito <- read_rds("data/credito.rds")
glimpse(df_credito)

Identificar valores NA's no modelo e formas tratalos

titulos_col <- df_credito %>%
  names

for(i in 1:length(titulos_col)){
 x <- contagem_nas(df_credito, titulos_col[i])[[1]]
  if(x>0){
   print(titulos_col[i])
   print(x)
  }

}

O que fazer com os NA's do modelo? Eles estão em variáveis que explicam a variável alvo? São muitos os NA's?

As variáveis moradia, estado_civil e trabalho, apresentaram um número de NA's pouco expressivo (menos de 1% do número de obs.), a situação NA foi considerada como ERRO no cadastro. Para esse estudo não foi feita análise, mas sim a alteração dos campos NA's para "indefinido".

df_credito_ajustado <- df_credito%>%
  tidyr::replace_na(replace = list(moradia = "indefinido",
                                   estado_civil = "indefinido",
                                   trabalho = "indefinido"))

grafico_rel_renda <- df_credito_ajustado %>%
  filter(!is.na(renda)) %>%
  ggplot() +
  aes(x = status, y = log(renda)) +
  geom_boxplot(fill = "#0c4c8a")+
  labs( title = "Renda x Status",
        x = "Status",
        y = "Renda")+
  theme_gray()+
  theme(
    legend.position = "right",
    plot.title = element_text(
      hjust = 0.5
    )
  )


grafico_rel_ativos <- df_credito_ajustado %>%
  filter(!is.na(ativos)) %>%
  ggplot() +
  aes(x = status, y = log(ativos)) +
  geom_boxplot(fill = "#0c4c8a")+
  labs( title = "Ativos x Status",
        x = "Status",
        y = "Ativos")+
  theme_gray()+
  theme(
    legend.position = "right",
    plot.title = element_text(
      hjust = 0.5
    )
  )

grafico_rel_dividas <- df_credito_ajustado %>%
  filter(!is.na(dividas)) %>%
  ggplot() +
  aes(x = status, y = log(dividas)) +
  geom_boxplot(fill = "#0c4c8a")+
  labs( title = "Dividas x Status",
        x = "Status",
        y = "Dividas")+
  theme_gray()+
  theme(
    legend.position = "right",
    plot.title = element_text(
      hjust = 0.5
    )
  )

As variáveis renda, ativos e dívidas, foram objeto de análise, gráfica, conforme abaixo:

```` {r warning=FALSE}

grafico_rel_renda + grafico_rel_dividas + grafico_rel_ativos

__Retirada dos NA's__

__A análise visual dos dados, nos mostra que ambas variáveis tem distribuição próxima a média para o status, "Bom" ou "Ruim".__

__Optei pela retirada dos NA's e inclusão da média para variável.__
```r


  df_credito_ajustado <- df_credito_ajustado %>%
  replace_na(replace = list(renda = mean(df_credito_ajustado$renda, na.rm = TRUE),
                            ativos = mean(df_credito_ajustado$ativos, na.rm = TRUE),
                            dividas = mean(df_credito_ajustado$dividas, na.rm = TRUE)))

Etapa 2: Caracteristicas demograficas e financeiras dos clientes presentes na base de dados.

Na etapa inicial, foi realizada analise gráfica e o mapeamento de algumas variáveis, conforme abaixo:

Buscando compreender um pouco mais sobre quem foram meus clientes no passado, montei gráficos para IDADE(por faixa etária), tempo de empresa (também por faixas) e distribuição de bons e ruins clientes.

df_credito_ajustado <- df_credito_ajustado %>%
  mutate(faixa_etaria = case_when(idade<=25 ~ "1.Abaixo dos 25 anos",
                                  idade<=35 ~ "2.Entre 26 e 35 anos",
                                  idade<=45 ~ "3.Entre 36 e 45 anos",
                                  idade<=55 ~ "4.Entre 46 e 55 anos",
                                  idade>55 ~"5.Acima dos 55 anos")) %>%
  relocate(faixa_etaria, .after = idade)

df_credito_ajustado <- df_credito_ajustado %>%
  mutate(faixa_tempo_empresa = case_when(tempo_empresa<=2 ~ "1. Abaixo dos 2 anos",
                                  tempo_empresa <= 4 ~ "2. Entre 3 e 4 anos",
                                  tempo_empresa <= 6 ~ "3. Entre 5 e 6 anos",
                                  tempo_empresa <= 8 ~ "4. Entre 7 e 8 anos",
                                  tempo_empresa <= 10 ~ "5. Entre 9 e 10 anos",
                                  tempo_empresa<=15 ~ "6. Entre 11 e 15 anos",
                                  tempo_empresa<=20 ~ "7. Entre 16 e 20 anos",
                                  tempo_empresa<=25 ~ "8. Entre 21 e 25 anos",
                                  tempo_empresa<=36 ~ "9. Entre 26 e 35 anos",
                                  tempo_empresa>36 ~"Acima dos 36 anos")) %>%
  relocate(faixa_tempo_empresa, .after = tempo_empresa)

tab_faixa_tempoempre <-  df_credito_ajustado %>%
    group_by(faixa_tempo_empresa, status) %>% 
    summarise(contagem = n()) %>% 
    arrange(desc(faixa_tempo_empresa)) %>% 
    spread(status, contagem) %>%
    mutate(prop.bons.ruins = bom/ruim)



 tab_faixa_etaria <- df_credito_ajustado %>%
  group_by(faixa_etaria, status) %>% 
  summarise(contagem = n()) %>% 
  arrange(desc(faixa_etaria)) %>% 
  spread(status, contagem) %>%
  mutate(prop.bons.ruins = bom/ruim)

dist_por_perfil <- grafico_status <- ggplot()+
  aes(x = df_credito_ajustado$status)+
  geom_bar(width = 0.3, fill = "#0c4c8a")+
  labs( title = "Perfil: Bom x Ruim",
        x = "Perfil",
        y = "Quantidade")+
  theme_gray()+
  theme(
    legend.position = "right",
    plot.title = element_text(
      hjust = 0.5
    )
  )

dist_por_faixa_eta <- grafico_faixa_etaria <- ggplot()+
  aes(x = df_credito_ajustado$faixa_etaria)+
  geom_bar(width = 0.5, fill = "#0c4c8a")+
  coord_flip()+
  labs( title = "Perfil Etário",
        x = "Faixa Etária",
        y = "Quantidade")+
  theme_gray()+
  theme(
    legend.position = "right",
    plot.title = element_text(
      hjust = 0.5
    ))

grafico_estado_civil <- df_credito_ajustado %>%
  filter(estado_civil != "indefinido") %>% 
  ggplot()+
  aes(x = estado_civil)+
  geom_bar(width = 0.5, fill = "#0c4c8a")+
  labs( title = "Estado Civil",
        x = "Situação",
        y = "Quantidade")+
  theme_gray()+
  theme(
    axis.text.x = element_text(angle=35, hjust=1, size = 11),
    legend.position = "right",
    plot.title = element_text(
      hjust = 0.5
    )
  )



tab_estado_civ <- df_credito_ajustado %>%
  group_by(estado_civil, status) %>%
  summarise(contagem = n()) %>%
  arrange(desc(estado_civil)) %>%
  spread(status, contagem) %>%
  mutate(prop.bons.ruins = bom/ruim) %>% 
  filter(!is.na(prop.bons.ruins)) %>% 
  arrange(prop.bons.ruins)

 ggplot(tab_estado_civ) +
   aes(x = estado_civil, weight = prop.bons.ruins) +
   geom_bar(width = 0.5, fill = "#0c4c8a") +
   coord_flip()+
   labs( title = "Bons Pagadores: (+) Tempo de Empresa ",
         x = "Tempo de Empresa",
         y = "Proporção: Bons/Ruins")+
   theme_gray()+
   theme(
     legend.position = "right",
     plot.title = element_text(
       hjust = 0.5
     ))

dist_por_perfil + grafico_estado_civil + dist_por_faixa_eta

Por fim, quiz checar dentre essas variáveis qual a proporção entre os clientes Bons e Ruins

df_credito_ajustado <- df_credito_ajustado %>%
  mutate(faixa_etaria = case_when(idade<=25 ~ "1.Abaixo dos 25 anos",
                                  idade<=35 ~ "2.Entre 26 e 35 anos",
                                  idade<=45 ~ "3.Entre 36 e 45 anos",
                                  idade<=55 ~ "4.Entre 46 e 55 anos",
                                  idade>55 ~"5.Acima dos 55 anos")) %>%
  relocate(faixa_etaria, .after = idade)

df_credito_ajustado <- df_credito_ajustado %>%
  mutate(faixa_tempo_empresa = case_when(tempo_empresa<=2 ~ "1. Abaixo dos 2 anos",
                                  tempo_empresa <= 4 ~ "2. Entre 3 e 4 anos",
                                  tempo_empresa <= 6 ~ "3. Entre 5 e 6 anos",
                                  tempo_empresa <= 8 ~ "4. Entre 7 e 8 anos",
                                  tempo_empresa <= 10 ~ "5. Entre 9 e 10 anos",
                                  tempo_empresa<=15 ~ "6. Entre 11 e 15 anos",
                                  tempo_empresa<=20 ~ "7. Entre 16 e 20 anos",
                                  tempo_empresa<=25 ~ "8. Entre 21 e 25 anos",
                                  tempo_empresa<=36 ~ "9. Entre 26 e 35 anos",
                                  tempo_empresa>36 ~"Acima dos 36 anos")) %>%
  relocate(faixa_tempo_empresa, .after = tempo_empresa)

tab_faixa_tempoempre

tab_faixa_etaria

tab_faixa_tempoempre <-  df_credito_ajustado %>%
    group_by(faixa_tempo_empresa, status) %>%
    summarise(contagem = n()) %>%
    arrange(desc(faixa_tempo_empresa)) %>%
    spread(status, contagem) %>%
    mutate(prop.bons.ruins = bom/ruim) 



tab_estado_civ <- df_credito_ajustado %>%
  group_by(estado_civil, status) %>%
  summarise(contagem = n()) %>%
  arrange(desc(estado_civil)) %>%
  spread(status, contagem) %>%
  mutate(prop.bons.ruins = bom/ruim) %>% 
  filter(!is.na(prop.bons.ruins)) %>% 
  arrange(prop.bons.ruins)


tab_faixa_etaria <- df_credito_ajustado %>%
  group_by(faixa_etaria, status) %>%
  summarise(contagem = n()) %>%
  arrange(desc(faixa_etaria)) %>%
  spread(status, contagem) %>%
  mutate(prop.bons.ruins = bom/ruim)


prop.faixa.et <- ggplot(tab_faixa_etaria) +
  aes(x = faixa_etaria, weight = prop.bons.ruins) +
  geom_bar(width = 0.4, fill = "#0c4c8a") +
  coord_flip()+
  labs( title = "Bons Pagadores: Maior faixa etária",
        x = "Tempo de Empresa",
        y = "Proporção: Bons/Ruins")+
  theme_gray()+
  theme(
    legend.position = "right",
    plot.title = element_text(
      hjust = 0.5
    ))

prop.tempo.emp <- ggplot(tab_faixa_tempoempre) +
   aes(x = faixa_tempo_empresa, weight = prop.bons.ruins) +
   geom_bar(width = 0.6, fill = "#0c4c8a") +
   coord_flip()+
   labs( title = "Bons Pagadores: (+) Tempo de Empresa ",
         x = "Tempo de Empresa",
         y = "Proporção: Bons/Ruins")+
   theme_gray()+
   theme(
     legend.position = "right",
     plot.title = element_text(
       hjust = 0.5
     ))


prop.est.civi <- ggplot(tab_estado_civ) +
   aes(x = estado_civil, weight = prop.bons.ruins) +
   geom_bar(width = 0.3, fill = "#0c4c8a") +
   labs( title = "Bons Pagadores: Estado Civil ",
         x = "Tempo de Empresa",
         y = "Proporção: Bons/Ruins")+
   theme_gray()+
   theme(
     legend.position = "right",
     plot.title = element_text(
       hjust = 0.5
     ))

prop.faixa.et

prop.tempo.emp

prop.est.civi

3: Elaborar modelo preditivo para o modelo

df_credito_ajustado <- df_credito_ajustado %>%
  mutate(status_bin = case_when(status == "bom" ~ 1,
                                status == "ruim" ~ 0)) %>%
  relocate(status_bin, .after = status)

df_credito_ajustado_previ <- df_credito_ajustado %>% 
  relocate(status_bin, .before = status) %>% 
  select(-status) %>% 
  filter(estado_civil != "indefinido")

Quando iniciei essa etapa a primeira coisa que percebi é que a limpeza/tratamento que havia dado ao modelo no início do projeto não eram suficientes para agora eu trabalhar com um modelo de regressão logística. Então mais um poquinho de tratamento aos dados...

# Normalizando as variáveis

numeric.vars <- c("tempo_empresa", "tempo_emprestimo", "idade",
                  "despesas","renda","ativos","dividas", "valor_emprestimo","preco_do_bem")


df_credito_ajustado_previ <- scale.features(df_credito_ajustado_previ, numeric.vars)

#Variáveis tipo Fator
categorical.vars <- c('status_bin', 'faixa_tempo_empresa', 'faixa_etaria',
                      'estado_civil', 'trabalho', "moradia","registros")

df_credito_ajustado_previ <- to.factors(df = df_credito_ajustado_previ, variables = categorical.vars)


glimpse(df_credito_ajustado_previ)

Divisão do data.frame em treino e teste

#60:40
indexes <- sample(1:nrow(df_credito_ajustado_previ), size = 0.6 * nrow(df_credito_ajustado_previ))
train.data <- df_credito_ajustado_previ[indexes,]
test.data <- df_credito_ajustado_previ[-indexes,]

Avaliando as variáveis que mais explicam o modelo

rfe.results <- run.feature.selection(feature.vars = train.data[,-1],
                                 class.var = train.data[,1])

#Visualizando os resultados
rfe.results
varImp((rfe.results))

As variáveis que apresentaram maior relação explicativa a relação bom ou ruim pagador (conforme esse modelo) são:

-registros

-trabalho

-tempo_empresa

-renda

-valor-emprestimo

Na análise descritiva realizada no início do estudo foram avaliadas faixa etária, tempo de trabalho na empresa e estado civil. Nota-se, que somente o tempo de empresa dentre as variáveis, consta na lista das 5 mais explicativas.

Isso reforça a ideia de que devemos trabalhar com dados

Nessa próxima etapa, construi o modelo inicial

## Separando as variáveis
test.feature.vars <- test.data[,-1]
test.class.var <- test.data[,1]

# Construindo um modelo de regressão logística
formula.init <- "status_bin ~ ."
formula.init <- as.formula(formula.init)
lr.model <- glm(formula = formula.init, data = train.data, family = "binomial")

# Visualizando o modelo
summary(lr.model)

Testando o modelo nos dados inicial e avaliando a ConfusionMatrix

lr.predictions <- predict(lr.model, test.data, type="response")
lr.predictions <- round(lr.predictions)

confusionMatrix(table(data = lr.predictions, reference = test.class.var), positive = '1')

A matrix de confusao mostra que o modelo está acertando muito mais que errando

Esse resultado está alinhado com o apurado para Accuracy, que é relativamente alto

Em um primeiro momento poderiamos dizer o que o modelo está com um bom nível de Accuracy, mas dá pra melhorar?

#selecionar as melhores variáveis
formula <- "status_bin ~ ."
formula <- as.formula(formula)
control <- trainControl(method = "repeatedcv", number = 10, repeats = 2)
model <- train(formula, data = train.data, method = "glm", trControl = control)
importance <- varImp(model, scale = FALSE)
plot(importance)

Contrstuindo um novo modelo com variáveis selecionadas

formula.new <- "status_bin ~ registros + valor_emprestimo + renda + trabalho + preco_do_bem + moradia + estado_civil + ativos + despesas + dividas + tempo_empresa"
formula.new <- as.formula(formula.new)
lr.model.new <- glm(formula = formula.new, data = train.data, family = "binomial")
glimpse(df_credito_ajustado_previ)

summary(lr.model.new)

Testando o modelo

# Testando o modelo nos dados de teste
lr.predictions.new <- predict(lr.model.new, test.data, type = "response") 
lr.predictions.new <- round(lr.predictions.new)

Avaliando a matrix de confusão e mudança na Accuracy

confusionMatrix(table(data = lr.predictions.new, reference = test.class.var), positive = '1')

Com base na Accuracy conclui que devemos utilizar o segundo modelo, embora seja pequena a mudança de um para o outro

Para concluir, foi apresentado a Curva de ROC no gráfico abaixo:

# Criando curvas ROC
lr.model.best <- lr.model
lr.prediction.values <- predict(lr.model.best, test.feature.vars, type = "response")
predictions <- prediction(lr.prediction.values, test.class.var)
par(mfrow = c(1,2))
plot.roc.curve(predictions, title.text = "Curva ROC")
plot.pr.curve(predictions, title.text = "Curva Precision/Recall")