In jbkunst/risk3r: Tools for credit risk modelling

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

library(risk3r)
library(ggplot2)

theme_set(
  theme_minimal(base_size = 21) + 
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  )

if(require(showtext)){

  sysfonts::font_add_google("IBM Plex Sans", "plex")
  showtext::showtext_auto()

}

data("credit_woe")

credit_woe <- dplyr::select(risk3r::credit_woe, -id_client_woe)

dtrain <- head(credit_woe, 20000)
dtest  <- tail(credit_woe, 20000)

m <- glm(bad ~ ., family = binomial, data = dtrain)
m <- featsel_stepforward(m, scale = 5, trace = 0)

Forest (?) plot

p1 <- gg_model_coef(m, color = "darkred")
p1

Variable importance

Done via Variable Dropout Plot.

Details in ingredients::feature_importance.

p2 <- gg_model_importance(m)
p2

Other version bases on scorecads.

bins <- scorecard::woebin(credit, "bad", no_cores = 1)

gg_model_importance2(m, bins)
gg_model_importance2(m, bins, fill = "gray60", width = 0.5)

Correlations and VIF

p3 <- gg_model_corr(m)
p3

# override 
p3 +  
  ggplot2::scale_fill_viridis_c(
    name = "Cors",
    label = scales::percent,
    # limits = c(-1, 1),
    na.value = "gray90",
    # breaks = seq(-1, 1, by = 0.25)
    )

Vif plot is inspired by see:::plot.see_check_collinearity.

p4 <- gg_model_vif(m)
p4

ROC

p5 <- gg_model_roc(m, newdata = dtest, size = 2) +
  scale_color_viridis_d(begin = 0.2, end = 0.8, direction = -1, option = "B")
p5

Empirical Cumulative Distribution Function

p6 <- gg_model_ecdf(m, newdata = dtest, size = 2) +
  scale_color_viridis_d(begin = 0.2, end = 0.8, direction = -1, option = "B")
p6

# just train
p6 <- p6 +
  ggforce::facet_wrap_paginate(ggplot2::vars(.data$sample), nrow = 1, ncol = 1, page = 1) +
  theme(strip.background = element_blank(), strip.text.x = element_blank())
p6

Distributions

p7 <- gg_model_dist(m, newdata = dtest, color = "transparent", alpha = 0.4)

p7

# Just train and separate distributions
p7 +
  scale_fill_viridis_d(begin = 0.2, end = 0.8, direction = -1, option = "B") +
  ggforce::facet_wrap_paginate(
    ggplot2::vars(.data$sample, .data$actual),
    nrow = 2, ncol = 1, page = 2
    ) +
  theme(strip.background = element_blank(), strip.text.x = element_blank())

Calibration

p8 <- gg_model_calibration(m, newdata = dtest, alpha = 0.01, size = 1, color = "darkred")

p8

# only test and x = y
p8 +
  ggforce::facet_wrap_paginate(
    ggplot2::vars(.data$sample),
    nrow = 1, ncol = 1, page = 2
    ) +
  geom_abline(aes(slope = 1, intercept = 0), color = "gray70", size = 2) +
  theme(strip.background = element_blank(), strip.text.x = element_blank())

Compose and override some lables/colors

Using patchwork.

library(patchwork)

(p1 | p2 | p3) /
  (p4 | p5 | p6)

As we can see there some space we can gain

p12 <- p1 + 
  labs(caption = NULL, x = "Estimate")

p22 <- p2 +
  scale_x_discrete(breaks = "", name = NULL, limits = rev) + 
  coord_flip()

p32 <- p3 +
  scale_fill_viridis_c(
    name = "Cors",
    limits = c(-1, 1),
    label = scales::percent,
    na.value = "gray90",
    breaks = seq(-1, 1, length.out = 5),
    option = "B"
  ) +
  geom_text(aes(label = round(cor * 100)), color = "white", size = 2.5) +
  scale_x_discrete(breaks = "", name = NULL) +
  scale_y_discrete(breaks = "", name = NULL) +
  theme(legend.position = "right")

p42 <- p4 + 
  scale_x_discrete(limits = rev) +
  coord_flip() +
  theme(legend.position = "bottom") +
  labs(x = NULL, y = "VIF")

p52 <-  p5 +
  scale_color_viridis_d(
    name = "Sample",
    begin = 0.2,
    end = 0.8,
    option = "A",
    labels = stringr::str_to_title,
    ) +
  theme(legend.position = "bottom") 


p62 <- p6 +
  scale_color_viridis_d(
    name = NULL,
    begin = 0.2,
    end = 0.8,
    option = "D",
    labels =  ~ ifelse(.x == "0", "Good", "Bad")
    ) +
  labs(x = "Predicted") +
  theme(legend.position = "bottom") 

(p12 | p22 | p32) /
  (p42 | p52 | p62)