Probability of Default Rating Modeling with R

Comprehensive overview of the modeling processes, principles, and designs

Andrija Djurovic
Contents
Preface 1

1 Introduction to R 3
1.1 R objects . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 5
1.2 Data import . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 9
1.3 Data manipulation and aggregation . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10
1.4 Data export . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 13
1.5 Sampling . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 14
1.6 Linear and logistic regression . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16
1.7 Loops . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18
1.8 User-defined functions . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19

2 Variable types and measurement scales 21

3 Ranking model development 23

3.1 Modeling datasets . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 23
3.2 Univariate analysis . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30
3.3 Bivariate analysis . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 42
3.3.1 Statistical and expert binning of numeric risk factors . . . . . . . . . . . . . . 42
[Link] Monotonic binning . . . . . . . . . . . . . . . . . . . . . . . . . . . . 43
[Link] U-shape binning . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 59
3.3.2 Statistical and expert binning of categorical risk factors . . . . . . . . . . . . 63
3.3.3 Risk factor standalone discriminatory power analysis . . . . . . . . . . . . . . 65
3.3.4 Risk factor stability analysis . . . . . . . . . . . . . . . . . . . . . . . . . . . 68
3.3.5 Risk factor correlation analysis . . . . . . . . . . . . . . . . . . . . . . . . . . 71
3.4 Multivariate analysis . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 76
3.4.1 Blockwise (modular) variable selection . . . . . . . . . . . . . . . . . . . . . . 87
[Link] Staged blocks . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 88
[Link] Embedded blocks . . . . . . . . . . . . . . . . . . . . . . . . . . . . 91
[Link] Ensemble blocks . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 95
3.4.2 Blockwise approach with different development samples . . . . . . . . . . . . 98
3.4.3 Analysis of discriminatory power . . . . . . . . . . . . . . . . . . . . . . . . . 107
3.4.4 Rating scale . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 114

4 Ranking model calibration 125

5 Ranking model uncertainty 134

5.1 Bootstrap method . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 134
5.2 Conformal inference . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 147
6 Margin of conservatism 170

7 Periodic model validation 189

7.1 PD model structure . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 195
7.2 Review of estimates . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 199
7.3 Margin of conservatism challengers . . . . . . . . . . . . . . . . . . . . . . . . . . . . 202

8 Fairness analysis 205

9 Machine learning support for the ranking model development 222

9.1 Case study 1: Machine learning for risk factor engineering . . . . . . . . . . . . . . . 222
9.2 Case study 2: Risk factor selection and non-linearity identification with model challenger241
9.3 Case study 3: Two-stage modeling approach . . . . . . . . . . . . . . . . . . . . . . . 249

Appendix 253

Bibliography 258
Preface
Credit risk refers to the potential loss incurred when borrowers fail to make payments on their
debts. This book focuses on a Probability of Default (PD) rating modeling, widely considered a
cornerstone of credit risk.

The motivation for writing this book arises from two primary factors. Firstly, despite the
substantial increase in the number of books and articles over the last decade, significant
misalignment continues to exist between practical application and academic research. Secondly,
recent progress in analytics and technology has seemingly shifted the focus in credit risk towards
tools, sometimes neglecting the fundamental principles and objectives of the modeling process.
Conversations surrounding programming languages and algorithms can overshadow the crucial task
of capturing and addressing the most important business inputs within the model.

Following the motivation, this book offers an overview of the critical steps in developing
and validating a probability of default models. Moreover, it presents practical examples that aim to
guide readers through the entire modeling process, with a particular emphasis on design rather
than focusing solely on statistical methods. These examples aim to equip and inspire readers to
design a tailored approach that aligns with their specific model’s implementation environment.
Although the book demonstrates the exercises in the statistical package R, the tool should not
be in the foreground. Rather than emphasizing the code itself, we encourage readers to adopt a
process-oriented perspective when approaching the code. This approach enables readers to replicate
the same or similar designs using their preferred software. While the book primarily emphasizes
the modeling processes within the banks with Internal Rating Based Models (IRB banks), it is
essential to note that the described methods are not limited solely to them. The methods can be
extended and applied to non-IRB banks as well. Readers and practitioners are encouraged to se-
lect and implement the chapters that best suit their specific use cases, focusing on managerial models.

If the book presents functions without explicit explanations or sufficient details, readers
can refer to the specific R packages in which these functions originate. In particular, the monobin
and PDtoolkit packages contain most of these functions.
The following code node details the R session used for the book development.
sessionInfo()

## R version 4.3.2 (2023-10-31 ucrt)

## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19045)
##
## Matrix products: default
##

1
##
## locale:
## [1] LC_COLLATE=English_United States.utf8
## [2] LC_CTYPE=English_United States.utf8
## [3] LC_MONETARY=English_United States.utf8
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United States.utf8
##
## time zone: Europe/Budapest
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] rpart_4.1.21 data.table_1.14.10 PDtoolkit_1.2.1 monobin_0.2.4
## [5] Hmisc_5.1-1 dplyr_1.1.4 knitr_1.45 rmarkdown_2.25
##
## loaded via a namespace (and not attached):
## [1] gtable_0.3.4 compiler_4.3.2 tidyselect_1.2.0 htmlTable_2.4.2
## [5] stringr_1.5.1 gridExtra_2.3 cluster_2.1.4 scales_1.3.0
## [9] yaml_2.3.7 fastmap_1.1.1 ggplot2_3.4.4 R6_2.5.1
## [13] generics_0.1.3 Formula_1.2-5 htmlwidgets_1.6.4 backports_1.4.1
## [17] checkmate_2.3.1 tibble_3.2.1 munsell_0.5.0 nnet_7.3-19
## [21] pillar_1.9.0 rlang_1.1.2 utf8_1.2.4 stringi_1.8.2
## [25] xfun_0.41 cli_3.6.1 magrittr_2.0.3 digest_0.6.33
## [29] grid_4.3.2 rstudioapi_0.15.0 base64enc_0.1-3 lifecycle_1.0.4
## [33] vctrs_0.6.5 evaluate_0.23 glue_1.6.2 fansi_1.0.6
## [37] colorspace_2.1-0 foreign_0.8-85 tools_4.3.2 pkgconfig_2.0.3
## [41] htmltools_0.5.7

About the author: Andrija Djurovic is a credit risk professional with over ten years of experience in
credit risk modeling. His expertise encompasses modeling Probability of Default, Loss Given Default,
Exposure At Default, the development of scoring models, macroeconomic modeling, and portfolio
analysis. With comprehensive statistical knowledge spanning academia to industry, his proficiency
extends to crafting tailored analytics applications. Notably, Andrija is the author and developer of
essential R (monobin, monobinShiny, PDtoolkit, LGDtoolkit) and Python (monobinpy) packages
tailored for credit risk modeling.
To learn more, visit his LinkedIn profile at [Link]/in/andrija-djurovic, github page at
[Link] or connect directly through email at djandrija@[Link].

2
1 Introduction to R
According to [Link], R is a language and environment for statistical computing and graphics.
As an environment within which statistical techniques are implemented, R is often used as a data
analysis and statistical software tool. R runs on various UNIX platforms, Windows, and MacOS,
and its installation file can be downloaded from [Link] The functionality of R
can be easily extended through packages. Several specific packages come pre-installed with the base
R distribution, and a vast collection of additional packages is available through the CRAN family of
Internet sites, encompassing a wide range of modern statistical methods.

The R GUI consists of two essential elements: the console and scripts.

R console:

3
R script:

R can be used as a calculator, and the main mathematical operators are: +, -, /, and *.
3 + 3

## [1] 6
5 * 5

## [1] 25

The main relational operators in R are == (equal), != (not equal), > (greater), >= (greater or equal),
< (less), <= (less or equal). Along with the relational operators, other commonly used operators are
& (and) and | (or).
5 >= 10

## [1] FALSE
5 < 10

## [1] TRUE
3 < 10 & 10 > 15

## [1] FALSE
3 < 10 | 10 > 15

## [1] TRUE

Packages in R are a set of functions, compiled code, and sample data. By default, R comes with
a group of packages that become available after software installation. These default packages are

4
automatically accessible upon starting the R environment. To utilize functions and procedures
from a package that is not part of the base R configuration, the first step is to install the de-
sired package. The most common method to install an R package is by executing the command
[Link]("name of the package"). Once the package is successfully installed, it needs
to be loaded into the R environment using the library command. Loading the package makes its
functionalities accessible within the current working environment.

To access the help page for any base R or package-specific function, users can run the corresponding
command using a question mark (?) followed by the function’s name. For example, ?[Link]
would display the help page for the [Link] function.

1.1 R objects
R is an object-oriented programming language that supports various object types, including vectors,
factors, matrices, data frames, and lists. The base R distribution includes essential functions for
creating these objects, eliminating the need for additional packages.
Users can print each object in the console or assign it to another object. To assign specific values to
the object, users can utilize <- or =. Although both methods usually yield the same result, in this
book, we adopt the <- sign as the standard way for consistency.

To manually assign values to a vector, we use the c() function. Vectors in R can be of different
types, such as numeric, categorical, or logical.
#numeric vector
c(1, 2, 3, 4, 5)

## [1] 1 2 3 4 5
1:5

## [1] 1 2 3 4 5
#categorical (character) vector
c("a", "b", "c")

## [1] "a" "b" "c"

#logical vector
c(TRUE, FALSE)

## [1] TRUE FALSE

Factors represent specific types of R objects commonly utilized for categorical data. The key feature
of a factor is its ability to use a predetermined set of values (referred to as levels) and sort them
based on a preferred order. Users commonly apply factors in scenarios involving data aggregation
and regression modeling, where a specific sorting of the levels is required.

5
In the following example, we illustrate using the order argument in the factor function to determine
the arrangement of vectors’ levels. The initial sorting is performed alphabetically, while the second
example showcases a user-defined specific order.
#define months
mnts <- c("January", "February", "March", "April", "May", "June", "July",
"August", "September", "October", "November", "December")
#alphabetic order
sort(mnts)

## [1] "April" "August" "December" "February" "January" "July"

## [7] "June" "March" "May" "November" "October" "September"
#user-defined order
mnts.f <- factor(x = mnts,
levels = mnts,
order = TRUE)
sort(mnts.f)

## [1] January February March April May June July

## [8] August September October November December
## 12 Levels: January < February < March < April < May < June < ... < December

Matrices are two-dimensional R objects that store numerical data, organized into rows and columns.
mat <- matrix(data = 1:6,
ncol = 3,
byrow = TRUE)
mat

## [,1] [,2] [,3]

## [1,] 1 2 3
## [2,] 4 5 6

The data frame is the most frequently encountered object type in R. Moreover, it is a two-dimensional
structure capable of storing a combination of various data types. For instance, it can accommodate
numeric values in one column and categorical values in another.
[Link](x1 = c(1:5), x2 = LETTERS[seq(1, 20, by = 4)])

## x1 x2
## 1 1 A
## 2 2 E
## 3 3 I
## 4 4 M

6
## 5 5 Q

Lists are the most versatile R objects, capable of combining different object types into a single entity.
In this book, we will primarily utilize lists to store the results of various procedures in one object.
list(a = c(letters[1:5]), b = matrix(data = 1:12, ncol = 4))

## $a
## [1] "a" "b" "c" "d" "e"
##
## $b
## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

We usually use square brackets [ ] to access elements of any of these objects. However, it is crucial
to remember that different objects possess varying dimensions, which requires careful consideration
when accessing their elements. For example, vectors and factors have a length, but factors also
include levels. On the other hand, matrices and data frames have two dimensions: rows and columns,
while lists have a length, and each element within the list can have distinct dimensions. Additionally,
data frames and lists can be accessed using the dollar sign ($) notation to retrieve specific column
or list element.
#define numeric vector x
x <- 1:6
x

## [1] 1 2 3 4 5 6
#extract the first 3 elements of the vector x
x[1:3]

## [1] 1 2 3
#count number of elements of the vector x
length(x)

## [1] 6
#define data frame DF
DF <- [Link](x1 = c(1:5),
x2 = LETTERS[seq(from = 1, to = 20, by = 4)])
DF

## x1 x2

7
## 1 1 A
## 2 2 E
## 3 3 I
## 4 4 M
## 5 5 Q
#print dimensions of the data frame DF
dim(DF)

## [1] 5 2
#extract the first row
DF[1, ]

## x1 x2
## 1 1 A
#the second column (index subsetting)
DF[, 2, drop = FALSE]

## x2
## 1 A
## 2 E
## 3 I
## 4 M
## 5 Q
#column x2 (name subsetting)
DF[, "x2", drop = FALSE]

## x2
## 1 A
## 2 E
## 3 I
## 4 M
## 5 Q
#extract the rows where x1 is greater than 3
DF[DF$x1 > 3, ]

## x1 x2
## 4 4 M
## 5 5 Q

8
#define list l
l <- list(a = c(letters[1:5]),
b = matrix(data = 1:12, ncol = 4))
l

## $a
## [1] "a" "b" "c" "d" "e"
##
## $b
## [,1] [,2] [,3] [,4]
## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12
#extract the 2nd and 4th elements of the 1st element of the list l
l[[1]][c(2, 4)]

## [1] "b" "d"

#print element b of the list l
l$b

## [,1] [,2] [,3] [,4]

## [1,] 1 4 7 10
## [2,] 2 5 8 11
## [3,] 3 6 9 12

1.2 Data import

This section covers data import from the most common data sources. The list of sources provided
here is not exhaustive, so we encourage readers to explore additional possibilities. For an excellent
overview of import/export procedures, readers can refer to the following link: [Link]
manual/R-devel/doc/manual/[Link].

Data is often stored in flat files such as csv or txt. To import these file types, R provides functions
as part of the base configuration, eliminating the need for additional packages. The two most
common functions used are [Link] and [Link].

Another widespread file type is MS Excel. While the base R configuration lacks specific functions
for importing MS Excel files directly, a workaround is to first save the file as a .csv and then use
the [Link] function for import. Alternatively, users can utilize packages in R that allow direct
import and manipulation of MS Excel files. Among these options, the following are popular within
the R community: openxlsx, XLConnect, and readxl.

9
When dealing with larger-sized files, users often store data in various databases. To import data
from these sources, different R packages are available. We recommend using RODBC, DBI, and odbc
as a starting point.

Apart from manipulating data stored in the mentioned file types, data exchange between different
statistical software is common during the data analytics process. For instance, SAS is widely used in
the banking industry, and users may need to import data stored in SAS format. For this purpose, R
offers different packages, including sas7bdat, rio, haven, Hmisc, and foreign.

Finally, R has its native data formats, .RData and .rds, which can be easily imported using the
base functions load and readRDS, respectively. The distinction between these formats lies in their
capabilities. The .RData format allows users to save multiple R objects, while the .rds format is
designed to save only one object. The advantage of using these native R data formats is the import
speed and the ability to save different R-specific objects into a single file. Additionally, working with
these formats is convenient when saving specific regression objects resulting from procedures like lm,
glm, or similar, which can then be used for predictions or other analyses.

1.3 Data manipulation and aggregation

After data import, we usually perform various data manipulations and aggregations. Even the base
R configuration provides advanced functions and procedures for these tasks. Additional benefits
come from installing specific packages specialized in data manipulation. One such ecosystem
is the tidyverse, which includes dplyr among other packages. Besides dplyr, other packages
gaining popularity within the R community are [Link] and dbplyr. The former offers a
high-performance version of the base R’s [Link] with syntax and feature enhancements for
ease of use, convenience, and programming speed, while the latter combines the performance of
[Link] and the syntax of dplyr into one package.

The following examples present only a small portion of R’s possibilities for data manipulations.
To run the examples, we will use the packages PDtoolkit, [Link], dplyr, and the dataset
loans, distributed with the package PDtoolkit. Before running the examples, make sure that these
packages have been installed.
#run if not installed
#[Link]("PDtoolkit")
#[Link]("[Link]")
#[Link]("dplyr")
#import libraries
library(PDtoolkit)
library([Link])
library(dplyr)
#import dataset loans

10
data(loans)
#check the structure of the dataset loans
str(loans)

## '[Link]': 1000 obs. of 21 variables:

## $ Creditability : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Account Balance : chr "1" "1" "2" "1" ...
## $ Duration of Credit (month) : num 18 9 12 12 12 10 8 6 18 24 ...
## $ Payment Status of Previous Credit: chr "4" "4" "2" "4" ...
## $ Purpose : chr "2" "0" "9" "0" ...
## $ Credit Amount : num 1049 2799 841 2122 2171 ...
## $ Value Savings/Stocks : chr "1" "1" "2" "1" ...
## $ Length of current employment : chr "2" "3" "4" "3" ...
## $ Instalment per cent : chr "4" "2" "2" "3" ...
## $ Sex & Marital Status : chr "2" "3" "2" "3" ...
## $ Guarantors : chr "1" "1" "1" "1" ...
## $ Duration in Current address : chr "4" "2" "4" "2" ...
## $ Most valuable available asset : chr "2" "1" "1" "1" ...
## $ Age (years) : num 21 36 23 39 38 48 39 40 65 23 ...
## $ Concurrent Credits : chr "3" "3" "3" "3" ...
## $ Type of apartment : chr "1" "1" "1" "1" ...
## $ No of Credits at this Bank : chr "1" "2" "1" "2" ...
## $ Occupation : chr "3" "3" "2" "2" ...
## $ No of dependents : chr "1" "2" "1" "2" ...
## $ Telephone : chr "1" "1" "1" "1" ...
## $ Foreign Worker : chr "1" "1" "1" "2" ...

Add a new variable, [Link], to the data frame loans, which will take the value 1 if the variable
Age (years) is greater than 25; otherwise, 0.
loans$[Link] <- ifelse(loans$"Age (years)" > 25, 1, 0)
table(loans$[Link])

##
## 0 1
## 190 810

Calculate the average Credit Amount per [Link].

#base R functions (tapply & aggregate)
tapply(X = loans$"Credit Amount",
INDEX = loans$[Link],

11
 FUN = mean)

## 0 1
## 3003.405 3334.075
aggregate(x = loans[, "Credit Amount", drop = FALSE],
by = list(Group = loans$[Link]),
FUN = mean)

## Group Credit Amount

## 1 0 3003.405
## 2 1 3334.075
#[Link]
[Link] <- [Link](loans)
[Link][, list(avg = mean(`Credit Amount`)),
by = list(Group = [Link])]

## Group avg
## 1: 0 3003.405
## 2: 1 3334.075
#dplyr
loans %>%
group_by(Group = [Link]) %>%
summarise(avg = mean(`Credit Amount`))

## # A tibble: 2 x 2
## Group avg
## <dbl> <dbl>
## 1 0 3003.
## 2 1 3334.

Split dataset based on the variable [Link].

loans.s <- split(x = loans,
f = loans$[Link])
sapply(X = loans.s, FUN = nrow)

## 0 1
## 190 810

R offers a wide range of functions for obtaining summary statistics. In the following examples, we
will present some of the most common functions that are part of the base configuration.

12
x <- loans$"Credit Amount"
head(x)

## [1] 1049 2799 841 2122 2171 2241

[Link] <- [Link]("min" = min(x),
"mean" = mean(x),
"median" = median(x),
"max" = max(x),
"quant.5th" = unname(quantile(x = x, prob = 0.05)),
"[Link]" = sd(x),
"iqr" = IQR(x))
[Link]

## min mean median max quant.5th [Link] iqr

## 1 250 3271.248 2319.5 18424 708.95 2822.752 2606.75
range(x)

## [1] 250 18424

1.4 Data export

Data export involves extracting and converting data from their existing format into the required
format, and it is an inevitable step in any analytics process.

The same principles explained for data import also apply to data export. The most common
data export formats are .csv and .txt files, and R provides built-in functions [Link] and
[Link] for this purpose. To export data to MS Excel file type, users can utilize the packages
openxlsx and XLConnect.

Apart from exporting data from databases, users can also write data back using packages such as
RODBC, DBI, or odbc.

As mentioned earlier, the native R format .RData can be used to export objects from the R
environment. For more details, we refer to the help pages of the functions ?save and ?saveRDS.

It’s also worth mentioning the possibilities to automate and export data directly from R to formats
like MS Word, MS PowerPoint, PDF, HTML, GitHub document, and more. Readers can explore
the packages officer and rmarkdown for this purpose.

13
1.5 Sampling
Sampling plays an important role in various areas of statistical analysis, including PD modeling,
where it serves several purposes, such as:

• creation of modeling datasets;

• splitting of modeling dataset (training, testing, validation sample);
• correcting for imbalanced classification;
• k-fold validation;
• hypothesis testing;
• quantification of model uncertainty;
• quantification of margin of conservatism;
• synthetic data creation.

The literature presents different classifications of sampling methods, and for PD modeling, we find
the following classifications particularly important:

1. based on replacements:
• sampling with replacements;
• sampling without replacement.
2. based on design:
• simple random sampling;
• stratified random sampling.
3. based on the size of the sampling units1 :
• equal;
• unequal.

In addition to the traditional understanding of the term sampling, it also encompasses sampling
from different statistical distributions (e.g., generating random numbers from the standard normal
distribution). R offers diverse options for implementing a wide range of sampling schemes. When
implementing any sampling scheme, it is highly recommended to use a random seed. In R, the
random seed can be defined using the function [Link]. By setting a random seed, users can
replicate the same sampling results, making the analyses more reliable and reproducible.

To simulate five numbers from the standard normal distribution, we can run the following command:
[Link](1)
rnorm(n = 10, mean = 0, sd = 1)

## [1] -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 -0.8204684

## [7] 0.4874291 0.7383247 0.5757814 -0.3053884

The R function sample is available for other sampling schemes.

1
This sampling method is known as PPS - Probability Proportional to Size.

14
Examples of sampling with or without replacement:
[Link](3)
#sampling without replacement
sample(x = 1:10, size = 5, replace = FALSE)

## [1] 5 7 4 2 3
#sampling with replacement
sample(x = 1:10, size = 5, replace = TRUE)

## [1] 8 4 10 7 8

Examples of simple and stratified random sampling:

[Link](5)
data(loans)
table(loans$Creditability)

##
## 0 1
## 700 300
#simple random sampling
[Link] <- sample(x = 1:nrow(loans),
size = 10,
replace = FALSE)
table(loans$Creditability[[Link]])

##
## 0 1
## 6 4
#stratified random sampling
[Link].0 <- sample(x = which(loans$Creditability%in%0),
size = 10,
replace = FALSE)
[Link].1 <- sample(x = which(loans$Creditability%in%1),
size = 10,
replace = FALSE)
table(loans$Creditability[c([Link].0, [Link].1)])

##
## 0 1
## 10 10

15
Example of sampling with probability proportional to size:
x <- c(rep(1, 5), rep(2, 10))
table(x)

## x
## 1 2
## 5 10
[Link](7)
#define probabilities
[Link] <- ifelse(x == 1, 0.10, 0.05)
#perform sampling proportional to the defined probabilities
smpl <- sample(x = x,
size = 10000,
prob = [Link],
replace = TRUE)
table(smpl)

## smpl
## 1 2
## 4995 5005

Using the function sample we can also create the permutations:

[Link](9)
sample(x = 1:10, size = 10, replace = FALSE)

## [1] 5 6 3 8 7 4 10 9 2 1

1.6 Linear and logistic regression

A regression is a statistical method that examines the relationship between a response (dependent)
variable and one or more explanatory (independent) variables, including their interactions. Linear
regression stands as one of the most fundamental statistical techniques for modeling continuous
dependent variables.
In R, users can perform linear regression using the function lm:
library(PDtoolkit)
data(loans)
lin.r <- lm(formula = `Duration of Credit (month)` ~ `Credit Amount`,
data = loans)
lin.r

##

16
## Call:
## lm(formula = `Duration of Credit (month)` ~ `Credit Amount`,
## data = loans)
##
## Coefficients:
## (Intercept) `Credit Amount`
## 12.16892 0.00267

To obtain standard details on the estimated coefficients, users can execute the following command:
summary(lin.r)$coefficients

## Estimate Std. Error t value Pr(>|t|)

## (Intercept) 12.168915375 0.4560178430 26.68517 7.594486e-119
## `Credit Amount` 0.002669955 0.0001055636 25.29239 1.854728e-109

Unlike linear regression, which models continuous dependent variables, logistic regression is used
when we want to model binary (dichotomous) dependent variables. It ensures that model predictions
remain within the 0-1 interval, suitable for binary outcomes.
To estimate logistic regression in R, we can utilize the glm function and specify the appropriate
model family as shown below:
library(PDtoolkit)
data(loans)
log.r <- glm(formula = Creditability ~ `Account Balance` + `Credit Amount`,
family = "binomial",
data = loans)
summary(log.r)$coefficient

## Estimate Std. Error z value

## (Intercept) -0.3852813017 0.14558526389 -2.646431
## `Account Balance`2 -0.5023853615 0.17765801200 -2.827823
## `Account Balance`3 -1.1201257383 0.32796342146 -3.415398
## `Account Balance`4 -2.0267475055 0.20027408149 -10.119869
## `Credit Amount` 0.0001131389 0.00002565664 4.409732
## Pr(>|z|)
## (Intercept) 0.00813461876481853980724867625
## `Account Balance`2 0.00468657526389188415494313489
## `Account Balance`3 0.00063688788779273216786314116
## `Account Balance`4 0.00000000000000000000000451018
## `Credit Amount` 0.00001034984686745242429264588

To make predictions using the estimated model, we can utilize the predict function, which has

17
specific methods for both linear and logistic regression. The following example demonstrates the
predictions for the first six observations in the modeling dataset.
head(predict(object = lin.r))

## 1 2 3 4 5 6
## 14.96970 19.64212 14.41435 17.83456 17.96539 18.15228
head(predict(object = log.r, type = "response"))

## 1 2 3 4 5 6
## 0.4337423 0.4828554 0.3116285 0.4637635 0.4651425 0.4671133

1.7 Loops
Loops are control structures that run a block of code multiple times. In R, there are three types of
loops:

1. for loop;
2. while loop;
3. repeat loop.

The for loop iterates over a defined sequence, while the other two types run until certain conditions
are met.
Below are simple examples of implementing these three loops in R.
#for loop
for (i in 1:2) {
print(i)
}

## [1] 1
## [1] 2
#while loop
x <- 1
while (x < 3) {
print(x)
x <- x + 1
}

## [1] 1
## [1] 2
#repeat loop
x <- 1

18
repeat {
print(x)
x <- x + 1
if(x > 2) {break}
}

## [1] 1
## [1] 2

1.8 User-defined functions

In every programming language, functions are defined as sets of instructions. Their primary purpose
is to organize code into logical chunks, reducing program complexity and avoiding code repetitions.
Each function consists of the following components:

1. function name;
2. function arguments;
3. function body;
4. return value.

A function requires a name to be called from other programs. When calling the function, specific
parameters, known as function arguments, are passed to execute the instructions inside the function.
It is generally not recommended to define functions without arguments. The set of instructions
executed by the function is known as the function body. Additionally, each function typically returns
a value, which serves as the function’s output.
It’s important to understand that a function operates within its own environment. We cannot
directly access the function’s output unless we return a value. Thus, setting the return value is the
way to access the function output within the working environment.
Let’s see how we can define our own function in R.
add <- function(x, y) {
xy.a <- x + y
return(xy.a)
}
add(x = 5,
y = 10)

## [1] 15

In the example provided, we have defined a function called add, which takes two arguments, x and
y. Inside the function’s body, the sum of these arguments is computed using the code xy.a <- x +
y. The result of this computation is stored in a variable called xy.a. Finally, this computed value is
returned as the function’s output using the code line return(xy.a).

19
The function add encapsulates the process of adding two values and allows us to perform
this operation conveniently by simply calling the function with the desired values for x and y. The
function’s name (add) serves as the identifier to access and execute the set of instructions within
the function’s body. By using function arguments, we can pass specific values to the function and
perform the addition operation using those values. The function’s output (the sum of x and y) is
made accessible by using the return statement, allowing us to use the result in other parts of the
program.

20
2 Variable types and measurement scales
The role of variable types and their measurement scales is paramount in data analysis. These
aspects influence the choice of descriptive statistics used to summarize the data and impact the
selection of inferential statistics used to support or refute hypotheses.

In practical data analysis, variables may be measured and transformed from one type to another,
and their measurement scales can be altered. Hence, it is crucial to clearly understand the analyzed
variables and the potential consequences of changing their types or measurement scales.

Essentially, a variable is defined as anything that can have multiple values. The term measurement
refers to assigning labels to the variable, enabling us to categorize and analyze the data effectively.

Before initiating the formal data collection process, two crucial steps need to be undertaken:

1. defining the variable by conceptual definition;

2. defining the variable by operational definition.

The modeling process begins with a conceptual definition, which precisely outlines the underlying
concept the variable seeks to represent. It provides insight into what the variable measures and its
significance in the context of the analysis. Subsequently, the second step introduces operational
definitions, which outline the practical measurement approach for the variable. Operational
definitions specify how the variable will be measured in practice.
For instance, in credit scoring, the variable loan characteristics can be conceptually defined as
representing specific aspects of a loan, including the approved loan product, loan amount, and
interest rate. To ensure accurate measurement, each aspect must have an operational definition.
For the loan product, operational definitions could include categories such as cash loan or mortgage
loan, defining the type of loan being offered to the borrower. Regarding the loan amount, the
operational definition allows for any value between 1000 and 10000 euros, encompassing a range
of potential loan amounts. Similarly, the operational definition for the interest rate permits any
percentage value greater than 0% and less than 10%, covering the different interest rates applicable
to the loans. By having clear and well-defined operational definitions for each aspect of loan
characteristics, models can accurately represent and quantify the relevant information to make
informed decisions.

The variables at the highest level can be categorized into two types: qualitative and quan-
titative.
Qualitative variables provide information about qualities or attributes that cannot be measured
numerically. These variables are typically descriptive and textual, examples of which include
gender, region, marital status, etc. In contrast, quantitative variables represent information that
can be counted and expressed numerically. Examples of quantitative data include age, loan amount,
interest rate, GDP growth rate, unemployment rate, etc.
Quantitative variables can be further sub-classified into discrete and continuous variables. Discrete

21
variables are a type of quantitative variable that contain only finite values and cannot be subdivided
further. They include whole numbers or integers representing specific counts and cannot be
expressed as fractions or decimals. Discrete variables include the number of credit accounts, the
number of credit cards, the number of transactions, etc. On the other hand, continuous variables
represent a set of observations that can take any numeric value within a finite or infinite range.
This means the data can be expressed as fractions or decimals and can cover a broad spectrum of
values. Continuous variables include credit utilization ratio, debt-to-income ratio, loan exposure
amount, etc.
Understanding the distinction between qualitative and quantitative variables and the sub-
classifications within quantitative variables is essential for effective data analysis and modeling.

Another classification of variables is based on their measurement scales. In statistics, there are four
data measurement scales: nominal, ordinal, interval, and ratio.
The nominal measurement scale refers to qualitative variables that can be counted and labeled
without any standard way of ranking their values. An example of a variable with this scale of
measurement is gender. Information about gender can be collected and counted, but there is no
rule to order its values.
The ordinal measurement scale also refers to qualitative variables for which the order of the values
is significant, but the differences are not quantifiable. An example of a variable with the ordinal
measurement scale is days past due buckets: 0 DPD, from 1 to 30 DPD, 31 and more DPD. These
values can be ordered, but we cannot measure how much one bucket is “better” than another.
The interval scale is a numeric scale in which we know the order and the exact differences between
the values. An example of an interval scale is the deposit interest rate because the difference
between each value is known. For example, the difference between 1% and 2% interest rate is a
measurable 1 percentage point, as is the difference between 3% and 4%.
The ratio scale differs from the interval scale in two key characteristics. Firstly, it includes
a “natural (or true) zero” value, while the interval scale lacks this feature. This natural zero
represents an absolute absence or absence of the measured attribute. For example, the deposit
interest rate lacks the concept of “true zero” since it has a non-zero starting point, i.e., it
can be positive and negative. Secondly, the ratio scale consistently provides a meaningful
interpretation of the ratio between two values. The ratio between the interest rate of -1% and
the interest rate of 1% lacks a meaningful interpretation. On the other hand, the loan amount
exemplifies the ratio scale. It shares all the properties of an interval scale but also features
a true zero. Consequently, the ratio between any two values of the loan amount is always meaningful.

In this book, we use the terms categorical and numeric variables, which are equivalent to
dividing them into qualitative and quantitative variable types.

22
3 Ranking model development
The first step in the Probability of Default (PD) modeling process is to develop the ranking model
or risk differentiation function. This step typically involves the following tasks:

1. creation of modeling datasets;

2. univariate analysis;
3. bivariate analysis;
4. multivariate analysis.

While we can, to some extent, standardize these tasks, we strongly encourage readers to view them
not just as statistical exercises but as components that serve existing and future business processes.
Furthermore, the ranking model should be designed to incorporate and process all essential business
inputs. Therefore, a thorough understanding of the main characteristics of the portfolio in scope, the
granting process, the collection process, and the risk appetite is critical for selecting the appropriate
model design.
The following sections present details on each task and examples of different model designs.

3.1 Modeling datasets

Before we commence with PD model development, significant work is required to create modeling
datasets. This process begins with defining the so-called target population (portfolio in scope).
Subsequently, it involves selecting an observational time frame. The observational time frame may
vary from one model to another, depending on data availability and the performance window of the
target variable. However, it is recommended to collect at least the most recent five years of complete
data. Here, it is essential to understand the term complete data, which refers to the target variable.
Specifically, when defining the target, such as a 6-month, 12-month, or 24-month default indicator,
a specific performance window is considered for every observation to assign the outcome to the
target variable. Let’s assume that our target is a 12-month default indicator. In this case, if the
client has an available history of 16 months from a particular historical snapshot date, we assign the
outcome only after 12 months. On the other hand, if the client has only seven months of available
history from the same snapshot date, we cannot assign the outcome to this client, making them
ineligible for our modeling dataset. Hence, our goal is to have complete data on the target variable.
After defining the target variable and observational time frame, we collect available data for the
target population. At this stage, we often gather monthly data snapshots and then derive a set of
new risk factors. Among others, the so-called trend risk factors are typically derived. In practice,
some banks regularly collect and store trend indicators, while others calculate them only for model
development and application.
As a final step, we select a subset of all snapshots for model development. This selection is due to
the correlation of risk factor values in consecutive snapshots. To avoid such correlation, we usually
choose snapshots with at least six or 12 months difference for one observation (client or contract).

23
This is the most common approach for creating a PD sample, but these steps can be designed
differently depending on the model type (e.g., application or behavioral model). Additionally, the
steps may vary based on the statistical method used for model development and the implementation
of the final model in production. In some cases, it is possible to use data available for a period
shorter than the performance window. For example, we have a survival analysis framework that
utilizes censored observations.

Sometimes, the sample created in the above way may contain too many observations, making
it impractical to perform model development on the entire sample. In such cases, an approach
to deal with this problem is to perform additional sampling. For instance, if our initial sample
has 20 million observations, we can sample 20% for model development. To incorporate this kind
of sampling design in the model development, we can use frequency weights in all steps of the
modeling process. Some researchers (Crone and Finlay (2012)) stated that logistic regression,
the most common approach for model development, is robust to different sampling designs, thus
eliminating the need to introduce frequency weights during the model estimation stage. Regardless
of the decision to consider or disregard the sampling design for model development, special attention
should be paid to creating datasets for model testing and generalizing the results for the application
portfolio. The functions and packages used throughout this book do not account for frequency
weights in model development; therefore, we will not cover this topic further. For those interested
in this adjustment, we recommend directly inspecting and adjusting the source code of functions of
interest (binning algorithms, functions for univariate, bivariate, and multivariate analysis).

After defining our sample, we usually create modeling datasets - training and testing. The
training dataset is used for model fitting, while the testing dataset is employed for the unbiased
evaluation of the final model fit. These two datasets must be mutually exclusive. The testing
dataset frequently comprises a mixture of out-of-sample and out-of-time observations, and the final
model’s performance is assessed independently on these two sets. In practice, splitting the data into
training and testing datasets is considered the most common approach. However, depending on the
statistical method used for model development (e.g., decision tree, random forest, XGBoost), recent
trends suggest splitting the data into training, validation, and testing datasets. In this case, both
the training and testing datasets serve the same purpose of model fitting and unbiased evaluation of
the fit, while the validation dataset is used for tuning the model hyperparameters. Our focus here
will be on the training-testing split. For this purpose, two sampling methods are commonly used -
simple random sampling and stratified random sampling. Stratification can be performed based
on different population characteristics, with some of the most frequently used ones being default
indicator, snapshot dates, exposure, region, or turnover, depending on the portfolio type. Let’s
explore how these sampling schemes can be implemented in R. For this demonstration, we will use
the dataset loans and the base R function sample.

24
data(loans)
#sampling inputs
[Link](123)
[Link] <- 0.7
nr <- nrow(loans)
nr

## [1] 1000
#simple random sampling
idx <- sample(x = 1:nr,
size = 0.7 * nr,
replace = FALSE)
training <- loans[idx, ]
testing <- loans[-idx, ]
#check - number of rows
c(nrow(training), nrow(testing))

## [1] 700 300

#check - non-default/default share in the training dataset
table(training$Creditability) / nrow(training)

##
## 0 1
## 0.7071429 0.2928571
#check - non-default/default share in the testing dataset
table(testing$Creditability) / nrow(testing)

##
## 0 1
## 0.6833333 0.3166667
#stratified random sampling (default indicator)
table(loans$Creditability) / nr

##
## 0 1
## 0.7 0.3
def <- loans[loans$Creditability%in%1, ]
[Link] <- nrow(def)
nondef <- loans[loans$Creditability%in%0, ]

25
[Link] <- nrow(nondef)
[Link] <- sample(x = 1:[Link],
size = 0.7 * [Link],
replace = FALSE)
[Link] <- sample(x = 1:[Link],
size = 0.7 * [Link],
replace = FALSE)
training <- [Link]("rbind", list(def[[Link], ], nondef[[Link], ]))
testing <- [Link]("rbind", list(def[-[Link], ], nondef[-[Link], ]))
#check - non-default/default share in the training dataset
table(training$Creditability) / nrow(training)

##
## 0 1
## 0.6995708 0.3004292
#check - non-default/default share in the testing dataset
table(testing$Creditability) / nrow(testing)

##
## 0 1
## 0.7009967 0.2990033

When dealing with a complex stratification scheme, it is recommended to create a user-defined

function. Additionally, the sampling procedure should account for the gap between samples of the
same observations due to the correlation of the risk factors. As mentioned earlier in this section,
the recommended gap is at least six or 12 months. This aspect must be carefully considered and
incorporated into the customized sampling procedure.

While preparing modeling datasets, we often encounter the problem of imbalanced data.
Technically, any dataset with an unequal class distribution of the target variable can be considered
imbalanced. Not every imbalance poses challenges for PD modeling, but special attention should be
given to low default portfolios. In practice, there is no widely accepted standard for the threshold
at which we consider some portfolios a low default. However, as a rule of thumb, a 2% threshold is
commonly used. In practice, three main approaches are commonly used to address imbalanced
samples when preparing modeling datasets:

1. undersampling of majority class;

2. oversampling of minority class;
3. Synthetic Minority Oversampling Technique (SMOTE).

When considering the approach to dealing with the imbalanced sample, we usually inspect the default

26
rate and the number of defaults. SMOTE is generally utilized for cases with a low default rate
(e.g., below 2%) and a low number of defaults. In other situations, oversampling and undersampling
techniques can also be considered. However, each of these approaches has certain shortcomings.
For example, undersampling may remove potentially essential observations from the majority class,
hindering an algorithm’s capacity to learn the decision boundary. SMOTE could lead to a similar
issue, affecting the distribution of the risk factors. On the other hand, oversampling duplicates
identical records and may result in overfitting of similar observations. Consequently, the selection of
the approach should undergo thorough analysis. Additionally, these approaches can be implemented
in different ways. We can run one of these procedures and then split the data into training and
testing datasets or vice versa. In practice, for portfolios with a sufficient number of defaults,
undersampling or oversampling is often performed only on the training dataset, while the testing
dataset retains the original class distribution. Given the nature of the SMOTE method, in the case
of a low default portfolio, it is recommended to run it after the training and testing dataset split.
The following examples demonstrate how all three approaches can be performed using R. We will
use the base R function sample for oversampling and undersampling schemes, while for SMOTE, we
will utilize the function smote from the PDtoolkit package.
data(loans)
#default indicator
table(loans$Creditability)

##
## 0 1
## 700 300
[Link](984)
#undersampling of non-defaults
idx.0 <- which(loans$Creditability%in%0)
[Link] <- sample(x = idx.0,
size = 300,
replace = FALSE)
[Link] <- [Link]("rbind",
list(loans[loans$Creditability%in%1, ],
loans[[Link], ]))
table([Link]$Creditability)

##
## 0 1
## 300 300
#oversampling of defaults
idx.1 <- which(loans$Creditability%in%1)

27
[Link] <- sample(x = idx.1,
size = 100,
replace = FALSE)
[Link] <- [Link]("rbind", list(loans, loans[[Link], ]))
table([Link]$Creditability)

##
## 0 1
## 700 400
#SMOTE
idx <- sample(x = 1:nrow(loans),
size = 0.7 * nrow(loans),
replace = FALSE)
training <- loans[idx, ]
testing <- loans[-idx, ]
#check - number of rows
c(nrow(training), nrow(testing))

## [1] 700 300

#check - number of defaults
c(sum(training$Creditability), sum(testing$Creditability))

## [1] 218 82
#define smote constraints
[Link] <- [Link](rf = c("Duration of Credit (month)",
"Credit Amount", "Age (years)"),
lower = c(4, 250, 19),
upper = c(72, 20000, 75),
type = c("integer", "numeric", "integer"))
#smote on the training dataset
training.s <- smote(db = training,
target = "Creditability",
[Link] = 1,
osr = 0.05,
[Link] = [Link],
k = 5,
seed = 81000)
#check - synthetic defaults in the training dataset
table(training.s$Creditability, training.s$smote)

28
##
## 0 1
## 0 482 0
## 1 218 11
#smote on the testing dataset
testing.s <- smote(db = testing,
target = "Creditability",
[Link] = 1,
osr = 0.05,
[Link] = [Link],
k = 5,
seed = 81000)
#check - synthetic defaults in the testing dataset
table(testing.s$Creditability, testing.s$smote)

##
## 0 1
## 0 218 0
## 1 82 4

The function smote from the PDtoolkit package can handle mixed data types (numeric, categorical,
ordinal measurement level) and utilizes the Heterogeneity Euclidean Overlapping Metric (HEOM)
for distance calculation. It is important to note that specific constraints on risk factors can
also be set using a data frame, like [Link] in the above example. This integration en-
sures that the simulated values of specific risk factors remain within reasonable lower and upper limits.

After defining the training and testing datasets, a representativeness analysis is typically
performed to ensure that the most important characteristics of the portfolio are similar in both
datasets. The commonly used metric for this analysis is the Population Stability Index (PSI), which
will also be mentioned in a few other sections of the book. Unlike using PSI to check for possible
distributional shifts of the risk factors, for this purpose, we usually select other characteristics for
testing. Depending on the portfolio type, we are often interested in testing the distribution shift of
defaults, exposure, region, or turnover between the training and testing datasets. For performing
this analysis in R, we can utilize the function psi from the PDtoolkit package. Additionally, we
will use the variable Credit Amount as a proxy for exposure and run tests on the training and
testing datasets from the previous example of the SMOTE approach.
[Link] <- "Credit Amount"
psi(base = training.s[, [Link]],
target = testing.s[, [Link]],

29
 bin = 5,
alpha = 0.05)

## $res
## psi [Link] psi** [Link] ci
## 1 0.02137365 0.04063094 0.01521534 0.04455384 0.95
##
## $tbl
## bin [Link] [Link] [Link] [Link] [Link] [Link] [Link]
## 1 1 -Inf 3878 518 0.728551336 339 3857 232
## 2 2 3905 7511 127 0.178621660 3914 7485 53
## 3 3 7582 11054 43 0.060478200 7678 11328 15
## 4 4 11560 14782 18 0.025316456 11590 14421 3
## 5 5 14896 Inf 5 0.007032349 15653 15653 1
## [Link] psi.b
## 1 0.763157895 0.0016059816
## 2 0.174342105 0.0001037811
## 3 0.049342105 0.0022662530
## 4 0.009868421 0.0145538212
## 5 0.003289474 0.0028438110

The calculated PSI value of 0.021 indicates an insignificant shift in the distribution of the variable
Credit Amount between the training and testing datasets. According to the rule of thumb for PSI,
a mild shift is observed if PSI is between 0.1 and 0.25, while a significant shift is considered when
the PSI value is greater than 0.25. For further information on PSI, refer to sections Risk factor
stability analysis and Periodic model validation.

3.2 Univariate analysis

After defining the datasets, the next step in the modeling process is typically the univariate analysis.
Simple descriptive statistics of the analyzed variables can offer valuable insights into the business
and data integrity. The common tasks covered in the univariate analysis are:

1. descriptive statistics of risk factors and target variable;

2. special cases management;
3. outliers detection and treatment;
4. identification of near-zero variance risk factors.

Descriptive statistics usually encompass a set of standard metrics such as the number of observations,
number of unique observations, minimum, mean, standard error of the mean, maximum, percentiles,
and the number of positive and negative values. It is evident that some of these metrics are specific
only to numeric risk factors, while others are for categorical ones. This serves as a starting point for

30
reviewing data integrity, and these metrics can reveal possible weaknesses in the collected data.

In the univariate analysis, we encounter the issue of special cases for the first time. Spe-
cial cases include missing and other unavailable values resulting from the data collection process or
risk factor transformations, such as division by zero. It is crucial to understand the nature of these
values and handle them appropriately in the further modeling process.
In practice, various approaches have been suggested to deal with special cases such as:

1. exclusion of risk factors with a significant share of special cases;

2. keeping special cases as a separate attribute (modality of the risk factor) in the model
development;
3. imputing for special cases.

The above options are not mutually exclusive, so very often, all of them are applied during the
modeling process. For example, the first step can involve excluding risk factors with a significant
share (e.g., above 30%) of special cases. Then, for the remaining risk factors, after understanding the
nature of special cases for some of them, we can perform imputations, while for others, we can keep
special cases as separate modalities of the risk factor. Different strategies can be applied regarding
imputations, but their selection depends on the nature of the special cases. In some situations,
imputing a zero value is a reasonable way of dealing with special cases. In others, imputation
can be performed using statistical methods such as tree-based or regularization techniques, which
consider the value of other risk factors. Usually, imputation based on the mean, median, or mode is
not recommended due to the possible information loss and spikes in data. Nonetheless, it is used in
practice, especially for imputing an insignificant share of special cases in the overall dataset.
Another aspect of dealing with special cases is their labeling. Specifically, if the special cases
result from transforming a numeric risk factor (e.g., ratio calculation and division by zero), they
can take values such as ±inf inite. Often, +Inf values are replaced with another numeric value,
such as 9999999999, while -Inf can be replaced with -9999999999. A similar process applies to
categorical risk factors. Instead of missing values (in R denoted as NA), for categorical risk factors,
we can use, for example, the SC modality (if it does not already exist within the analyzed risk
factor), while other modalities can be used to indicate, for example, outdated values. By performing
labeling in this way, we can distinguish between different types of special values in further modeling
procedures. Finally, a decision can be made to treat all special cases together or separately.
When dealing with special cases, the crucial point is that the approaches used during the model
development must align with how the model will be employed in production.

Often, the descriptive statistics of numeric risk factors are enhanced with information
about outliers. The most common and straightforward way to report the number of outliers is
to use the method implemented in a box plot (also known as a 5-figure plot). Specifically, every
value that lies below Q1 − 1.5 ∗ IQR(x) and above Q3 + 1.5 ∗ IQR(x) is considered an outlier,

31
where Q1 and Q3 represent the first and third quartiles of the numeric risk factor x, and IQR is
its interquartile range. Outliers are treated during different stages of the modeling process. If
addressed during the univariate analysis, simple winsorizing or risk factor transformation is usually
employed. Winsorizing, in essence, forces outliers onto specified minimum and/or maximum values,
which may be explicitly stated, set at a certain number of standard deviations away from the mean,
or set at a certain percentile level. The most common approaches involve replacing outliers with
values at the 1st or 99th percentile or with minimum and maximum values identified from the box
plot creation procedure.
Besides winsorizing, another method to deal with outliers is univariate risk factor transformation
(in practice, also known as distributional transformation), such as the one based on logistic function.
During this process, risk factor values are bounded within the range 0-1, and outliers are shrunk
towards the center.
Apart from the transformation based on logistic function, normalization and standardization are
commonly used transformations in the univariate analysis. Normalization limits risk factor values
between selected minimum and maximum values, while standardization results in a mean of 0 and
a standard deviation of 1 of the transformed risk factor. These transformations are often used
as a preparatory step for multivariate analysis in case we decide not to discretize numeric risk
factors. Additionally, they serve as preparation of inputs for other transformational methods, such
as Principal Component Analysis (PCA).
In many cases, specific treatment of the outliers at this stage is optional, as the binning process
in the bivariate analysis is resilient to outliers. However, if they are addressed in the univariate
analysis, it’s essential to ensure alignment between approaches in the development and production.

The near-zero variance procedure aims to identify risk factors with either one unique value (zero
variance) or a high ratio of the most common value to the next most common value, resulting in a
few unique values (near-zero variance). The outcome of this procedure can indicate potential data
quality problems, but it can also happen that some risk factors are almost constant. Additionally,
this procedure can be performed before or after imputation for special cases or outliers. Therefore,
the treatment of risk factors identified in this procedure should be carefully chosen, and the process
should be adequately designed.

Finally, the univariate analysis usually results in the following:

1. data cleaning;
2. data integrity checks;
3. an understanding of the meaning of special values;
4. initial risk factor filtering - excluding some risk factors that cannot bring additional value to
the further modeling process.

To demonstrate how tasks from the univariate analysis can be performed in R, we will combine

32
user-defined functions and functions from the PDtoolkit package. Let’s begin with user-defined
functions used to transform numeric risk factors.
It is important to note that before conducting the univariate analysis, it is customary to partition
the modeling dataset into separate training and testing datasets. The univariate analysis is then
performed independently on each of these datasets. For the sake of simplicity, the following
examples will be executed on the overall dataset.

#run if not installed

#[Link]("monobin")
library(monobin)
#import gcd dataset from the monobin package
data(gcd)
#user-defined function for normalization
normalize <- function(x, [Link], [Link]) {
x.r <- range(x)
x.t <- (x - x.r[1]) / (x.r[2] - x.r[1]) * ([Link] - [Link]) + [Link]
return(x.t)
}
x.n <- normalize(x = gcd$age,
[Link] = 0,
[Link] = 10)
summary(x.n)

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## 0.000 1.429 2.500 2.954 4.107 10.000
#compare distribution of the original and transformed values
par(mfrow = c(1, 2))
#original values
hist(x = gcd$age,
nclass = 30,
xlab = "Age",
main = "Original values")
#transformed values
hist(x = x.n,
nclass = 30,
xlab = "Age normalized",
main = "Transformed values")

33
 Original values Transformed values

120
80
60
Frequency

Frequency

80
60
40

40
20

20
0

20 40 60 0 0 2 4 6 8 10

Age Age normalized

#user-defined function for standardization

standardize <- function(x) {
x.s <- (x - mean(x)) / sd(x)
return(x.s)
}
#another approach is to use a built-in function scale
x.s <- standardize(x = gcd$amount)
summary(x.s)

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## -1.0703 -0.6751 -0.3372 0.0000 0.2483 5.3681
round(c(mean = mean(x.s), sd = sd(x.s)), 4)

## mean sd
## 0 1
#compare distribution of the original and transformed values
par(mfrow = c(1, 2))
#original values
hist(x = gcd$age,

34
 nclass = 30,
xlab = "Age",
main = "Original values")
#transformed values
hist(x = x.s,
nclass = 30,
xlab = "Age standardized",
main = "Transformed values")

Original values Transformed values

200
80

150
60
Frequency

Frequency

100
40

50
20
0

20 40 60 −1 0 1 2 3 4 5

Age Age standardized

#user-defined function for logistic function transformation

[Link] <- function(x) {
x.q <- quantile(x = x, prob = c(0.05, 0.95))
L <- unname(x.q[1])
U <- unname(x.q[2])
mid <- (L + U) / 2
slope <- 2.94 / (U - mid)
[Link] <- 1 / (1 + exp(-slope * (x - mid)))
return([Link])
}

35
[Link] <- [Link](x = gcd$maturity)
summary([Link])

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## 0.03842 0.10910 0.22097 0.33381 0.39652 0.99817
#compare distribution of the original and transformed values
par(mfrow = c(1, 2))
#original values
hist(x = gcd$age,
nclass = 30,
xlab = "Age",
main = "Original values")
#transformed values
hist(x = [Link],
nclass = 30,
xlab = "Age logistic function",
main = "Transformed values")

Original values Transformed values

80

150
60
Frequency

Frequency

100
40

50
20
0

20 40 60 0.0 0.2 0.4 0.6 0.8 1.0

Age Age logistic function

We will commence by implementing the following preparatory steps to demonstrate the usage of

36
specific functions from the PDtoolkit package.
#import PDtoolkit package
library(PDtoolkit)
#import dataset loans
data(loans)
#add missing values for risk factor "Credit Amount"
loans$"Credit Amount"[1:10] <- NA

Afterward, we can proceed with running the univariate function and display the results of the
first few records.
[Link] <- univariate(db = loans)
head([Link], 7)

## rf [Link] [Link] bin

## 1 Creditability numeric complete cases complete cases
## 2 Account Balance character complete cases complete cases
## 3 Duration of Credit (month) numeric complete cases complete cases
## 4 Payment Status of Previous Credit character complete cases complete cases
## 5 Purpose character complete cases complete cases
## 6 Credit Amount numeric special cases special cases
## 7 Credit Amount numeric complete cases complete cases
## cnt pct [Link] min p1 p5 p25 p50 avg [Link]
## 1 1000 1.00 2 0 0.00 0.00 0.00 0 0.300 0.01449863
## 2 1000 1.00 4 NA NA NA NA NA NA NA
## 3 1000 1.00 33 4 6.00 6.00 12.00 18 20.903 0.38133320
## 4 1000 1.00 5 NA NA NA NA NA NA NA
## 5 1000 1.00 10 NA NA NA NA NA NA NA
## 6 10 0.01 1 Inf NA NA NA NA NaN NA
## 7 990 0.99 915 250 424.13 708.45 1371.25 2324 3283.242 90.03256824
## p75 p95 p99 max neg pos [Link] [Link]
## 1 1.00 1.0 1.00 1 0 300 0 0
## 2 NA NA NA NA NA NA NA 0
## 3 24.00 48.0 60.00 72 0 1000 70 0
## 4 NA NA NA NA NA NA NA 0
## 5 NA NA NA NA NA NA NA 0
## 6 NA NA NA -Inf NA NA 0 0
## 7 3978.25 9219.7 14194.29 18424 0 990 72 0

Based on the results above, we will filter out only the risk factors with some share of special cases.

37
[Link][[Link]$[Link]%in%"special cases", ]

## rf [Link] [Link] bin cnt pct [Link] min p1

## 6 Credit Amount numeric special cases special cases 10 0.01 1 Inf NA
## p5 p25 p50 avg [Link] p75 p95 p99 max neg pos [Link] [Link]
## 6 NA NA NA NaN NA NA NA NA -Inf NA NA 0 0

We can observe that only the risk factor Credit Amount has ten observations with special values.
In the next step, we will utilize the function [Link] to replace these values with zeros. It is essential
to exercise greater caution in this step and provide a well-founded rationale for this substitution.
For demonstration purposes, let’s assume that Credit Amount refers to the exposure of mortgage
loans, and after thorough verification, we confirmed that missing values result from preparatory
data steps and merging data from various sources. Additionally, we verified that these few clients
have no mortgage loans, and substituting the missing values with zero is appropriate.
#impute for missing values for risk factor "Credit Amount"
[Link] <- [Link](db = loans[, c("Credit Amount"), drop = FALSE],
[Link] = NA,
[Link] = NA,
[Link] = "zero")

Let’s examine the imputation report and display the first 15 observations of the modified risk factor
Credit Amount:
#imputation report
[Link][2]

## $report
## rf info [Link] [Link]
## 1 Credit Amount Imputation completed. 0 0
## [Link]
## 1 10
#first 15 rows of "Credit Amount" (note zeros in first 10 rows)
[Link][[1]][1:15, , drop = FALSE]

## Credit Amount
## 1 0
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0

38
## 7 0
## 8 0
## 9 0
## 10 0
## 11 3905
## 12 6187
## 13 1957
## 14 7582
## 15 1936

Replace the original values of the risk factor Credit Amount with the imputed values.
loans$"Credit Amount" <- [Link][[1]][, "Credit Amount"]

In the next step, let’s check for outliers in the Age (years) risk factor.
[Link][[Link]$rf%in%"Age (years)", c("rf", "[Link]", "[Link]"),
drop = FALSE]

## rf [Link] [Link]
## 15 Age (years) numeric 23

Let’s apply the winsorization method and replace outliers with the minimum and maximum values
from the box plot method:
[Link] <- [Link](db = loans[, "Age (years)", drop = FALSE],
method = "iqr",
range = 1.5)

Review the imputation report, contrast the distributions of the original and transformed values,
and update the actual values for the risk factor Age (years) with the imputed values:
#imputation report
[Link]["report"]

## $report
## rf info [Link] [Link]
## 1 Age (years) Imputation completed. iqr 64
## [Link] [Link] [Link]
## 1 19 23 0
#compare distribution of the original and transformed values
par(mfrow = c(1, 2))
#original values
hist(x = loans$"Age (years)",

39
 nclass = 30,
xlab = "Age",
main = "Original values")
#transformed values
hist(x = [Link][[1]][, "Age (years)"],
nclass = 30,
xlab = "Age after winsorization",
main = "Transformed values")

Original values Transformed values

80

80
60

60
Frequency

Frequency
40

40
20

20
0

20 40 60 20 30 40 50 60

Age Age after winsorization

#summary statistics of original risk factor

summary(loans$"Age (years)")

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## 19.00 27.00 33.00 35.54 42.00 75.00
loans$"Age (years)" <- [Link][[1]][, "Age (years)"]
#summary statistics after winsorization
summary(loans$"Age (years)")

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## 19.00 27.00 33.00 35.44 42.00 64.00

40
As the histograms above show, winsorization has resulted in a noticeable peak at the distribution’s
tail. Hence, it is crucial to exercise particular care when addressing the task of outlier replacement.
After the imputation process, it is generally good practice to re-run the univariate analysis for the
risk factors that underwent transformations.
[Link] <- univariate(db = loans[, c("Credit Amount", "Age (years)")])
[Link]

## rf [Link] [Link] bin cnt pct [Link] min

## 1 Credit Amount numeric complete cases complete cases 1000 1 916 0
## 2 Age (years) numeric complete cases complete cases 1000 1 46 19
## p1 p5 p25 p50 avg [Link] p75 p95 p99 max
## 1 247.5 682.95 1350.75 2302.5 3250.410 89.7290477 3972.25 9162.7 14180.39 18424
## 2 20.0 22.00 27.00 33.0 35.438 0.3495259 42.00 60.0 64.00 64
## neg pos [Link] [Link]
## 1 0 990 72 0
## 2 0 1000 0 0

Finally, to identify risk factors with very low variability, we can utilize the nzv function from the
PDtoolkit package:
[Link] <- nzv(db = loans,
sc = c(NA, NaN, Inf, -Inf))

To identify the risk factors with the ratio between the most frequent value and the second most
frequent value greater than 19, we can use column [Link] (complete cases frequency ratio) from
the [Link] data frame:
[Link][[Link]$[Link] > 19, ]

## rf type [Link] [Link] [Link] [Link] [Link] [Link]

## 21 Foreign Worker categorical 0 0 1000 1 2 0.002
## [Link].1 [Link].1 [Link].2 [Link].2 [Link] ind
## 21 1 963 2 37 26.02703 0
table(loans$"Foreign Worker")

##
## 1 2
## 963 37

Risk factors identified in the procedure above should not be automatically excluded from the
further modeling process but should be subject to additional checks. Usually, this frequency ratio is
interpreted in conjunction with other metrics from the nzv results, such as [Link] (percentage of
special cases), [Link] (number of unique values in complete cases), or [Link] (ratio between

41
the number of unique values and the overall number of complete cases).

3.3 Bivariate analysis

After completing the univariate analysis, the subsequent step in model development involves
conducting the bivariate analysis. This analysis aims to investigate the relationship between the
target variable and individual risk factors or between two risk factors.

During the bivariate analysis, the following tasks are typically performed:

1. statistical and expert binning (discretization) of numeric risk factors;

2. statistical and expert binning of categorical risk factors;
3. examination of the standalone discriminatory power of the risk factors;
4. risk factor stability analysis;
5. risk factor correlation analysis.

The outcomes of these tasks result in the following:

1. creation of categorical risk factors through statistical and expert-based methods;

2. exclusion of risk factors based on binning, discriminatory power, stability, and correlation
analysis;
3. preparation of a short list of risk factors for multivariate analysis.

3.3.1 Statistical and expert binning of numeric risk factors

Binning is not a compulsory step in model development but offers advantages over the use of
continuous risk factors. According to Siddiqi (2017) the benefits are:

• reduction of the impact of outliers;

• easing the understanding of the relationship between risk factors and target variable;
• capturing the non-linear dependency with the linear model;
• allowing business judgment to be used;
• allowing the user to develop insights into the behavior of risk predictors and increases knowledge
of the portfolio.

In practice, the following principles define a good binning process:

• each bin should contain at least 5% of the observations;

• each bin should contain at least one bad case (modality of the target variable);
• adjacent bins should have different riskiness levels;
• risk level of the bins should have either a monotonic or U-shape trend;
• number of bins should not be greater than ten.

42
[Link] Monotonic binning

Monotonicity is typically a compulsory requirement in the binning process. To perform the monotonic
binning in R, we can utilize the packages monobin and monobinShiny. The monobinShiny package
serves as an add-on to monobin and simplifies its use by providing a web-based user interface.
However, this section will primarily focus on monobin and its functionalities. Let’s begin by
providing an overview of its algorithms.
#run if not installed
#[Link]("monobin")
library(monobin)
#list the binning algorithms from the monobin (all with suffix bin)
#running:
ls("package:monobin")

## [1] "[Link]" "gcd" "[Link]" "[Link]" "[Link]" "[Link]" "[Link]"

## [8] "[Link]"
#or:
help(package = "monobin")

Currently, monobin provides seven binning functions (algorithms), each of which outputs a list of
two elements: a binning summary table and the discretized risk factor. Before delving into specific
use cases, it is essential to highlight a couple of key points.

Firstly, none of the functions checks for a target rate per bin of 100%. Risk factors with such
characteristics are often considered proxies for the default indicator (target variable). These risk
factors exhibit suspiciously high discriminatory power and are therefore excluded from the further
modeling process.

Secondly, each function includes the argument [Link], which allows users to predefine the
expected relationship between the target and the analyzed risk factor. When passed as the default
(NA), the prevailing relationship trend will be determined based on the sign of the Spearman rank
correlation coefficients.

Additionally, each function handles special cases separately from so-called complete cases, and the
user can choose whether to group all special cases together or treat each one separately (using the
[Link] argument with options "together" and "separately").

Finally, most functions can accommodate requirements such as a minimum percentage of observations
and target rate. However, it should be noted that not all functions incorporate all principles of good
binning practice, as evident from the following functions’ pseudo-codes. Therefore, the final selection
of the binning algorithm should align with the specific binning requirements and the intended usage
of the results in the modeling process.

43
To demonstrate use cases, let’s begin by importing the gcd dataset, which is distributed with the
monobin package:
data(gcd)

Note that in the following pseudo-code nodes, we assume that the relationship trend between the
analyzed risk factor and the target variable is identified automatically by the algorithm.
An example of a use case for function [Link]:
#[Link] function
[Link] <- [Link](x = gcd$age,
y = gcd$qual,
g = 15)
names([Link])

## [1] "[Link]" "[Link]"

#summary table
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] so sg sb dist.g

## 1 01 (-Inf,34) 514 181 0.3521401 26.93774 19 33 1000 700 300 0.4757143
## 2 02 [34,Inf) 486 119 0.2448560 44.64198 34 75 1000 700 300 0.5242857
## dist.b woe iv.b type
## 1 0.6033333 -0.2376524 0.03032897 complete cases
## 2 0.3966667 0.2789405 0.03559812 complete cases
#woe trend visualization
main <- "WoE trend of the risk factor: age\nBinning method: [Link]"
[Link] <- min([Link][["[Link]"]]$woe)
[Link] <- max([Link][["[Link]"]]$woe)
barplot(height = [Link][["[Link]"]]$woe,
[Link] = [Link][["[Link]"]]$bin,
col = "red",
main = main,
xlab = "",
ylab = "WoE",
ylim = c(1.3 * [Link], 1.3 * [Link]),
las = 1,
[Link] = 0.65)

44
 WoE trend of the risk factor: age
Binning method: [Link]

0.3

0.2

0.1
WoE

0.0

−0.1

−0.2

−0.3

01 (−Inf,34) 02 [34,Inf)

#transformed risk factor

head([Link][["[Link]"]])

## [1] "01 (-Inf,34)" "02 [34,Inf)" "01 (-Inf,34)" "02 [34,Inf)" "02 [34,Inf)"
## [6] "02 [34,Inf)"

The pseudo-code for function [Link]:

1. define a number of starting groups `g`
2. split risk factor `x` in `g` equidistant groups
3. calculate the mean of the target variable `y` per each group defined in step 2
4. calculate the Spearman correlation coefficient
5. if the Spearman correlation coefficient is equal to 1 or -1,
then stop the process
6. if the Spearman correlation coefficient is not equal to 1 or -1,
then decrease the number of groups (`g`) for one and repeat steps 2 to 6
7. stop the process if the number of groups becomes equal to 1

An example of a use case for function [Link]:

45
#[Link] function
[Link] <- [Link](x = gcd$maturity,
y = gcd$qual,
[Link] = 0.05,
[Link] = 0.01)
names([Link])

## [1] "[Link]" "[Link]"

#summary table
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] type so sg

## 1 01 (-Inf,8) 87 9 0.1034483 5.908046 4 7 complete cases 1000 700
## 2 02 [8,12) 93 18 0.1935484 9.419355 8 11 complete cases 1000 700
## 3 03 [12,16) 251 62 0.2470120 12.812749 12 15 complete cases 1000 700
## 4 04 [16,27) 340 109 0.3205882 21.594118 16 26 complete cases 1000 700
## 5 05 [27,36) 59 20 0.3389831 29.389831 27 33 complete cases 1000 700
## 6 06 [36,45) 100 42 0.4200000 36.850000 36 42 complete cases 1000 700
## 7 07 [45,Inf) 70 40 0.5714286 50.514286 45 72 complete cases 1000 700
## sb dist.g dist.b woe iv.b
## 1 300 0.11142857 0.03000000 1.31218639 0.106849463
## 2 300 0.10714286 0.06000000 0.57981850 0.027334300
## 3 300 0.27000000 0.20666667 0.26731477 0.016929935
## 4 300 0.33000000 0.36333333 -0.09622803 0.003207601
## 5 300 0.05571429 0.06666667 -0.17946849 0.001965607
## 6 300 0.08285714 0.14000000 -0.52452447 0.029972827
## 7 300 0.04285714 0.13333333 -1.13497993 0.102688661
#woe trend visualization
main <- "WoE trend of the risk factor: maturity\nBinning method: [Link]"
[Link] <- min([Link][["[Link]"]]$woe)
[Link] <- max([Link][["[Link]"]]$woe)
barplot(height = [Link][["[Link]"]]$woe,
[Link] = [Link][["[Link]"]]$bin,
col = "red",
main = main,
xlab = "",
ylab = "WoE",
ylim = c(1.5 * [Link], 1.3 * [Link]),
las = 2,

46
 [Link] = 0.65)

WoE trend of the risk factor: maturity

Binning method: [Link]

1.5

1.0

0.5
WoE

0.0

−0.5

−1.0

−1.5
01 (−Inf,8)

02 [8,12)

03 [12,16)

04 [16,27)

05 [27,36)

06 [36,45)

07 [45,Inf)
#transformed risk factor
head([Link][["[Link]"]])

## [1] "04 [16,27)" "02 [8,12)" "03 [12,16)" "03 [12,16)" "03 [12,16)"
## [6] "02 [8,12)"

The pseudo-code for function [Link]:

1. identify the trend direction between the risk factor and the target
(Spearman correlation)
2. run isotonic regression and create a summary table on identified knots
3. check and correct bins for the minimum percentage of observations:
a) for increasing trend, perform merging of the current bin
with the following one
b) for decreasing trend, perform merging of the current bin
with the previous one
4. check and correct bins for the minimum target rate (percentage of defaults):
a) for increasing trend, perform merging of the current bin
with the following one

47
 b) for decreasing trend, perform merging of the current bin
with the previous one

An example of a use case for function [Link]:

#[Link] function
[Link] <- [Link](x = gcd$amount,
y = gcd$qual,
[Link] = 0.05,
[Link] = 0.01,
[Link] = 0.1)
names([Link])

## [1] "[Link]" "[Link]"

#summary table
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] type so

## 1 01 (-Inf,3914) 739 189 0.2557510 1919.352 250 3905 complete cases 1000
## 2 02 [3914,6758) 145 54 0.3724138 5121.938 3914 6742 complete cases 1000
## 3 03 [6758,Inf) 116 57 0.4913793 9570.397 6758 18424 complete cases 1000
## sg sb dist.g dist.b woe iv.b
## 1 700 300 0.78571429 0.63 0.2208734 0.03439314
## 2 700 300 0.13000000 0.18 -0.3254224 0.01627112
## 3 700 300 0.08428571 0.19 -0.8128117 0.08592581
#woe trend visualization
main <- "WoE trend of the risk factor: amount\nBinning method: [Link]"
[Link] <- min([Link][["[Link]"]]$woe)
[Link] <- max([Link][["[Link]"]]$woe)
barplot(height = [Link][["[Link]"]]$woe,
[Link] = [Link][["[Link]"]]$bin,
col = "red",
main = main,
xlab = "",
ylab = "WoE",
ylim = c(1.3 * [Link], 2 * [Link]),
las = 1,
[Link] = 0.65)

48
 WoE trend of the risk factor: amount
Binning method: [Link]
0.4

0.2

0.0

−0.2
WoE

−0.4

−0.6

−0.8

−1.0

01 (−Inf,3914) 02 [3914,6758) 03 [6758,Inf)

#WoE difference of adjacent bins

diff([Link][["[Link]"]]$woe)

## [1] -0.5462958 -0.4873893

#transformed risk factor
head([Link][["[Link]"]])

## [1] "01 (-Inf,3914)" "01 (-Inf,3914)" "01 (-Inf,3914)" "01 (-Inf,3914)"

## [5] "01 (-Inf,3914)" "01 (-Inf,3914)"

The pseudo-code for function [Link]:

1. identify the trend direction between the risk factor and the target
(Spearman correlation)
2. run isotonic regression and create a summary table on identified knots
3. check and correct bins for the minimum percentage of observations:
a) for increasing trend, perform merging of the current bin
with the following one
b) for decreasing trend, perform merging of the current bin
with the previous one
4. check and correct bins for the minimum target rate (percentage of defaults):

49
 a) for increasing trend, perform merging of the current bin
with the following one
b) for decreasing trend, perform merging of the current bin
with the previous one
5. check for WoE gap between adjacent bins:
a) if all absolute values of WoE gaps are greater than the WoE threshold
then stop the process
b) otherwise, merge bins with the smallest WoE gap and repeat step 5

An example of a use case for function [Link] (known as MAPE - Monotone Adjacent Pooling
Algorithm):
#[Link] function
[Link] <- [Link](x = gcd$age,
y = gcd$qual,
g = 15)
names([Link])

## [1] "[Link]" "[Link]"

#summary table
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] type so sg

## 1 01 (-Inf,25) 150 62 0.4133333 22.60000 19 24 complete cases 1000 700
## 2 02 [25,27) 89 32 0.3595506 25.55056 25 26 complete cases 1000 700
## 3 03 [27,30) 130 43 0.3307692 27.90000 27 29 complete cases 1000 700
## 4 04 [30,35) 178 55 0.3089888 31.89326 30 34 complete cases 1000 700
## 5 05 [35,Inf) 453 108 0.2384106 45.41722 35 75 complete cases 1000 700
## sb dist.g dist.b woe iv.b
## 1 300 0.12571429 0.2066667 -0.49709543 0.0402410587
## 2 300 0.08142857 0.1066667 -0.26998250 0.0068138439
## 3 300 0.12428571 0.1433333 -0.14258986 0.0027159973
## 4 300 0.17571429 0.1833333 -0.04244669 0.0003234034
## 5 300 0.49285714 0.3600000 0.31411533 0.0417324652
#woe trend visualization
main <- "WoE trend of the risk factor: age\nBinning method: [Link]"
[Link] <- min([Link][["[Link]"]]$woe)
[Link] <- max([Link][["[Link]"]]$woe)
barplot(height = [Link][["[Link]"]]$woe,
[Link] = [Link][["[Link]"]]$bin,

50
 col = "red",
main = main,
xlab = "",
ylab = "WoE",
ylim = c(1.5 * [Link], 1.4 * [Link]),
las = 1,
[Link] = 0.65)

WoE trend of the risk factor: age

Binning method: [Link]
0.4

0.2

0.0
WoE

−0.2

−0.4

−0.6

01 (−Inf,25) 02 [25,27) 03 [27,30) 04 [30,35) 05 [35,Inf)

#transformed risk factor

head([Link][["[Link]"]])

## [1] "01 (-Inf,25)" "05 [35,Inf)" "01 (-Inf,25)" "05 [35,Inf)" "05 [35,Inf)"
## [6] "05 [35,Inf)"

The pseudo-code for function [Link]:

1. define a number of starting groups `g`
2. split risk factor `x` in `g` equidistant groups
3. calculate the sum of target variable `y` per each group defined in step 2
4. identify the trend direction between risk factor and the target
(Spearman correlation)

51
5. order bins from step 2 based on identified trend:
a) for increasing the trend sum of `y` order based on decreasing values
of `x` groups
b) for decreasing trend sum of `y` order based on increasing values of
`x` groups
6. calculate cumulative default rate based on ordered `y` sums
7. find the maximum of the cumulative default rate
8. discard all `x` groups that appear before and the one from
the cumulative default rate from step 7
9. repeat the process until all `x` groups are discarded

An example of a use case for function [Link]:

#[Link] function
[Link] <- [Link](x = gcd$maturity,
y = gcd$qual,
[Link] = 0.05,
[Link] = 0.01,
[Link] = 0.05)
names([Link])

## [1] "[Link]" "[Link]"

#summary table
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] type

## 1 01 (-Inf,8) 87 9 0.1034483 5.908046 4 7 complete cases
## 2 02 [8,16) 344 80 0.2325581 11.895349 8 15 complete cases
## 3 03 [16,36) 399 129 0.3233083 22.746867 16 33 complete cases
## 4 04 [36,45) 100 42 0.4200000 36.850000 36 42 complete cases
## 5 05 [45,Inf) 70 40 0.5714286 50.514286 45 72 complete cases
## [Link] so sg sb dist.g dist.b woe iv.b
## 1 NA 1000 700 300 0.11142857 0.0300000 1.3121864 0.106849463
## 2 0.003932160 1000 700 300 0.37714286 0.2666667 0.3466246 0.038293766
## 3 0.003041824 1000 700 300 0.38571429 0.4300000 -0.1086883 0.004813339
## 4 0.034245734 1000 700 300 0.08285714 0.1400000 -0.5245245 0.029972827
## 5 0.025910825 1000 700 300 0.04285714 0.1333333 -1.1349799 0.102688661
#woe trend visualization
main <- "WoE trend of the risk factor: maturity\nBinning method: [Link]"
[Link] <- min([Link][["[Link]"]]$woe)

52
[Link] <- max([Link][["[Link]"]]$woe)
barplot(height = [Link][["[Link]"]]$woe,
[Link] = [Link][["[Link]"]]$bin,
col = "red",
main = main,
xlab = "",
ylab = "WoE",
ylim = c(1.4 * [Link], 1.5 * [Link]),
las = 1,
[Link] = 0.65)

WoE trend of the risk factor: maturity

Binning method: [Link]

1.5

1.0

0.5
WoE

0.0

−0.5

−1.0

−1.5

01 (−Inf,8) 02 [8,16) 03 [16,36) 04 [36,45) 05 [45,Inf)

#transformed risk factor

head([Link][["[Link]"]])

## [1] "03 [16,36)" "02 [8,16)" "02 [8,16)" "02 [8,16)" "02 [8,16)"
## [6] "02 [8,16)"

The pseudo-code for function [Link]:

1. identify the trend direction between the risk factor and the target
(Spearman correlation)

53
2. run isotonic regression and create a summary table on identified knots
3. check and correct bins for the minimum percentage of observations:
a) for increasing trend, perform merging of the current bin
with the following one
b) for decreasing trend, perform merging of the current bin
with the previous one
4. check and correct bins for the minimum target rate (percentage of defaults):
a) for increasing trend, perform merging of the current bin
with the following one
b) for decreasing trend, perform merging of the current bin
with the previous one
5. check for the p-value of two proportion test between adjacent bins:
a) if all p-values are less than the selected threshold, then stop the process
b) otherwise, merge bins with the highest p-value and repeat step 5

An example of a use case for function [Link]:

#[Link] function
[Link] <- [Link](x = gcd$amount,
y = gcd$qual,
[Link] = 0.05,
[Link] = 0.01,
[Link] = 0.05)
names([Link])

## [1] "[Link]" "[Link]"

#summary table
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] type so

## 1 01 (-Inf,3914) 739 189 0.2557510 1919.352 250 3905 complete cases 1000
## 2 02 [3914,Inf) 261 111 0.4252874 7099.031 3914 18424 complete cases 1000
## sg sb dist.g dist.b woe iv.b
## 1 700 300 0.7857143 0.63 0.2208734 0.03439314
## 2 700 300 0.2142857 0.37 -0.5461928 0.08505002
#woe trend visualization
main <- "WoE trend of the risk factor: amount\nBinning method: [Link]"
[Link] <- min([Link][["[Link]"]]$woe)
[Link] <- max([Link][["[Link]"]]$woe)
barplot(height = [Link][["[Link]"]]$woe,

54
 [Link] = [Link][["[Link]"]]$bin,
col = "red",
main = main,
xlab = "",
ylab = "WoE",
ylim = c(1.4 * [Link], 2 * [Link]),
las = 1,
[Link] = 0.65)

WoE trend of the risk factor: amount

Binning method: [Link]
0.4

0.2

0.0
WoE

−0.2

−0.4

−0.6

01 (−Inf,3914) 02 [3914,Inf)

#transformed risk factor

head([Link][["[Link]"]])

## [1] "01 (-Inf,3914)" "01 (-Inf,3914)" "01 (-Inf,3914)" "01 (-Inf,3914)"

## [5] "01 (-Inf,3914)" "01 (-Inf,3914)"

The pseudo-code for function [Link]:

1. identify the trend direction between the risk factor and the target
(Spearman correlation)
2. run isotonic regression and create a summary table on identified knots
3. check and correct bins for the minimum percentage of observations:

55
 a) for increasing trend, perform merging of the current bin
with the following one
b) for decreasing trend, perform merging of the current bin
with the previous one
4. check and correct bins for the minimum target rate (percentage of defaults):
a) for increasing trend, perform merging of the current bin
with the following one
b) for decreasing trend, perform merging of the current bin
with the previous one
5. create nested dummy variables based on bins from step 4
6. run stepwise logistic regression (backward elimination) on nested dummy
7. calculate boundaries of `x` for dummies selected in step 6

The function [Link] performs monotonic binning driven by a decision tree:

#[Link] function
[Link] <- [Link](x = gcd$amount,
y = gcd$qual,
g = 50,
[Link] = 0.05,
[Link] = 0.01)
names([Link])

## [1] "[Link]" "[Link]"

#summary table
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] type so

## 1 01 (-Inf,3915) 740 190 0.2567568 1922.047 250 3914 complete cases 1000
## 2 02 [3915,6199) 117 43 0.3675214 4834.043 3915 6187 complete cases 1000
## 3 03 [6199,7763) 65 25 0.3846154 6902.446 6199 7758 complete cases 1000
## 4 04 [7763,Inf) 78 42 0.5384615 10701.167 7763 18424 complete cases 1000
## sg sb dist.g dist.b woe iv.b
## 1 700 300 0.78571429 0.63333333 0.2155963 0.032852776
## 2 700 300 0.10571429 0.14333333 -0.3044329 0.011452475
## 3 700 300 0.05714286 0.08333333 -0.3772942 0.009881516
## 4 700 300 0.05142857 0.14000000 -1.0014485 0.088699728
#woe trend visualization
main <- "WoE trend of the risk factor: amount\nBinning method: [Link]"
[Link] <- min([Link][["[Link]"]]$woe)

56
[Link] <- max([Link][["[Link]"]]$woe)
barplot(height = [Link][["[Link]"]]$woe,
[Link] = [Link][["[Link]"]]$bin,
col = "red",
main = main,
xlab = "",
ylab = "WoE",
ylim = c(1.5 * [Link], 3 * [Link]),
las = 1,
[Link] = 0.65)

WoE trend of the risk factor: amount

Binning method: [Link]

0.5

0.0
WoE

−0.5

−1.0

−1.5
01 (−Inf,3915) 02 [3915,6199) 03 [6199,7763) 04 [7763,Inf)

#transformed risk factor

head([Link][["[Link]"]])

## [1] "01 (-Inf,3915)" "01 (-Inf,3915)" "01 (-Inf,3915)" "01 (-Inf,3915)"

## [5] "01 (-Inf,3915)" "01 (-Inf,3915)"

The pseudo-code for function [Link]:

1. identify the trend direction between the risk factor and the target
(Spearman correlation)

57
2. split analyzed risk factor in `g` equidistant groups
3. discard splitting knots that do not comply with an identified trend
4. for each split, calculate the Gini index
5. select split that refers to the minimum Gini index and create two nodes
6. repeat the process until the number of observations or minimum average rate
hit their selected threshold

The following code node provides a real-world simulation of the binning process. First, we will split
the dataset loans from the PDtoolkit package into training and testing sets. Note that this is
usually the first step in the modeling process (before the univariate analysis) and that different
sampling methods can be deployed. The most common methods are simple and stratified random
sampling. For this example, we will use simple random sampling. Then, we will perform the binning
of one of the selected numeric risk factors on the training dataset. Finally, we will process and
recode the same risk factor on the testing dataset. For the R demo of the above process, we will
use the [Link] function from the monobin package and the helper function [Link] from the
PDtoolkit package.
data(loans)
#training/testing dataset split
[Link] <- 0.7
nr <- nrow(loans)
[Link](357)
idx <- sample(x = 1:nr,
size = round([Link] * nr),
replace = FALSE)
[Link] <- loans[idx, ]
[Link] <- loans[-idx, ]
[Link](table([Link]$Creditability))

##
## 0 1
## 0.7014286 0.2985714
[Link](table([Link]$Creditability))

##
## 0 1
## 0.6966667 0.3033333
#discretize risk factor `age` on training dataset
[Link] <- [Link](y = [Link]$Creditability,
x = [Link]$"Age (years)")

58
[Link][["[Link]"]]

## bin no [Link] [Link] [Link] [Link] [Link] type

## 1 01 (-Inf,35) 384 139 0.3619792 27.13281 19 34 complete cases
## 2 02 [35,Inf) 316 70 0.2215190 45.03797 35 75 complete cases
## [Link] so sg sb dist.g dist.b woe iv.b
## 1 NA 700 491 209 0.4989817 0.6650718 -0.2873256 0.04772194
## 2 0.00002660274 700 491 209 0.5010183 0.3349282 0.4027264 0.06688887
#add discretized variable to [Link]
[Link]$age.b <- [Link][["[Link]"]]
[Link](table([Link]$age.b))

##
## 01 (-Inf,35) 02 [35,Inf)
## 0.5485714 0.4514286
#discretize variable `Age (years)` on testing dataset
mapping <- [Link]([Link] = [Link][["[Link]"]]$[Link],
[Link] = [Link][["[Link]"]]$[Link])
mapping

## [Link] [Link]
## 1 19 34
## 2 35 75
[Link]$age.b <- [Link](x = [Link]$"Age (years)",
mapping = mapping)
[Link](table([Link]$age.b))

##
## 01 (-Inf,35) 02 [35,Inf)
## 0.5433333 0.4566667

[Link] U-shape binning

In PD modeling, besides monotonicity, a U-shape trend is sometimes a desired property of the

relationship between the risk factor and the target variable. This relationship is present if we
find a point in our risk factor (usually called an inflection point), after which the relationship
changes direction. For example, the increasing trend is identified before the inflection point, and
the decreasing trend occurs after the inflection point, or vice versa. In practice, only a limited
number of risk factors are theoretically and business-supported for U-shape testing. Additionally,
the inflection point can be determined statistically, provided as an expert input, or defined through

59
a combination of these two approaches.
To demonstrate U-shape testing and binning in R, we will explore the functions [Link] and
[Link] from the PDtoolkit package. The initial step usually involves testing if a U-shape trend
exists. The function [Link] generates linear B-splines basis functions for specified knots (cutpoints
of the analyzed risk factor). It then employs these functions as input in the logistic regression and
examines the signs of the estimated coefficients. Let’s observe how this function operates on the
risk factor Credit Amount from the loans dataset.
data(loans)
[Link] <- [Link](x = loans$"Credit Amount",
y = loans$Creditability,
g = 5)
[Link]

## $candidates
## cp estimate.b1 estimate.b2 direction [Link] [Link].b1 [Link].b2
## 1 709.00 0.9440120 2.854889 FALSE 0.05 0.30438256 0.0028765526904
## 2 1413.00 -0.5669628 1.665814 TRUE 0.05 0.12072205 0.0003440711798
## 3 2319.50 -0.4085768 2.065598 TRUE 0.05 0.14536129 0.0000016694923
## 4 3777.75 -0.1345486 2.437031 TRUE 0.05 0.60017067 0.0000003247891
## 5 9157.00 0.7065009 3.078598 FALSE 0.05 0.01395294 0.0003613244450
## significance deviance
## 1 FALSE 1197.985
## 2 FALSE 1195.537
## 3 FALSE 1193.772
## 4 FALSE 1194.302
## 5 TRUE 1196.811
##
## $optimal
## NULL
##
## $[Link]
## NULL

As we can see, the function [Link] outputs a list of three elements. The first element (candidates
data frame) provides a summary for each of the testing knots (cp). It includes the estimated
coefficients next to the B-splines basis functions from the logistic regression (estimate.b1 and
estimate.b2), the direction check (direction), the selected coefficients’ significance level ([Link]),
the p-values of the estimated coefficients ([Link].b1 and [Link].b2), the coefficients’ joint
significance (significance), and the logistic regression deviance (deviance). The direction field
is set to TRUE if the tested knot’s estimated coefficients are of opposite signs, indicating that a

60
change in the trend has been identified. Furthermore, if both p-values of the estimated coefficients
are less than the selected p-value threshold, then significance is set to TRUE.
The optimal knot (inflection point) is reported as the second element of the output (optimal) only if
both direction and significance are identified as TRUE. If multiple knots satisfy these conditions,
the one with the lowest deviance is selected.
The same principle is applied for the output’s third element ([Link]), and it is returned
only in case of the existence of the optimal knot. Otherwise, both elements are empty.
If the optimal knot is not found, as in the above example, we can select it based solely on direction
and deviance. Alternatively, expert selection can be performed from the knots for which direction
is TRUE.
res <- [Link][["candidates"]]
direction.t <- res[res$direction, ]
direction.t$cp

## [1] 1413.00 2319.50 3777.75

[Link] <- direction.t$cp[direction.t$deviance%in%min(direction.t$deviance)]
[Link]

## [1] 2319.5

After defining the inflection point, we can proceed with binning. For this purpose, we will use the
function [Link], which supports all algorithms from the monobin package. In essence, procedures
from the monobin are implemented given the same inputs but on the opposite trend before and
after a given inflection point.
#u-shape binning
[Link] <- [Link](x = loans$"Credit Amount",
y = loans$Creditability,
knot = [Link],
method = "[Link]")
#summary table
[Link][["[Link]"]]

## bin no ng nb pct.o pct.g pct.b dr so sg sb

## 1 01 (-Inf,960) 109 73 36 0.109 0.10428571 0.1200000 0.3302752 1000 700 300
## 2 02 [960,1374) 144 100 44 0.144 0.14285714 0.1466667 0.3055556 1000 700 300
## 3 03 [1374,2320) 247 188 59 0.247 0.26857143 0.1966667 0.2388664 1000 700 300
## 4 04 [2320,3914) 239 189 50 0.239 0.27000000 0.1666667 0.2092050 1000 700 300
## 5 05 [3914,6758) 145 91 54 0.145 0.13000000 0.1800000 0.3724138 1000 700 300
## 6 06 [6758,Inf) 116 59 57 0.116 0.08428571 0.1900000 0.4913793 1000 700 300
## dist.g dist.b woe iv.b iv.s

61
## 1 0.10428571 0.1200000 -0.14035736 0.0022056156 0.1767595
## 2 0.14285714 0.1466667 -0.02631731 0.0001002564 0.1767595
## 3 0.26857143 0.1966667 0.31160666 0.0224060026 0.1767595
## 4 0.27000000 0.1666667 0.48242615 0.0498507021 0.1767595
## 5 0.13000000 0.1800000 -0.32542240 0.0162711200 0.1767595
## 6 0.08428571 0.1900000 -0.81281168 0.0859258066 0.1767595
#default rate visualization
barplot(height = [Link][[1]]$dr,
[Link] = [Link][[1]]$bin,
col = "red",
main = "Average default rate per bin",
xlab = "",
ylab = "Default rate",
ylim = c(0, 0.5),
las = 2,
[Link] = 0.65)

Average default rate per bin

0.5

0.4
Default rate

0.3

0.2

0.1

0.0
01 (−Inf,960)

02 [960,1374)

03 [1374,2320)

04 [2320,3914)

05 [3914,6758)

06 [6758,Inf)

#transformed risk factors

head([Link][["[Link]"]])

62
## [1] "02 [960,1374)" "04 [2320,3914)" "01 (-Inf,960)" "03 [1374,2320)"
## [5] "03 [1374,2320)" "03 [1374,2320)"

Combining the above functions with the [Link] function can effortlessly simulate the real-world
U-shape binning process on both the training and testing datasets.

3.3.2 Statistical and expert binning of categorical risk factors

In PD modeling, we almost always deal with combined data types - numeric and categorical.
Although the binning process is more common for numeric risk factors, sometimes we have to
perform similar statistical analyses on categorical ones. Examples of categorical risk factors can be
municipalities, geographical sub-regions, or the purpose of the loan. One characteristic of these risk
factors is a high number of modalities (unique values). Therefore, we usually perform statistical
or expert-based grouping of raw modalities or combine these two methods. The most common
approach is to combine expert-based and statistical grouping. This is usually done in two steps. In
the first step, we perform expert-based grouping, followed by assigning an order to each modality.
Then in the second step, we perform additional statistical grouping to meet the criteria of the
good binning process, such as the minimum number of observations and default rate per bin or the
maximum number of bins. We can also use statistical grouping to merge a special case bin with
one of the complete case bins. Let’s demonstrate how this can be done in R with the PDtoolkit
package.
data(loans)
#check modalities of risk factor "Purpose"
table(loans$Purpose)

##
## 0 1 10 2 3 4 5 6 8 9
## 234 103 12 181 280 12 22 50 9 97

We see that the risk factor Purpose has ten unique values, and in the first step of the expert-based
binning, we will group modalities 0 and 1, as well as modalities 9 and 10. As a result of this task,
we will create and add the new variable Purpose.1 to the loans dataset.
loans$Purpose.1 <- ifelse(loans$Purpose%in%0, 1,
ifelse(loans$Purpose%in%10, 9, loans$Purpose))
table(loans$Purpose.1)

##
## 1 2 3 4 5 6 8 9
## 337 181 280 12 22 50 9 109

In the second step, we will perform statistical binning with the following requirements:

63
 • each bin should have at least 5% of the observations;
• each bin should have at least 1% of defaults;
• the maximum number of bins should be five.

Additionally, we will assume that there is no expert-based order of the existing modalities of the
risk factor Purpose.1, so the binning will be performed based on the modalities sorted in increasing
order of the default rate.
purpose.b <- [Link](x = loans$Purpose.1,
y = loans$Creditability,
[Link] = 0.05,
[Link] = 0.01,
[Link] = 5,
[Link] = "dr")
purpose.b[["[Link]"]]

## bin no ng nb pct.o pct.g pct.b dr so sg sb

## 1 1 [8,3] 289 226 63 0.289 0.3228571 0.2100000 0.2179931 1000 700 300
## 2 2 [1] 337 231 106 0.337 0.3300000 0.3533333 0.3145401 1000 700 300
## 3 3 [2] 181 123 58 0.181 0.1757143 0.1933333 0.3204420 1000 700 300
## 4 4 [4,9] 121 78 43 0.121 0.1114286 0.1433333 0.3553719 1000 700 300
## 5 5 [5,6] 72 42 30 0.072 0.0600000 0.1000000 0.4166667 1000 700 300
## dist.g dist.b woe iv.b iv.s
## 1 0.3228571 0.2100000 0.43010241 0.048540129 0.08028416
## 2 0.3300000 0.3533333 -0.06831924 0.001594116 0.08028416
## 3 0.1757143 0.1933333 -0.09555652 0.001683615 0.08028416
## 4 0.1114286 0.1433333 -0.25178915 0.008033273 0.08028416
## 5 0.0600000 0.1000000 -0.51082562 0.020433025 0.08028416
table(purpose.b[["[Link]"]])

##
## 1 [8,3] 2 [1] 3 [2] 4 [4,9] 5 [5,6]
## 289 337 181 121 72

The criteria of the maximum number of bins in the function [Link] is achieved by the algorithm
merging adjacent bins to have minimal information value loss.
We sometimes perform this analysis on the risk factors that were already discretized using some
of the binning algorithms from the monobin package. The reason for this could be to match the
requested number of bins in case the binning process results in a large number of bins or to merge
the special cases with one of the bins from the complete cases.

64
3.3.3 Risk factor standalone discriminatory power analysis

Some of the risk factors that were subject to the binning process will not meet all the requested criteria
and will be excluded from the further process. We usually perform the standalone discriminatory
power analysis as the next step for the remaining risk factors. The most commonly used metric for
discriminatory power assessments is the Information Value (IV). We can employ the bivariate
function from the PDtoolkit package to calculate the information value in R as follows:
data(loans)
biv.a <- bivariate(db = loans,
target = "Creditability")
biv.a[["info"]]

## rf [Link]
## 1 Duration of Credit (month) 1
## 2 Credit Amount 1
## 3 Age (years) 1
## comment
## 1 Inappropriate class. It has to be one of: character, factor or logical.
## 2 Inappropriate class. It has to be one of: character, factor or logical.
## 3 Inappropriate class. It has to be one of: character, factor or logical.
head(biv.a[["results"]])

## rf bin no ng nb pct.o pct.g pct.b

## 1 Account Balance 1 274 139 135 0.274 0.19857143 0.45000000
## 2 Account Balance 2 269 164 105 0.269 0.23428571 0.35000000
## 3 Account Balance 3 63 49 14 0.063 0.07000000 0.04666667
## 4 Account Balance 4 394 348 46 0.394 0.49714286 0.15333333
## 5 Payment Status of Previous Credit 0 40 15 25 0.040 0.02142857 0.08333333
## 6 Payment Status of Previous Credit 1 49 21 28 0.049 0.03000000 0.09333333
## dr so sg sb dist.g dist.b woe iv.b iv.s
## 1 0.4927007 1000 700 300 0.19857143 0.45000000 -0.8180987 0.205693389 0.6660115
## 2 0.3903346 1000 700 300 0.23428571 0.35000000 -0.4013918 0.046446763 0.6660115
## 3 0.2222222 1000 700 300 0.07000000 0.04666667 0.4054651 0.009460853 0.6660115
## 4 0.1167513 1000 700 300 0.49714286 0.15333333 1.1762632 0.404410499 0.6660115
## 5 0.6250000 1000 700 300 0.02142857 0.08333333 -1.3581235 0.084074311 0.2932335
## 6 0.5714286 1000 700 300 0.03000000 0.09333333 -1.1349799 0.071882062 0.2932335
## auc
## 1 0.7077690
## 2 0.7077690
## 3 0.7077690

65
## 4 0.7077690
## 5 0.6268048
## 6 0.6268048

As we can see from the results above, the bivariate function processes only categorical risk factors;
hence it is usually used after the binning process. After running the [Link] binning algorithm for
three numeric risk factors, let’s repeat the same analysis.
#define numeric risk factors
[Link] <- c("Duration of Credit (month)", "Credit Amount", "Age (years)")
#perform binning using [Link] algorithm from the monobin package
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
monobin::[Link](x = loans[, x],
y = loans[, "Creditability"])[[2]])
#confirm data type
[Link](loans[, [Link]])

## Length Class Mode

## Duration of Credit (month) 1000 -none- character
## Credit Amount 1000 -none- character
## Age (years) 1000 -none- character
#run bivariate analysis again
biv.a <- bivariate(db = loans,
target = "Creditability")
biv.a[["info"]]

## data frame with 0 columns and 0 rows

tail(biv.a[["results"]])

## rf bin no ng nb pct.o pct.g pct.b dr so

## 72 No of dependents 1 845 591 254 0.845 0.84428571 0.84666667 0.3005917 1000
## 73 No of dependents 2 155 109 46 0.155 0.15571429 0.15333333 0.2967742 1000
## 74 Telephone 1 596 409 187 0.596 0.58428571 0.62333333 0.3137584 1000
## 75 Telephone 2 404 291 113 0.404 0.41571429 0.37666667 0.2797030 1000
## 76 Foreign Worker 1 963 667 296 0.963 0.95285714 0.98666667 0.3073728 1000
## 77 Foreign Worker 2 37 33 4 0.037 0.04714286 0.01333333 0.1081081 1000
## sg sb dist.g dist.b woe iv.b iv.s
## 72 700 300 0.84428571 0.84666667 -0.00281611 0.000006705024 0.00004339223
## 73 700 300 0.15571429 0.15333333 0.01540863 0.000036687203 0.00004339223
## 74 700 300 0.58428571 0.62333333 -0.06469132 0.002526042066 0.00637760503

66
## 75 700 300 0.41571429 0.37666667 0.09863759 0.003851562963 0.00637760503
## 76 700 300 0.95285714 0.98666667 -0.03486727 0.001178845755 0.04387741201
## 77 700 300 0.04714286 0.01333333 1.26291534 0.042698566256 0.04387741201
## auc
## 72 0.5011905
## 73 0.5011905
## 74 0.5195238
## 75 0.5195238
## 76 0.5169048
## 77 0.5169048

We can quickly inspect the standalone discriminatory power of the analyzed risk factors from the
above results.
unique(biv.a[["results"]][, c("rf", "iv.s")])

## rf iv.s
## 1 Account Balance 0.66601150335
## 5 Duration of Credit (month) 0.26770659621
## 9 Payment Status of Previous Credit 0.29323354739
## 14 Purpose 0.16919506567
## 24 Credit Amount 0.11944316082
## 26 Value Savings/Stocks 0.19600955690
## 31 Length of current employment 0.08643363103
## 36 Instalment per cent 0.02632209005
## 40 Sex & Marital Status 0.04467067763
## 44 Guarantors 0.03201932202
## 47 Duration in Current address 0.00358877319
## 51 Most valuable available asset 0.11263826241
## 55 Age (years) 0.10115938772
## 58 Concurrent Credits 0.05761454196
## 61 Type of apartment 0.08539292555
## 64 No of Credits at this Bank 0.01326652424
## 68 Occupation 0.00876276571
## 72 No of dependents 0.00004339223
## 74 Telephone 0.00637760503
## 76 Foreign Worker 0.04387741201

Risk factors with Information Value below a specific threshold are usually excluded from the further
modeling process. The standard threshold value typically selected is 0.1. However, excluding risk
factors solely based on their standalone discriminatory power is not mandatory. Alternatively,

67
all risk factors that successfully passed the binning process can be retained and used as input
for designing the multivariate analysis. While this step is frequently practiced, there is limited
substantial evidence suggesting that examining the discriminatory power of individual risk factors
provides meaningful insights into their multivariate relationship with the outcome. On the contrary,
this exclusion method may remove many high-quality risk factors. The subsequent sections will
provide additional information on the design and implementation of the multivariate analysis.

3.3.4 Risk factor stability analysis

In stability analysis, we do not explicitly establish a direct relationship between the analyzed risk
factor and the target variable or other risk factors. However, we place it within the context of
bivariate analysis because it is typically performed after the binning process. The main goal of
this analysis is to check if there is a significant shift in the distribution of risk factors between the
training dataset and the testing dataset or a more recent representative dataset. To measure this
shift in distribution, we commonly use the Population Stability Index (PSI), also known as the
Characteristic Stability Index (CSI) when used in this context. A standard threshold of 0.25 is
usually adopted, and risk factors with PSI values greater than this threshold are considered unstable
and require further treatment. In practice, we often exclude risk factors identified as unstable during
this procedure. Still, we can also analyze the reasons for instability and decide to keep all or some
of the risk factors for the multivariate analysis.
In addition to comparing the calculated PSI with the selected threshold, we can enhance stability
analysis with additional statistics. Two such statistics are discussed in Yurdakul (2018), which
include critical values of the z-score (based on the standard normal distribution) and chi-square
statistics (based on the chi-square distribution) adjusted to sample sizes of the datasets used to
calculate PSI. Another general approach involves calculating the bootstrapped p-value of PSI.
Let’s see how these approaches can be implemented in R. To begin, let’s create artificial training
and testing datasets.
data(loans)
#split on the training and the testing datasets
[Link](1122)
[Link] <- sample(x = 1:nrow(loans),
size = 700,
replace = FALSE)
training <- loans[[Link], ]
testing <- loans[-[Link], ]

Next, we will choose the Account Balance risk factor and apply the psi function from the PDtoolkit
package.

68
rf <- "Account Balance"
res <- psi(base = training[, rf],
target = testing[, rf],
alpha = 0.05)
res

## $res
## psi [Link] psi** [Link] ci
## 1 0.01001983 0.03347168 0.010515 0.03721299 0.95
##
## $tbl
## bin [Link] [Link] [Link] [Link] psi.b
## 1 1 194 0.27714286 80 0.2666667 0.0004036860
## 2 2 179 0.25571429 90 0.3000000 0.0070733907
## 3 3 45 0.06428571 18 0.0600000 0.0002956837
## 4 4 282 0.40285714 112 0.3733333 0.0022470672

The psi function returns a list of two elements. The first element contains the PSI value (in the
psi column) and the critical values of the statistical tests. After comparing the calculated PSI
value with the threshold of 0.25, we conclude that there is no significant shift in the distribution
of the analyzed risk factor between the training and testing datasets. For the statistical tests, we
compare the [Link] and [Link] values with the psi** value. In this specific case, both
values are greater than psi**, indicating that we cannot reject the null hypothesis, which suggests
no significant shift in the distribution of the analyzed risk factor between the training and testing
datasets. The second element of the output (tbl) provides a summary table on the modality level.
If the risk factor is numeric, the function discretizes it before calculating all metrics. The bin
argument in the psi function controls the number of groups for discretization.
To calculate the bootstrapped p-value for the PSI, we need to implement a custom function in R.
Despite the absence of a dedicated function for this purpose in the PDtoolkit package, we can
readily create one ourselves. In this example, we will set a PSI threshold of 0.10, typically indicating
a mild shift in the compared distributions.
#select a new risk factor
rf <- "Value Savings/Stocks"
#set PSI threshold
[Link] <- 0.10
#set the number of bootstrap samples
B <- 1000
#run the bootstrap procedure
[Link] <- nrow(testing)
[Link] <- rep(NA, B)

69
for (i in 1:B) {
[Link](i)
idx <- sample(x = 1:[Link],
size = [Link],
replace = TRUE)
[Link][i] <- psi(base = training[, rf],
target = testing[idx, rf],
alpha = 0.05)$res$psi
}
#histogram of the bootstrapped PSI values
hist(x = [Link],
main = "Histogram of bootstrapped PSI values",
xlab = "PSI")

Histogram of bootstrapped PSI values

200
150
Frequency

100
50
0

0.00 0.05 0.10 0.15

PSI

#calculate the p-value

mean([Link] < [Link])

## [1] 0.974

Considerable attention should be given to the execution and interpretation of the results of this

70
analysis when utilizing any sampling strategy to tackle imbalanced data. This is particularly crucial
when using the SMOTE method, as it directly impacts the distribution of risk factors. In such
instances, it is advisable to compare risk factor distributions between the original and sampled
training datasets to gain a deeper understanding and ultimately evaluate the effectiveness of the
chosen approach for mitigating imbalanced data.

3.3.5 Risk factor correlation analysis

We can examine the correlation between risk factors from both statistical and business perspectives.
From a statistical standpoint, the goal is to ensure the absence of multicollinearity, leading us to
often exclude risk factors that exhibit a high correlation with others. From a business viewpoint, our
objective is to ensure the robustness of the model and avoid selecting risk factors that describe the
client’s creditworthiness from the same aspect, irrespective of the statistical tests they have passed.
To achieve these goals, we employ different approaches at different stages of PD model development.
During the bivariate analysis, we typically begin with statistical analysis and then support the
final decision on risk factor exclusions with expert judgment and business inputs. One common
approach involves clustering risk factors based on a similarity (dissimilarity) matrix and selecting
each cluster’s most representative risk factors. This selection process often combines statistical
analysis, such as discriminatory power metrics or distance to cluster centroid, with expert judgment
based on existing credit risk processes within the bank.
Another approach involves expertly creating clusters of risk factors and subsequently using statistical
methods to select the most representative ones. This approach is particularly useful for non-retail
PD modeling, where we analyze creditworthiness based on financial indicators that pertain to various
aspects of business performance, such as liquidity, solvency, profitability, etc.
Considering this, we encourage incorporating overrides of the results from statistical analysis at
this stage. If we omit correlation analysis in the bivariate analysis, we typically address it in the
multivariate analysis through a well-designed risk factor selection process. This allows us to ensure
the robustness of the final PD model and prevent the inclusion of risk factors that may be highly
correlated or redundantly describe the client’s creditworthiness. Expert judgment and business
inputs are crucial in making informed decisions during this selection process.
We can use the function [Link] from the PDtoolkit package to perform this analysis in R.
This function conducts a hierarchical cluster analysis on a distance matrix of dissimilarities. Initially,
each risk factor is assigned to its own cluster, and then the algorithm proceeds iteratively by joining
the two most similar clusters until there is just one cluster. Suppose the number of clusters is not
supplied (argument k with default value NA). In that case, the algorithm will identify the optimal
number of clusters using the automatic elbow method, which minimizes the sum of squared within
the cluster distances. An important note here is that clustering algorithms usually require numeric
data input. Thus, we will first use additional helper functions ([Link] and [Link]) to
discretize numeric risk factors and then perform Weights of Evidence (WoE) encoding. This enables
us to implement the clustering analysis in R effectively.

71
data(loans)
[Link] <- c("Duration of Credit (month)", "Credit Amount", "Age (years)")
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
[Link](x = loans[, x],
y = loans[, "Creditability"])[[2]])
#replace woe in order to convert to numeric data type
[Link] <- [Link](db = loans,
target = "Creditability")[[1]]
cr <- [Link](db = [Link][, -which(names([Link])%in%"Creditability")],
metric = "raw spearman",
k = NA)
cr

## rf clusters [Link]
## 1 Account Balance 1 0.000000
## 2 Credit Amount 2 1.209957
## 4 Most valuable available asset 2 1.211659
## 6 Type of apartment 2 1.268112
## 5 Occupation 2 1.390810
## 3 Duration of Credit (month) 2 1.801565
## 8 Payment Status of Previous Credit 3 1.593498
## 7 No of Credits at this Bank 3 1.631908
## 9 Purpose 4 0.000000
## 10 Value Savings/Stocks 5 0.000000
## 11 Length of current employment 6 0.000000
## 12 Instalment per cent 7 0.000000
## 13 Sex & Marital Status 8 0.000000
## 14 Guarantors 9 0.000000
## 15 Duration in Current address 10 0.000000
## 16 Age (years) 11 0.000000
## 17 Concurrent Credits 12 0.000000
## 18 No of dependents 13 0.000000
## 19 Telephone 14 0.000000
## 20 Foreign Worker 15 0.000000
#select one risk factor per cluster with min distance to the centroid
cr %>% group_by(clusters) %>%
slice([Link]([Link]))

## # A tibble: 15 x 3

72
## # Groups: clusters [15]
## rf clusters [Link]
## <chr> <int> <dbl>
## 1 Account Balance 1 0
## 2 Credit Amount 2 1.21
## 3 Payment Status of Previous Credit 3 1.59
## 4 Purpose 4 0
## 5 Value Savings/Stocks 5 0
## 6 Length of current employment 6 0
## 7 Instalment per cent 7 0
## 8 Sex & Marital Status 8 0
## 9 Guarantors 9 0
## 10 Duration in Current address 10 0
## 11 Age (years) 11 0
## 12 Concurrent Credits 12 0
## 13 No of dependents 13 0
## 14 Telephone 14 0
## 15 Foreign Worker 15 0
#add information value (IV) and
#select risk factors with the highest IV per cluster
biv.a <- bivariate(db = loans,
target = "Creditability")[[1]]
cr <- merge(x = cr,
y = unique(biv.a[, c("rf", "iv.s")]),
by = "rf",
all.x = TRUE)
cr %>% group_by(clusters) %>%
slice([Link](iv.s))

## # A tibble: 15 x 4
## # Groups: clusters [15]
## rf clusters [Link] iv.s
## <chr> <int> <dbl> <dbl>
## 1 Account Balance 1 0 0.666
## 2 Duration of Credit (month) 2 1.80 0.283
## 3 Payment Status of Previous Credit 3 1.59 0.293
## 4 Purpose 4 0 0.169
## 5 Value Savings/Stocks 5 0 0.196
## 6 Length of current employment 6 0 0.0864

73
## 7 Instalment per cent 7 0 0.0263
## 8 Sex & Marital Status 8 0 0.0447
## 9 Guarantors 9 0 0.0320
## 10 Duration in Current address 10 0 0.00359
## 11 Age (years) 11 0 0.101
## 12 Concurrent Credits 12 0 0.0576
## 13 No of dependents 13 0 0.0000434
## 14 Telephone 14 0 0.00638
## 15 Foreign Worker 15 0 0.0439

Referring to the help page of the [Link] function, we observe that various metrics (specified
using the function argument metric) can be employed to compute the dissimilarity distance matrix.
It is worth noting that all metrics, except the x2y, necessitate risk factors to be numeric. Therefore,
we can perform cluster analysis using the x2y metric even after creating the modeling dataset. The
x2y metric does not provide a symmetric measure of the correlation coefficient. It utilizes the
Classification And Regression Tree (CART) as the underlying method for calculating the correlation
coefficient. Since the x2y metric is not symmetric, the [Link] function computes the distance
matrix using the mean of correlation coefficients from rf.1 to rf.2 and rf.2 to rf.1. Due to
its underlying CART method, this approach works for all types of variables. However, one of the
weaknesses of this metric is the processing time, especially when many risk factors are used as
inputs for the dissimilarity distance matrix calculation. Thus, deploying this metric requires proper
preparation and execution. For more comprehensive information regarding this particular metric,
we direct readers to the help page of the [Link] function.
The following example demonstrates how to perform risk factor clustering based on the x2y metric
using the loans dataset.
data(loans)
str(loans)

## '[Link]': 1000 obs. of 21 variables:

## $ Creditability : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Account Balance : chr "1" "1" "2" "1" ...
## $ Duration of Credit (month) : num 18 9 12 12 12 10 8 6 18 24 ...
## $ Payment Status of Previous Credit: chr "4" "4" "2" "4" ...
## $ Purpose : chr "2" "0" "9" "0" ...
## $ Credit Amount : num 1049 2799 841 2122 2171 ...
## $ Value Savings/Stocks : chr "1" "1" "2" "1" ...
## $ Length of current employment : chr "2" "3" "4" "3" ...
## $ Instalment per cent : chr "4" "2" "2" "3" ...
## $ Sex & Marital Status : chr "2" "3" "2" "3" ...
## $ Guarantors : chr "1" "1" "1" "1" ...

74
## $ Duration in Current address : chr "4" "2" "4" "2" ...
## $ Most valuable available asset : chr "2" "1" "1" "1" ...
## $ Age (years) : num 21 36 23 39 38 48 39 40 65 23 ...
## $ Concurrent Credits : chr "3" "3" "3" "3" ...
## $ Type of apartment : chr "1" "1" "1" "1" ...
## $ No of Credits at this Bank : chr "1" "2" "1" "2" ...
## $ Occupation : chr "3" "3" "2" "2" ...
## $ No of dependents : chr "1" "2" "1" "2" ...
## $ Telephone : chr "1" "1" "1" "1" ...
## $ Foreign Worker : chr "1" "1" "1" "2" ...
#risk factors clustering using x2y metric
cr <- [Link](db = loans[, -which(names(loans)%in%"Creditability")],
metric = "x2y",
k = NA)
cr

## rf clusters [Link]
## 1 Account Balance 1 0.000000
## 2 Age (years) 2 0.000000
## 3 Concurrent Credits 3 0.000000
## 4 Credit Amount 4 1.021498
## 5 Duration of Credit (month) 4 1.624727
## 6 Duration in Current address 5 0.000000
## 7 Foreign Worker 6 0.000000
## 8 Guarantors 7 0.000000
## 9 Instalment per cent 8 0.000000
## 10 Length of current employment 9 0.000000
## 11 Most valuable available asset 10 0.000000
## 13 Payment Status of Previous Credit 11 1.453024
## 12 No of Credits at this Bank 11 1.467936
## 14 No of dependents 12 0.000000
## 15 Occupation 13 0.000000
## 16 Purpose 14 0.000000
## 17 Sex & Marital Status 15 0.000000
## 18 Telephone 16 0.000000
## 19 Type of apartment 17 0.000000
## 20 Value Savings/Stocks 18 0.000000
#select per cluster risk factor with the shortest distance to the centroid
cr %>% group_by(clusters) %>%

75
slice([Link]([Link]))

## # A tibble: 18 x 3
## # Groups: clusters [18]
## rf clusters [Link]
## <chr> <int> <dbl>
## 1 Account Balance 1 0
## 2 Age (years) 2 0
## 3 Concurrent Credits 3 0
## 4 Credit Amount 4 1.02
## 5 Duration in Current address 5 0
## 6 Foreign Worker 6 0
## 7 Guarantors 7 0
## 8 Instalment per cent 8 0
## 9 Length of current employment 9 0
## 10 Most valuable available asset 10 0
## 11 Payment Status of Previous Credit 11 1.45
## 12 No of dependents 12 0
## 13 Occupation 13 0
## 14 Purpose 14 0
## 15 Sex & Marital Status 15 0
## 16 Telephone 16 0
## 17 Type of apartment 17 0
## 18 Value Savings/Stocks 18 0

3.4 Multivariate analysis

After completing the bivariate analysis, the next step in PD modeling involves multivariate analysis.
This analysis aims to define the final risk differentiation function, which entails selecting the most
appropriate risk factors from a shortlist of candidates that have passed prior analyses. The most
common statistical method for multivariate analysis is logistic regression; thus, this section will be
mainly dedicated to its usage within the different model designs.

In the modern PD modeling framework, the final multivariate model rarely results from autopiloted
regression methods like stepwise procedures. Instead, we design our stepwise process to incorporate
different statistical and business requirements. For instance, a critical statistical requirement involves
considering the expected sign of the estimated coefficient. If the estimated coefficients from the
multivariate analysis exhibit an opposite sign compared to the trend identified in the bivariate
analysis, it may indicate the presence of multicollinearity.
Despite ensuring the exclusion of highly correlated risk factors in previous modeling steps, no fixed
threshold for correlation can guarantee the elimination of multicollinearity issues during multivariate

76
analysis. Consequently, addressing this concern becomes an essential aspect of the customized
stepwise process.

In addition to meeting statistical requirements, the modeling process often necessitates the incorpo-
ration of various business inputs, as the ultimate goal of the model is to support existing or future
bank processes. Including these inputs in our customized stepwise procedure increases the likelihood
of certain risk factors being included in the final risk differentiation function. One such example of
business input is the prioritized list of risk factors.

Another crucial business requirement is the need for the PD model to reflect and score the client’s
performance in different business areas, such as solvency, liquidity, profitability, or others, especially
in the non-retail portfolio. To meet this requirement, we can employ the blockwise or modular risk
factor selection design, which facilitates a thorough consideration of these specific business aspects.
For a more in-depth understanding of different blockwise selection methods, refer to the work by
Anderson (2022).
These additional business requirements have been collectively termed the risk profile concept by
Siddiqi (2017), providing valuable insights into the significance of incorporating business-driven
elements into the modeling process.

The PDtoolkit package offers a range of algorithms for customized stepwise logistic re-
gressions, providing practical applications in real-world scenarios.
Let’s begin by discussing the stepFWD function. As indicated by the FWD in its name, this function
executes a forward selection process of risk factors, considering their p-value, expected coefficient
sign, and trend. It’s essential to note that stepFWD exclusively operates on categorical risk factors
and supports either Weights of Evidence (WoE) or dummy encoding. This means that before
running the stepFWD function, we need to perform binning for our numeric risk factors, with the
encoding process handled internally by the algorithm.

While WoE has recently become a widely adopted standard approach, it’s not uncommon to
encounter models that incorporate mixed risk factor encoding. The following code node exemplifies
the use of this function:
data(loans)
#define the target variable
target <- "Creditability"
#identify numeric risk factors
[Link] <- sapply(X = loans, FUN = [Link])
[Link] <- names([Link])[!names([Link])%in%target & [Link]]
#discretize the numeric risk factors using [Link] from the monobin package
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
[Link](x = loans[, x], y = loans[, target])[[2]])

77
#run stepFWD
rfm <- paste(target, " ~ 1")
res <- stepFWD([Link] = [Link](rfm),
[Link] = 0.05,
coding = "WoE",
db = loans)
#check the output
names(res)

## [1] "model" "steps" "warnings" "[Link]"

#print the final model
summary(res$model)$coefficients

## Estimate Std. Error z value

## (Intercept) -0.8547612 0.08410677 -10.162811
## Account_Balance -0.8178512 0.10545572 -7.755399
## Duration_of_Credit__month -0.6890414 0.19012993 -3.624055
## Payment_Status_of_Previous_Credit -0.7647498 0.15570583 -4.911504
## Purpose -0.9954891 0.20796242 -4.786870
## Value_Savings_Stocks -0.8025048 0.20015701 -4.009377
## Length_of_current_employment -0.6355607 0.28829249 -2.204569
## Instalment_per_cent -2.0279862 0.54639785 -3.711556
## Credit_Amount -0.7824906 0.28264138 -2.768493
## Age__years -0.7099874 0.26868479 -2.642455
## Sex___Marital_Status -1.0321091 0.40080603 -2.575084
## Guarantors -1.0021026 0.44585850 -2.247580
## Duration_in_Current_address -3.4603174 1.37808336 -2.510964
## Most_valuable_available_asset -0.5488483 0.26242312 -2.091463
## Pr(>|z|)
## (Intercept) 0.000000000000000000000002905754
## Account_Balance 0.000000000000008806625860542650
## Duration_of_Credit__month 0.000290019632586644500633898947
## Payment_Status_of_Previous_Credit 0.000000903805708117542536735728
## Purpose 0.000001694022294845475235056803
## Value_Savings_Stocks 0.000060879280043653676238873951
## Length_of_current_employment 0.027484352144808318202384711526
## Instalment_per_cent 0.000205989185833339177606610138
## Credit_Amount 0.005631626675456159573929237894
## Age__years 0.008230743105964815481412344411

78
## Sex___Marital_Status 0.010021581619213326339035141643
## Guarantors 0.024602987159298574104671075702
## Duration_in_Current_address 0.012040203783037899468166820327
## Most_valuable_available_asset 0.036486561088916291684114412419
#print the summary of algorithm steps
res$steps

## rf aic [Link] [Link]

## 1 Account_Balance 1094.3927 1.312262e-25 TRUE
## 2 Duration_of_Credit__month 1051.4923 2.620064e-10 TRUE
## 3 Payment_Status_of_Previous_Credit 1024.9347 1.823280e-07 TRUE
## 4 Purpose 999.8925 4.379256e-07 TRUE
## 5 Value_Savings_Stocks 984.8700 6.840451e-05 TRUE
## 6 Length_of_current_employment 977.4074 2.141611e-03 TRUE
## 7 Instalment_per_cent 972.1846 7.588168e-03 TRUE
## 8 Credit_Amount 964.6909 2.054318e-03 TRUE
## 9 Age__years 959.0002 5.543110e-03 TRUE
## 10 Sex___Marital_Status 955.1948 1.586175e-02 TRUE
## 11 Guarantors 951.3269 1.705574e-02 TRUE
## 12 Duration_in_Current_address 947.0918 1.325940e-02 TRUE
## 13 Most_valuable_available_asset 944.7049 3.648656e-02 TRUE
## [Link]
## 1 TRUE
## 2 TRUE
## 3 TRUE
## 4 TRUE
## 5 TRUE
## 6 TRUE
## 7 TRUE
## 8 TRUE
## 9 TRUE
## 10 TRUE
## 11 TRUE
## 12 TRUE
## 13 TRUE

The same procedure can also be carried out using the dummy encoding (specified by the function
argument coding) for the risk factors. In this scenario, the statistical significance of the risk factor
is determined through the multiple Wald test, involving hypothesis testing of all factor modalities
included in the regression. The resulting p-value is then compared to the chosen p-value threshold.

79
Although the stepFWD function performs checks based on p-values and trend, it does not incorporate
any business inputs, such as prioritizing risk factor groups that should enter the model. To meet
this requirement, we can turn to the stepRPC function (where RPC stands for Risk Profile Concept).

In the following example, let’s assume we have formed three priority groups out of a total of 20 risk
factors (stored in the data frame [Link] as illustrated below).

Essentially, the stepRPC function runs the stepFWD algorithm on the first priority group, selecting
the “best” risk factors and retaining them as a starting model. The process then moves on to the
next priority group, and so forth, with risk factors chosen in the previous groups always remaining
in the model.

In practice, significant attention is paid to risk factor grouping, as this input typically results from
the alignment between business and modeling units within the bank.
data(loans)
#define the target variable
target <- "Creditability"
#identify numeric risk factors
[Link] <- sapply(X = loans, FUN = [Link])
[Link] <- names([Link])[!names([Link])%in%target & [Link]]
#discretize the numeric risk factors using [Link] from the monobin package
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
[Link](x = loans[, x], y = loans[, target])[[2]])
#prioritized risk factors
[Link] <- names(loans)[!names(loans)%in%target]
[Link](591)
[Link] <- [Link](rf = [Link],
group = sample(x = 1:3,
size = length([Link]),
replace = TRUE))
[Link] <- [Link][order([Link]$group), ]
[Link]

## rf group
## 2 Duration of Credit (month) 1
## 6 Value Savings/Stocks 1
## 7 Length of current employment 1
## 13 Age (years) 1
## 18 No of dependents 1
## 20 Foreign Worker 1

80
## 1 Account Balance 2
## 3 Payment Status of Previous Credit 2
## 5 Credit Amount 2
## 9 Sex & Marital Status 2
## 10 Guarantors 2
## 11 Duration in Current address 2
## 12 Most valuable available asset 2
## 14 Concurrent Credits 2
## 16 No of Credits at this Bank 2
## 17 Occupation 2
## 4 Purpose 3
## 8 Instalment per cent 3
## 15 Type of apartment 3
## 19 Telephone 3
#run stepRPC
rfm <- paste(target, " ~ 1")
res <- stepRPC([Link] = [Link](rfm),
[Link] = [Link],
[Link] = 0.05,
coding = "WoE",
db = loans)
#print the final model
summary(res$model)$coefficients

## Estimate Std. Error z value

## (Intercept) -0.8551709 0.08372306 -10.214282
## Duration_of_Credit__month -0.9045211 0.17514066 -5.164541
## Value_Savings_Stocks -0.8049463 0.19938416 -4.037163
## Length_of_current_employment -0.6412960 0.28768144 -2.229188
## Age__years -0.6614044 0.26691178 -2.477989
## Account_Balance -0.8183317 0.10504401 -7.790370
## Most_valuable_available_asset -0.6841591 0.25575517 -2.675055
## Payment_Status_of_Previous_Credit -0.7595384 0.15490138 -4.903367
## Guarantors -1.0462517 0.44324994 -2.360410
## Duration_in_Current_address -3.7306527 1.36658340 -2.729912
## Sex___Marital_Status -0.9225941 0.39650255 -2.326830
## Purpose -0.9633101 0.20669231 -4.660600
## Instalment_per_cent -1.5162033 0.50935863 -2.976691
## Pr(>|z|)

81
## (Intercept) 0.00000000000000000000000171142
## Duration_of_Credit__month 0.00000024102948022733797985191
## Value_Savings_Stocks 0.00005410154940313382956711130
## Length_of_current_employment 0.02580140599921532107430266478
## Age__years 0.01321253483997614566747280662
## Account_Balance 0.00000000000000668134452494785
## Most_valuable_available_asset 0.00747170578168208313757370220
## Payment_Status_of_Previous_Credit 0.00000094207674207241482158479
## Guarantors 0.01825473739539220513483641639
## Duration_in_Current_address 0.00633511978272064454204004491
## Sex___Marital_Status 0.01997431237212436705430462780
## Purpose 0.00000315289644319895134708456
## Instalment_per_cent 0.00291377440109889633557127553
#print summary of algorithm steps
res$steps

## group rf aic
## 1 1 Duration_of_Credit__month 1172.1296
## 2 1 Value_Savings_Stocks 1132.6988
## 3 1 Length_of_current_employment 1116.7170
## 4 1 Age__years 1109.8158
## 5 2 Account_Balance 1021.4719
## 6 2 Most_valuable_available_asset 1012.3524
## 7 2 Payment_Status_of_Previous_Credit 991.1211
## 8 2 Guarantors 985.9664
## 9 2 Duration_in_Current_address 981.2804
## 10 2 Sex___Marital_Status 978.0497
## 11 3 Purpose 957.3777
## 12 3 Instalment_per_cent 950.3659
## [Link] [Link] [Link]
## 1 0.0000000000063954667489995 TRUE TRUE
## 2 0.0000000018308497831410842 TRUE TRUE
## 3 0.0000244679277880111532839 TRUE TRUE
## 4 0.0027839631396311746540373 TRUE TRUE
## 5 0.0000000000000000005832726 TRUE TRUE
## 6 0.0009156221095528962105811 TRUE TRUE
## 7 0.0000023483344056389425778 TRUE TRUE
## 8 0.0084039505271077240972089 TRUE TRUE
## 9 0.0103591299882148813599203 TRUE TRUE

82
## 10 0.0218901337401732065668369 TRUE TRUE
## 11 0.0000035446699301119897203 TRUE TRUE
## 12 0.0029137744010988963355713 TRUE TRUE

The above example can be readily adapted to create priority groups based on individual risk factors.
In such a scenario, the risk factors are tested in the specified order, maintaining their given sequence.
A simple modification is required in the input [Link] to achieve this.

In the following context, we explore a situation where risk factors are sorted based on their Area
Under the ROC2 Curve (AUC) values, ranging from the lowest to the highest. Subsequently, we
re-run the stepRPC function to incorporate this new risk factor ordering.
#bring AUC value to [Link]
bva <- bivariate(db = loans, target = target)[[1]]
[Link] <- unique(bva[, c("rf", "auc")])
[Link] <- merge(x = [Link],
y = [Link],
by = "rf",
all.x = TRUE)
#prioritized risk factors
[Link] <- [Link][order([Link]$auc), ]
#override existing groups to make them on the risk factor level
[Link]$group <- 1:nrow([Link])
[Link]

## rf group auc
## 13 No of dependents 1 0.5011905
## 5 Duration in Current address 2 0.5161786
## 7 Foreign Worker 3 0.5169048
## 18 Telephone 4 0.5195238
## 14 Occupation 5 0.5214429
## 8 Guarantors 6 0.5256524
## 12 No of Credits at this Bank 7 0.5260571
## 9 Instalment per cent 8 0.5433833
## 3 Concurrent Credits 9 0.5481857
## 17 Sex & Marital Status 10 0.5524238
## 19 Type of apartment 11 0.5680619
## 4 Credit Amount 12 0.5778571
## 10 Length of current employment 13 0.5808190
## 2 Age (years) 14 0.5837619
2
Receiver Operating Characteristics

83
## 11 Most valuable available asset 15 0.5853286
## 20 Value Savings/Stocks 16 0.5991429
## 16 Purpose 17 0.6108571
## 6 Duration of Credit (month) 18 0.6241762
## 15 Payment Status of Previous Credit 19 0.6268048
## 1 Account Balance 20 0.7077690
#run stepRPC
res.1 <- stepRPC([Link] = [Link](rfm),
[Link] = [Link],
[Link] = 0.05,
coding = "WoE",
db = loans)
#print the final model
summary(res.1$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.8500867 0.08008649 -10.614607 2.548638e-26
## Foreign_Worker -1.2435125 0.43785856 -2.839987 4.511541e-03
## Guarantors -1.0728191 0.42885606 -2.501583 1.236394e-02
## Instalment_per_cent -1.4381332 0.48737849 -2.950752 3.170011e-03
## Concurrent_Credits -1.0054181 0.31879369 -3.153821 1.611481e-03
## Sex___Marital_Status -0.7786371 0.37789878 -2.060438 3.935667e-02
## Type_of_apartment -0.8287765 0.26468583 -3.131170 1.741110e-03
## Length_of_current_employment -0.6763967 0.26826415 -2.521383 1.168945e-02
## Value_Savings_Stocks -0.7272509 0.18717434 -3.885420 1.021531e-04
## Purpose -0.8337129 0.19648580 -4.243120 2.204331e-05
## Account_Balance -0.8986312 0.10106221 -8.891862 6.009345e-19
#print summary of algorithm steps
res.1$steps

## group rf aic [Link]

## 1 3 Foreign_Worker 1217.656 0.0150871191494758062623394
## 2 6 Guarantors 1213.250 0.0126757546720711652271651
## 3 8 Instalment_per_cent 1210.636 0.0324179991592217914275764
## 4 9 Concurrent_Credits 1199.866 0.0002984411635862531972201
## 5 10 Sex___Marital_Status 1189.823 0.0005033905703734858991943
## 6 11 Type_of_apartment 1173.808 0.0000196618210859994070657
## 7 13 Length_of_current_employment 1161.402 0.0001550151305738056391800
## 8 16 Value_Savings_Stocks 1126.534 0.0000000109918592688327890

84
## 9 17 Purpose 1102.775 0.0000008047091774221620048
## 10 20 Account_Balance 1014.675 0.0000000000000000006009345
## [Link] [Link]
## 1 TRUE TRUE
## 2 TRUE TRUE
## 3 TRUE TRUE
## 4 TRUE TRUE
## 5 TRUE TRUE
## 6 TRUE TRUE
## 7 TRUE TRUE
## 8 TRUE TRUE
## 9 TRUE TRUE
## 10 TRUE TRUE

The previous examples show that both functions are tailored for categorical risk factors, and the
encoding process occurs within the functions’ procedures. While some level of control over mixing
numeric and categorical risk factors within the same model can be achieved using function arguments
like [Link], [Link], and [Link], full flexibility is still limited.

To overcome these constraints, we can employ the functions stepFWDr and stepRPCr, which operate
effectively on all types of risk factors. Furthermore, the advantage of using these functions is that
any necessary risk factor transformations can be performed outside of the stepwise procedure. This
approach becomes particularly significant when working exclusively with categorical risk factors
and implementing specific strategies for addressing special cases.

For instance, let’s consider a scenario where for certain risk factors, we keep special cases as a
separate modality during our binning process, and we use regression with WoE encoding. In such
cases, the special case bin may contain only good or bad observations, rendering WoE calculations
impossible, leading to -Inf or Inf values. To address this, we can adopt a strategy to replace -Inf
and Inf with WoE values derived from the most and least risky bins, respectively.

Implementing this strategy involves first discretizing the numeric risk factors, then checking and, if
necessary, correcting the WoE of the special case bin, before finally estimating the model using the
WoE encoding of risk factors. The following code node exemplifies the described strategy in action.
data(loans)
#artificially created some missing values for "Age (years)"
loans$"Age (years)"[1:20] <- NA
#define the target variable
target <- "Creditability"
#identify numeric risk factors
[Link] <- sapply(X = loans, FUN = [Link])

85
[Link] <- names([Link])[!names([Link])%in%target & [Link]]
#discretize the numeric risk factors using [Link] from the monobin package
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
[Link](x = loans[, x], y = loans[, target])[[2]])
#run the bivariate analysis to get WoE
bv.a <- bivariate(db = loans, target = "Creditability")[[1]]
#check the risk factors with special case bins
[Link] <- bv.a[bv.a$rf%in%unique(bv.a$rf[bv.a$bin%in%"SC"]), ]
[Link]

## rf bin no ng nb pct.o pct.g pct.b dr

## 57 Age (years) 01 (-Inf,26) 184 104 80 0.184 0.14857143 0.2666667 0.4347826
## 58 Age (years) 02 [26,35) 355 243 112 0.355 0.34714286 0.3733333 0.3154930
## 59 Age (years) 03 [35,Inf) 441 333 108 0.441 0.47571429 0.3600000 0.2448980
## 60 Age (years) SC 20 20 0 0.020 0.02857143 0.0000000 0.0000000
## so sg sb dist.g dist.b woe iv.b iv.s auc
## 57 1000 700 300 0.14857143 0.2666667 -0.58493360 0.069077872 Inf 0.5958381
## 58 1000 700 300 0.34714286 0.3733333 -0.07273529 0.001904972 Inf 0.5958381
## 59 1000 700 300 0.47571429 0.3600000 0.27871340 0.032251122 Inf 0.5958381
## 60 1000 700 300 0.02857143 0.0000000 Inf Inf Inf 0.5958381
#replace SC WoE with WoE of the least risky bin
[Link] <- max([Link]$woe[])
bv.a$woe[bv.a$rf%in%unique([Link]$rf) & bv.a$bin%in%"SC"] <- [Link]
bv.a[bv.a$rf%in%unique(bv.a$rf[bv.a$bin%in%"SC"]), ]

## rf bin no ng nb pct.o pct.g pct.b dr

## 57 Age (years) 01 (-Inf,26) 184 104 80 0.184 0.14857143 0.2666667 0.4347826
## 58 Age (years) 02 [26,35) 355 243 112 0.355 0.34714286 0.3733333 0.3154930
## 59 Age (years) 03 [35,Inf) 441 333 108 0.441 0.47571429 0.3600000 0.2448980
## 60 Age (years) SC 20 20 0 0.020 0.02857143 0.0000000 0.0000000
## so sg sb dist.g dist.b woe iv.b iv.s auc
## 57 1000 700 300 0.14857143 0.2666667 -0.58493360 0.069077872 Inf 0.5958381
## 58 1000 700 300 0.34714286 0.3733333 -0.07273529 0.001904972 Inf 0.5958381
## 59 1000 700 300 0.47571429 0.3600000 0.27871340 0.032251122 Inf 0.5958381
## 60 1000 700 300 0.02857143 0.0000000 0.27871340 Inf Inf 0.5958381
#for all risk factors perform WoE encoding
mapping <- [Link](bv.a[, c("rf", "bin", "woe")])
names(mapping) <- c("rf", "[Link]", "[Link]")

86
rf.u <- unique(mapping$rf)
rf.l <- length(rf.u)
for (i in 1:rf.l) {
rf.i <- rf.u[i]
loans[, rf.i] <- [Link](x = loans[, rf.i],
mapping = mapping[mapping$rf%in%rf.i, ])
}
#run stepFWDr
frm <- paste(target, " ~ 1")
res <- stepFWDr([Link] = [Link](frm),
[Link] = 0.05,
db = loans,
[Link] = TRUE,
[Link] = NULL)
#print the final model
summary(res$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.8774812 0.08521163 -10.297668 7.218982e-25
## Account_Balance -0.8226305 0.10585545 -7.771263 7.770759e-15
## Duration_of_Credit__month -0.6555793 0.19019743 -3.446836 5.671936e-04
## Payment_Status_of_Previous_Credit -0.7504648 0.15625538 -4.802809 1.564548e-06
## Purpose -1.0020501 0.20885475 -4.797832 1.603919e-06
## Value_Savings_Stocks -0.8087502 0.20169347 -4.009799 6.077055e-05
## Age__years -0.8387311 0.26464527 -3.169265 1.528248e-03
## Most_valuable_available_asset -0.5290797 0.26486427 -1.997550 4.576545e-02
## Instalment_per_cent -2.1130676 0.55463465 -3.809837 1.390584e-04
## Credit_Amount -0.8247017 0.27797973 -2.966769 3.009469e-03
## Sex___Marital_Status -1.0326945 0.40201072 -2.568823 1.020445e-02
## Duration_in_Current_address -3.4368267 1.38261836 -2.485738 1.292832e-02
## Guarantors -1.0226565 0.44766169 -2.284440 2.234566e-02
## Length_of_current_employment -0.6291264 0.28991023 -2.170073 3.000130e-02

The same process can also be applied to priority groups using the stepRPCr function.

3.4.1 Blockwise (modular) variable selection

Usually, stakeholders prefer adopting a blockwise (modular) approach instead of running a single
optimization algorithm on a consolidated modeling dataset. This modular strategy utilizes multiple
submodels or blocks based on data coverage, industry insights, and geographic variations. These
submodels are then combined to form a unified PD score, providing banks with benefits and increased

87
flexibility.

As emphasized by Dash, Kremer, and Petrov (2021), this modular architecture offers several
advantages to banks, such as:

1. the ability to respond promptly to severe economic disruptions, like the COVID-19 pandemic;
2. the capacity to cover different population segments and open up new growth areas;
3. integrating a customer-centric approach in segments where the bank traditionally follows a
product-centric approach, resulting in high-performance credit models.

During the design of this modular approach, a critical aspect involves establishing effective coordi-
nation between the business and model development teams. The model development team should
collaborate closely with the business team to validate all underlying assumptions of the model
design. Additionally, they must ensure that there is no data overlapping between modules, as this
could potentially skew the integration results.
This section will primarily showcase various approaches for consolidating the block scores into a
single final score, accompanied by practical justifications. We will elucidate three principal methods,
as outlined by Anderson (2022):

1. staged blocks (residual prediction) - predictions from the previous block are utilized as an
offset in the next block;
2. embedded blocks - predictions from the previous block are used as a predictor in the next
block;
3. ensemble blocks - create a separate model per block and then integrate them into a unified
model.

[Link] Staged blocks

This method uses predictions (log odds) from the previous block as an offset for the subsequent block.
In other words, the coefficient next to predictions from the previous block is set to 1. According to
Anderson (2022), reasons for staging can be related to the following:

1. data sources, especially their cost, quality, reliability, and availability;

2. risk factor prioritization;
3. extensive knowledge of end-users about predictive risk factors.

Regarding data sources, banks typically assign the highest level of credibility to in-house data,
followed by data from external sources. As a result, staging may favor the in-house block and
conditionally apply the next stage based on costs and potential value added. A similar rationale can
be applied to the other two reasons, where prioritized risk factors serve as inputs defined through
collaboration with the business team and/or end-users.
To conduct stage modeling in R, we can utilize the [Link] function from the PDtoolkit
package. For simplicity, let’s assume that risk factors are grouped into three blocks based on random

88
selection. In summary, the steps carried out by the [Link] function can be outlined as
follows:

1. estimate the stepwise regression (stepFWD) for the first block;

2. calculate within-sample predictions for the final model from step 1;
3. estimate the stepwise regression (stepFWD) for the second block and use predictions from step
2 as an offset;
4. calculate within-sample predictions for the final model from step 3;
5. estimate the stepwise regression (stepFWD) for the third block and use predictions from step 4
as an offset.
#import loans dataset
data(loans)
#discretize the numeric risk factors
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
[Link](x = loans[, x],
y = loans$Creditability)[[2]])
#create the risk factor priority groups
[Link] <- names(loans)[!names(loans)%in%"Creditability"]
[Link](22)
blocks <- [Link](rf = [Link],
block = sample(x = 1:3,
size = length([Link]),
replace = TRUE))
blocks <- blocks[order(blocks$block), ]
blocks

## rf block
## 2 Duration of Credit (month) 1
## 6 Value Savings/Stocks 1
## 7 Length of current employment 1
## 13 Age (years) 1
## 14 Concurrent Credits 1
## 17 Occupation 1
## 19 Telephone 1
## 1 Account Balance 2
## 3 Payment Status of Previous Credit 2
## 4 Purpose 2

89
## 10 Guarantors 2
## 11 Duration in Current address 2
## 15 Type of apartment 2
## 16 No of Credits at this Bank 2
## 18 No of dependents 2
## 5 Credit Amount 3
## 8 Instalment per cent 3
## 9 Sex & Marital Status 3
## 12 Most valuable available asset 3
## 20 Foreign Worker 3
#run the staging algorithm
res <- [Link](method = "stepFWD",
target = "Creditability",
coding = "WoE",
[Link] = 0.05,
db = loans,
blocks = blocks)
#check the output
names(res)

## [1] "models" "steps" "[Link]"

#print the model development steps
res$steps

## block rf aic [Link]

## 1 1 Duration_of_Credit__month 1168.8848 0.000000000001134364801183
## 2 1 Value_Savings_Stocks 1130.4089 0.000000002715812596701633
## 3 1 Length_of_current_employment 1113.5460 0.000015652618154701490095
## 4 1 Concurrent_Credits 1106.2334 0.002081589270872189704337
## 5 1 Age__years 1097.8951 0.001278499568255630483224
## 6 2 Account_Balance 1004.8953 0.000000000000000008293676
## 7 2 Purpose 981.7324 0.000000978722102776531821
## 8 2 Payment_Status_of_Previous_Credit 965.6696 0.000033612961701576131240
## 9 2 Duration_in_Current_address 960.7485 0.008993533668393002139529
## 10 2 Guarantors 955.5996 0.008709764542329636108353
## 11 2 Type_of_apartment 953.3110 0.037762552772065097195231
## 12 3 Instalment_per_cent 934.0031 0.002379852241857987639462
## 13 3 Credit_Amount 930.5594 0.019864961172741071870895
## 14 3 Sex___Marital_Status 925.9892 0.010463678965053022432152

90
## [Link] [Link]
## 1 TRUE TRUE
## 2 TRUE TRUE
## 3 TRUE TRUE
## 4 TRUE TRUE
## 5 TRUE TRUE
## 6 TRUE TRUE
## 7 TRUE TRUE
## 8 TRUE TRUE
## 9 TRUE TRUE
## 10 TRUE TRUE
## 11 TRUE TRUE
## 12 TRUE TRUE
## 13 TRUE TRUE
## 14 TRUE TRUE
#print the last stage model
summary(res$models[[length(res$models)]])$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.009279235 0.08385167 -0.1106625 0.9118839962
## Instalment_per_cent -2.114975565 0.54854620 -3.8556015 0.0001154454
## Credit_Amount -0.624200216 0.23817390 -2.6207751 0.0087730124
## Sex___Marital_Status -1.018707080 0.39791420 -2.5601175 0.0104636790
#check offset values from the first stage
identical(unname(predict(object = res$models[[1]],
type = "link",
newdata = res$[Link][[1]])),
res$[Link][[2]]$[Link])

## [1] TRUE

As demonstrated in the above example, each block algorithm generates all the necessary data
to replicate the models manually. Consequently, with three blocks, we have access to three
distinct models, each accompanied by its corresponding development database. The development
database of each block is enriched with predictions obtained from the model within that block
(res$[Link][[2]]$[Link]).

[Link] Embedded blocks

This method involves utilizing the prediction of the previous block as a predictor for the subsequent
block. Unlike staging, where the coefficient next to the predictions of the previous block is fixed,

91
this approach estimates the coefficient.

Essentially, we can apply this approach for similar reasons as staging. However, as stated by
Anderson (2022), this method is particularly useful when integrating data from distinct sources,
such as company performance and its principals’ information. When it is impossible to combine
principals’ bureau data directly, we can link their data with company performance data and compute
the average score of principals. For more comprehensive insights, please refer to Anderson (2022).
To illustrate embedded blocks in R, we will use the [Link] function from the PDtoolkit
package. In the case of a two-block model design, the function [Link] performs the
following sequence of steps:

1. estimate the stepwise regression (stepFWDr) for the first block;

2. calculate within-sample predictions for the final model from step 1;
3. estimate the stepwise regression (stepFWDr) for the second block and use predictions from
step 2 as a compulsory predictor (block_1) in the starting model.
#import the loans dataset
data(loans)
#create the risk factor priority groups
[Link] <- names(loans)[!names(loans)%in%"Creditability"]
[Link](11)
blocks <- [Link](rf = [Link],
block = sample(x = 1:2,
size = length([Link]),
replace = TRUE))
blocks <- blocks[order(blocks$block), ]
blocks

## rf block
## 4 Purpose 1
## 6 Value Savings/Stocks 1
## 7 Length of current employment 1
## 11 Duration in Current address 1
## 15 Type of apartment 1
## 17 Occupation 1
## 18 No of dependents 1
## 19 Telephone 1
## 20 Foreign Worker 1
## 1 Account Balance 2
## 2 Duration of Credit (month) 2
## 3 Payment Status of Previous Credit 2
## 5 Credit Amount 2

92
## 8 Instalment per cent 2
## 9 Sex & Marital Status 2
## 10 Guarantors 2
## 12 Most valuable available asset 2
## 13 Age (years) 2
## 14 Concurrent Credits 2
## 16 No of Credits at this Bank 2
#standardize the numeric risk factors (mean = 0, sd = 1)
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
unname(scale(loans[, x])))
#run the embedded blocks algorithm
res <- [Link](method = "stepFWDr",
target = "Creditability",
[Link] = 0.05,
db = loans,
blocks = blocks)
#check the output
names(res)

## [1] "models" "steps" "[Link]"

#print the model development steps
res$steps

## block rf aic [Link] [Link]

## 1 1 Value_Savings_Stocks 1192.753 0.00000070197031 TRUE
## 2 1 Foreign_Worker 1186.511 0.01371408571060 TRUE
## 3 1 Type_of_apartment 1172.158 0.00009395283301 TRUE
## 4 1 Length_of_current_employment 1165.547 0.00611221068258 TRUE
## 5 2 Account_Balance 1053.508 0.00000000000000 TRUE
## 6 2 Duration_of_Credit__month 1019.340 0.00000000348373 TRUE
## 7 2 Guarantors 1014.570 0.01976254512051 TRUE
## [Link]
## 1 TRUE
## 2 TRUE
## 3 TRUE
## 4 TRUE

93
## 5 TRUE
## 6 TRUE
## 7 TRUE
#print the model of the first block
summary(res$models[[1]])$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) 0.06294658 0.3191171 0.1972523 0.84363010430
## Value_Savings_Stocks2 -0.09308387 0.2312898 -0.4024555 0.68734882745
## Value_Savings_Stocks3 -0.96744022 0.3489253 -2.7726283 0.00556055884
## Value_Savings_Stocks4 -1.30430043 0.4505385 -2.8949813 0.00379181118
## Value_Savings_Stocks5 -0.94529046 0.2170345 -4.3554857 0.00001327722
## Foreign_Worker2 -1.41527959 0.5444032 -2.5996902 0.00933079668
## Type_of_apartment2 -0.60869575 0.1832930 -3.3208884 0.00089731414
## Type_of_apartment3 0.12225665 0.2666509 0.4584895 0.64660078184
## Length_of_current_employment2 0.21998282 0.3190309 0.6895345 0.49048695171
## Length_of_current_employment3 -0.14291078 0.2990308 -0.4779132 0.63271196384
## Length_of_current_employment4 -0.61727620 0.3307705 -1.8661766 0.06201666268
## Length_of_current_employment5 -0.41537047 0.3096698 -1.3413336 0.17981217875
#print the model of the second block
summary(res$models[[2]])$coefficients

## Estimate Std. Error z value

## (Intercept) 0.5953825 0.16119031 3.693662
## block_1 0.8072673 0.12872642 6.271186
## Account_Balance2 -0.4096382 0.18659667 -2.195313
## Account_Balance3 -1.1079451 0.33989498 -3.259669
## Account_Balance4 -1.8375679 0.20834091 -8.820005
## Duration_of_Credit__month 0.4460112 0.07681813 5.806067
## Guarantors2 0.3779402 0.37177045 1.016596
## Guarantors3 -0.9848194 0.38492134 -2.558495
## Pr(>|z|)
## (Intercept) 0.000221047715839081979983
## block_1 0.000000000358307849324833
## Account_Balance2 0.028141125853489382807604
## Account_Balance3 0.001115423551437679091855
## Account_Balance4 0.000000000000000001144545
## Duration_of_Credit__month 0.000000006395751999043158
## Guarantors2 0.309345876385333895530749

94
## Guarantors3 0.010512627414297252836928

[Link] Ensemble blocks

The ensemble method consolidates multiple models, developed using diverse data with the same
target, into a single final model. Typically, this integration necessitates an additional regression step,
combining predictions from each model. This approach is commonly practiced due to its evident
advantages in incorporating data from various sources and approaching the modeling target from
different perspectives. However, it has one notable weakness: the correlation between predictions
from different modules.

To address this issue, the solution often involves employing the cascade integration of modules.
In this process, we begin by integrating correlated modules in the initial steps. Subsequently,
predictions from these initial integrations are used in the ensemble model.
We can utilize the [Link] function from the PDtoolkit package to implement the
ensemble blocks algorithm in R. In the scenario of a two-block design, the function [Link]
executes the subsequent actions:

1. estimate the stepwise regression (stepFWDr) for the first block;

2. calculate within-sample predictions for the final model from step 1;
3. estimate the stepwise regression (stepFWDr) for the second block;
4. calculate within-sample predictions for the final model from step 3;
5. estimate the integration regression of the form Creditability ~ block_1 + block_2 where
the block_1 and block_2 are within-sample predictions from steps 2 and 4.
data(loans)
#discretize the numeric risk factors
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
[Link](x = loans[, x],
y = loans$Creditability)[[2]])
#replace WoE
[Link] <- [Link](db = loans, target = "Creditability")[[1]]
#create the risk factor priority groups
[Link] <- names(loans)[!names(loans)%in%"Creditability"]
[Link](984)
blocks <- [Link](rf = [Link],
block = sample(x = 1:2,
size = length([Link]),
replace = TRUE))

95
blocks <- blocks[order(blocks$block), ]
blocks

## rf block
## 4 Purpose 1
## 5 Credit Amount 1
## 8 Instalment per cent 1
## 10 Guarantors 1
## 11 Duration in Current address 1
## 12 Most valuable available asset 1
## 16 No of Credits at this Bank 1
## 17 Occupation 1
## 19 Telephone 1
## 1 Account Balance 2
## 2 Duration of Credit (month) 2
## 3 Payment Status of Previous Credit 2
## 6 Value Savings/Stocks 2
## 7 Length of current employment 2
## 9 Sex & Marital Status 2
## 13 Age (years) 2
## 14 Concurrent Credits 2
## 15 Type of apartment 2
## 18 No of dependents 2
## 20 Foreign Worker 2
#run the ensemble blocks algorithm
res <- [Link](method = "stepFWDr",
target = "Creditability",
[Link] = 0.05,
db = loans,
blocks = blocks)
#check the output
names(res)

## [1] "models" "steps" "[Link]"

#print the model development steps
res$steps

## block rf aic [Link] [Link]

## 1 1 Credit_Amount 1200.313 0.000000374055402 TRUE
## 2 1 Instalment_per_cent 1192.506 0.003718104396875 TRUE

96
## 3 1 Telephone 1187.344 0.008074634004347 TRUE
## 4 2 Account_Balance 1098.393 0.000000000000000 TRUE
## 5 2 Duration_of_Credit__month 1058.913 0.000000009734113 TRUE
## 6 2 Length_of_current_employment 1050.046 0.002523621419763 TRUE
## 7 2 Foreign_Worker 1043.688 0.010615020220789 TRUE
## 8 2 Age__years 1041.100 0.037518994553749 TRUE
## 9 2 Concurrent_Credits 1038.025 0.027942302543183 TRUE
## [Link]
## 1 TRUE
## 2 TRUE
## 3 TRUE
## 4 TRUE
## 5 TRUE
## 6 TRUE
## 7 TRUE
## 8 TRUE
## 9 TRUE
#print the model of the first block
summary(res$models[[1]])$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -1.3942666 0.2191665 -6.3616773 0.0000000001995624
## Credit_Amount02 [3914,Inf) 1.0401296 0.1664186 6.2500811 0.0000000004102395
## Instalment_per_cent2 0.1051889 0.2533830 0.4151382 0.6780407416600048
## Instalment_per_cent3 0.2965191 0.2724449 1.0883636 0.2764346319879181
## Instalment_per_cent4 0.6822196 0.2309648 2.9537813 0.0031390638985665
## Telephone2 -0.4006653 0.1512554 -2.6489330 0.0080746340043470
#print the model of the second block
summary(res$models[[2]])$coefficients

## Estimate Std. Error z value

## (Intercept) -0.242068774 0.5312620 -0.455648548
## Account_Balance2 -0.610287774 0.1869871 -3.263796676
## Account_Balance3 -1.141027105 0.3402826 -3.353174503
## Account_Balance4 -2.003630792 0.2085580 -9.607067631
## Duration_of_Credit__month02 [8,16) 0.913246668 0.3972229 2.299078451
## Duration_of_Credit__month03 [16,45) 1.422473906 0.3864863 3.680528619
## Duration_of_Credit__month04 [45,Inf) 2.437931846 0.4595411 5.305144020
## Length_of_current_employment2 0.222059134 0.3427907 0.647797985

97
## Length_of_current_employment3 -0.139749090 0.3212315 -0.435041669
## Length_of_current_employment4 -0.749205824 0.3552156 -2.109157969
## Length_of_current_employment5 -0.225647833 0.3351038 -0.673366995
## Foreign_Worker2 -1.458580386 0.5829298 -2.502154505
## Age__years02 [26,35) -0.294372878 0.2095654 -1.404682738
## Age__years03 [35,Inf) -0.591909702 0.2195166 -2.696423164
## Concurrent_Credits2 -0.002387738 0.3913544 -0.006101218
## Concurrent_Credits3 -0.508562773 0.2123434 -2.395001810
## Pr(>|z|)
## (Intercept) 0.6486427265261418551034466873
## Account_Balance2 0.0010993002470975590974255898
## Account_Balance3 0.0007989032007045173550130457
## Account_Balance4 0.0000000000000000000007464449
## Duration_of_Credit__month02 [8,16) 0.0215004848972892813330215489
## Duration_of_Credit__month03 [16,45) 0.0002327509328033763630512454
## Duration_of_Credit__month04 [45,Inf) 0.0000001125840726318672497109
## Length_of_current_employment2 0.5171156185860474874260717115
## Length_of_current_employment3 0.6635321818614645650313832448
## Length_of_current_employment4 0.0349309485002186476121366354
## Length_of_current_employment5 0.5007138404111189933232139992
## Foreign_Worker2 0.0123440041466294329886022041
## Age__years02 [26,35) 0.1601156409552381143512889139
## Age__years03 [35,Inf) 0.0070088565311404466690037296
## Concurrent_Credits2 0.9951319622746271909008441980
## Concurrent_Credits3 0.0166202832278031856216848894
#print the ensemble model
summary(res$models[[3]])$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) 0.4478443 0.15952765 2.807314 4.995645e-03
## block_1 0.5736093 0.16537031 3.468635 5.231090e-04
## block_2 0.9531673 0.08085019 11.789302 4.431984e-32

3.4.2 Blockwise approach with different development samples

The examples presented in the previous sections showcased blockwise approaches using the same
development samples. However, this scenario is not always applicable in real-world practice, as each
block may possess a significantly or slightly different development sample. This variation is not
necessarily due to data quality issues; it often results from internal bank processes.

Consider a simple example where a client applies for a loan for the first time, and an existing

98
blockwise approach for the PD model is in place. The existing blocks encompass various aspects,
such as client personal data, loan characteristics, client behavior, and credit bureau data. For new
clients, it is expected that not all block scores will be available, such as behavioral or credit bureau
scores, as the client is new to the banking system.

Another reason for differing development samples can be an outdated data collection process for
specific clients, which could be attributed to both data quality issues and existing processes within
the bank. For instance, non-retail clients may have outdated financial statements from two or
more years ago. In such cases, clients from these cohorts are often considered ineligible for model
development.

These are some practical reasons contributing to the presence of different development samples for
various blocks.

To address this situation in blockwise model development, we usually introduce a dummy indicator
to account for block score availability and conduct imputation for missing block scores.
In the context of R, this can be demonstrated through simulation, assuming a model with only two
blocks and starting with the simulation of development samples.
data(loans)
#shuffle the observations
[Link](1)
loans <- loans[sample(x = 1:nrow(loans), size = nrow(loans), replace = FALSE), ]
#risk factors
rf <- names(loans)[!names(loans)%in%"Creditability"]
#add the unique identifier
loans <- [Link](id = 1:nrow(loans), loans)
#simulate the first development sample
ds.1 <- loans[1:900, c("id", "Creditability", rf[1:10])]
#simulate the second development sample
ds.2 <- loans[101:1000, c("id", "Creditability", rf[11:20])]
#check dimensions of the development samples
dim(ds.1)

## [1] 900 12
dim(ds.2)

## [1] 900 12
#check the overlapping observations from the development samples
sum(ds.1$id%in%ds.2$id)

## [1] 800

99
sum(ds.2$id%in%ds.1$id)

## [1] 800

With the development samples prepared, we can now proceed to the modeling phase. However,
it’s worth noting that the PDtoolkit package does not provide specific functions to handle overall
model development in cases where each block has different development samples. Therefore, we
must design our own process to address this situation effectively.
Let’s begin by focusing on the staging blockwise method. For this blockwise design, we will execute
the following steps:

1. estimate the stepwise regression (stepFWDr) for the first block;

2. add within-sample predictions of the estimated model from step 1 to the development sample
of the second block (pred);
3. add a dummy indicator (ind.1) to the development sample of the second block. This indicator
takes on a value of 1 if there are missing predictions from the first block and 0 otherwise;
4. on the development sample of the second block, impute 0 for the missing values of the
predictions of the first block;
5. estimate a regression on the second block of the form Creditability ~ pred + ind.1
([Link]);
6. utilize within-sample predictions of the model from step 5 as an offset for the stepwise regression
(stepFWDr) for the second block.
#develop the model for the first block using stepFWDr function
block.1 <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = ds.1[, -1],
[Link] = TRUE,
[Link] = NULL)
summary(block.1$model)$coefficients

## Estimate Std. Error z value

## (Intercept) 0.139990390 0.415647747 0.336800551
## Account_Balance2 -0.361809011 0.204618416 -1.768213327
## Account_Balance3 -0.989715001 0.358844386 -2.758061824
## Account_Balance4 -1.686779322 0.223344081 -7.552379775
## Duration_of_Credit__month 0.039965054 0.007005417 5.704878675
## Payment_Status_of_Previous_Credit1 -0.004927455 0.504646077 -0.009764179
## Payment_Status_of_Previous_Credit2 -0.727487624 0.377204341 -1.928630043
## Payment_Status_of_Previous_Credit3 -0.987032006 0.449047038 -2.198059273
## Payment_Status_of_Previous_Credit4 -1.448330958 0.400763938 -3.613925362
## Value_Savings_Stocks2 -0.180949666 0.273147722 -0.662460828

100
## Value_Savings_Stocks3 -0.791121982 0.416677093 -1.898645248
## Value_Savings_Stocks4 -1.063679770 0.483904999 -2.198116930
## Value_Savings_Stocks5 -1.006909134 0.255962985 -3.933807587
## Guarantors2 0.358947223 0.381348163 0.941258561
## Guarantors3 -1.196585379 0.411407437 -2.908516648
## Pr(>|z|)
## (Intercept) 0.73626725787349456276
## Account_Balance2 0.07702524711481148478
## Account_Balance3 0.00581451998292682303
## Account_Balance4 0.00000000000004273761
## Duration_of_Credit__month 0.00000001164259869163
## Payment_Status_of_Previous_Credit1 0.99220943618638057782
## Payment_Status_of_Previous_Credit2 0.05377680661035380560
## Payment_Status_of_Previous_Credit3 0.02794488228437408059
## Payment_Status_of_Previous_Credit4 0.00030159591629973958
## Value_Savings_Stocks2 0.50767593127719945478
## Value_Savings_Stocks3 0.05761113490379379115
## Value_Savings_Stocks4 0.02794077433478912853
## Value_Savings_Stocks5 0.00008361072374056389
## Guarantors2 0.34657237295295673096
## Guarantors3 0.00363147841264959597
#within the sample model predictions of the first block
[Link] <- unname(predict(object = block.1$model))
[Link] <- [Link](id = ds.1[, "id"], pred = [Link])
#add results of block 1 to the second development sample
ds.2 <- merge(x = ds.2,
y = [Link],
by = "id",
all.x = TRUE)
table([Link](ds.2$pred))

##
## FALSE TRUE
## 800 100
#add dummy indicator for missing scores from the first block
ds.2$ind.1 <- ifelse([Link](ds.2$pred), 1, 0)
table(ds.2$ind.1)

##

101
## 0 1
## 800 100
#impute missing scores from the first block
ds.2$pred <- ifelse([Link](ds.2$pred), 0, ds.2$pred)
table([Link](ds.2$pred))

##
## FALSE
## 900
#integrate the predictions from the first block and
#the target from the second block
[Link] <- glm(formula = Creditability ~ pred + ind.1,
family = "binomial",
data = ds.2)
#print the integration regression summary
summary([Link])$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.006324164 0.10384753 -0.06089855 9.514400e-01
## pred 0.998387798 0.08695921 11.48110529 1.641683e-30
## ind.1 -0.889059883 0.24362167 -3.64934649 2.629083e-04
#add the predictions of the mid-integration step
ds.2$[Link] <- unname(predict(object = [Link]))
#develop the model for the second block
[Link] <- c("id", "pred", "ind.1", "[Link]")
block.2 <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = ds.2[, !names(ds.2)%in%[Link]],
[Link] = TRUE,
[Link] = ds.2$[Link])
summary(block.2$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.2701035 0.2245011 -1.2031277 0.22892689
## Foreign_Worker2 -1.5997986 0.7573863 -2.1122624 0.03466395
## Duration_in_Current_address2 0.6341597 0.2666977 2.3778219 0.01741524
## Duration_in_Current_address3 0.1374900 0.3086731 0.4454227 0.65601433
## Duration_in_Current_address4 0.2175542 0.2583491 0.8420939 0.39973540

102
#predictions from the second block
head(predict(object = block.2$model))

## 1 2 3 4 5 6
## -1.4591247 -1.8983469 -4.2964209 -1.9143480 -1.4704579 -0.5864355

For the embedded block design, we can implement a process that is very similar to the staging block
method. The only differences are:

1. we don’t have mid integration step, as we use predictions from the first block as a predictor in
the second block;
2. for the start model argument in the second block, we use Creditability ~ pred + ind.1;
3. optionally we set argument [Link] = TRUE/FALSE (default is TRUE);
4. we set argument [Link] = NULL.

Let’s exemplify this implementation using R. Note that there is no need to re-run the model for
the first block since we have already created all essential inputs (specifically, the pred and ind.1
columns) for running the model in the second block.
[Link] <- stepFWDr([Link] = `Creditability` ~ `pred` + `ind.1`,
[Link] = 0.05,
db = ds.2[, !names(ds.2)%in%"[Link]"],
[Link] = FALSE,
[Link] = NULL)
summary([Link]$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.2642565 0.23241995 -1.1369784 2.555473e-01
## pred 1.0109114 0.08848317 11.4249010 3.140131e-30
## ind.1 -0.9340999 0.24654225 -3.7888027 1.513751e-04
## Foreign_Worker2 -1.6015891 0.75870071 -2.1109629 3.477550e-02
## Duration_in_Current_address2 0.6381664 0.26914371 2.3710990 1.773528e-02
## Duration_in_Current_address3 0.1355916 0.31010016 0.4372510 6.619293e-01
## Duration_in_Current_address4 0.2177253 0.25917158 0.8400816 4.008626e-01
#predictions from the embedded second block
head(predict(object = [Link]$model))

## 1 2 3 4 5 6
## -1.4617890 -1.9090786 -4.3200217 -1.9266707 -1.4732644 -0.5807108

The previous examples demonstrate that we adapt the process to the specific development sample
at each block. However, the situation differs for ensemble blocks. In this scenario, we have the
flexibility to integrate block scores on the union of development samples.

103
Let’s conduct another set of simulations to showcase the practical implementation of ensemble
blocks in R. After we simulate the development samples of the first and second blocks, we will
execute the following steps:

1. estimate the stepwise regression (stepFWDr) for the first block (block.1);
2. estimate the stepwise regression (stepFWDr) for the second block (block.2);
3. merge (full join) the target and within-sample model predictions (pred.1 and pred.2) of the
first and second development samples (data frame block.12);
4. add a dummy indicator for missing values (ind.1 and ind.2) for each model prediction. This
indicator takes on a value of 1 if there are missing predictions and 0 otherwise;
5. impute 0 for the missing values for each model prediction;
6. estimate the integration regression of the form Creditability ~ pred.1 + pred.2 + ind.1
+ ind.2.
data(loans)
#shuffle the observations
[Link](1)
loans <- loans[sample(x = 1:nrow(loans), size = nrow(loans), replace = FALSE), ]
#risk factors
rf <- names(loans)[!names(loans)%in%"Creditability"]
#add the unique identifier
loans <- [Link](id = 1:nrow(loans), loans)
#simulate the first development sample
ds.1 <- loans[1:900, c("id", "Creditability", rf[1:10])]
#simulate the second development sample
ds.2 <- loans[101:1000, c("id", "Creditability", rf[11:20])]
#develop the model for the first block
block.1 <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = ds.1[, -1],
[Link] = NULL)
summary(block.1$model)$coefficients

## Estimate Std. Error z value

## (Intercept) 0.139990390 0.415647747 0.336800551
## Account_Balance2 -0.361809011 0.204618416 -1.768213327
## Account_Balance3 -0.989715001 0.358844386 -2.758061824
## Account_Balance4 -1.686779322 0.223344081 -7.552379775
## Duration_of_Credit__month 0.039965054 0.007005417 5.704878675
## Payment_Status_of_Previous_Credit1 -0.004927455 0.504646077 -0.009764179
## Payment_Status_of_Previous_Credit2 -0.727487624 0.377204341 -1.928630043

104
## Payment_Status_of_Previous_Credit3 -0.987032006 0.449047038 -2.198059273
## Payment_Status_of_Previous_Credit4 -1.448330958 0.400763938 -3.613925362
## Value_Savings_Stocks2 -0.180949666 0.273147722 -0.662460828
## Value_Savings_Stocks3 -0.791121982 0.416677093 -1.898645248
## Value_Savings_Stocks4 -1.063679770 0.483904999 -2.198116930
## Value_Savings_Stocks5 -1.006909134 0.255962985 -3.933807587
## Guarantors2 0.358947223 0.381348163 0.941258561
## Guarantors3 -1.196585379 0.411407437 -2.908516648
## Pr(>|z|)
## (Intercept) 0.73626725787349456276
## Account_Balance2 0.07702524711481148478
## Account_Balance3 0.00581451998292682303
## Account_Balance4 0.00000000000004273761
## Duration_of_Credit__month 0.00000001164259869163
## Payment_Status_of_Previous_Credit1 0.99220943618638057782
## Payment_Status_of_Previous_Credit2 0.05377680661035380560
## Payment_Status_of_Previous_Credit3 0.02794488228437408059
## Payment_Status_of_Previous_Credit4 0.00030159591629973958
## Value_Savings_Stocks2 0.50767593127719945478
## Value_Savings_Stocks3 0.05761113490379379115
## Value_Savings_Stocks4 0.02794077433478912853
## Value_Savings_Stocks5 0.00008361072374056389
## Guarantors2 0.34657237295295673096
## Guarantors3 0.00363147841264959597
pred.1 <- unname(predict(object = block.1$model))
[Link] <- [Link](id = ds.1$id,
target.1 = ds.1$Creditability,
pred.1 = pred.1)
#develop the model for the second block
block.2 <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = ds.2[, -1],
[Link] = NULL)
summary(block.2$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) 0.94255111 0.334233378 2.8200389 0.0048017835
## Type_of_apartment2 -0.66946939 0.193272025 -3.4638711 0.0005324615
## Type_of_apartment3 0.21676897 0.282758963 0.7666210 0.4433068581

105
## Age__years -0.02305943 0.007454104 -3.0935214 0.0019779626
## Concurrent_Credits2 0.13564598 0.371604022 0.3650283 0.7150902850
## Concurrent_Credits3 -0.65901481 0.203349779 -3.2407943 0.0011919715
## Foreign_Worker2 -1.99204388 0.742812772 -2.6817577 0.0073236480
pred.2 <- unname(predict(object = block.2$model))
[Link] <- [Link](id = ds.2$id,
target.2 = ds.2$Creditability,
pred.2 = pred.2)
#integate the scores from the first and the second block
block.12 <- merge(x = [Link],
y = [Link],
by = "id",
all = TRUE)
#check for percentage of the missing values
colMeans([Link](block.12))

## id target.1 pred.1 target.2 pred.2

## 0.0 0.1 0.1 0.1 0.1
#add the missing score indicators
block.12$ind.1 <- ifelse([Link](block.12$pred.1), 1, 0)
block.12$ind.2 <- ifelse([Link](block.12$pred.2), 1, 0)
#impute for the missing scores
block.12$pred.1 <- ifelse([Link](block.12$pred.1), 0, block.12$pred.1)
block.12$pred.2 <- ifelse([Link](block.12$pred.2), 0, block.12$pred.2)
#adjust the final target variable
block.12$Creditability <- coalesce(block.12$target.1, block.12$target.2)
table(block.12$Creditability)

##
## 0 1
## 700 300
#run the integration regression
integ <- glm(formula = Creditability ~ pred.1 + pred.2 + ind.1 + ind.2,
family = "binomial",
data = block.12)
summary(integ)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) 0.5315609 0.15724233 3.380520 7.234872e-04

106
## pred.1 0.9404962 0.08169962 11.511635 1.152723e-30
## pred.2 0.6990665 0.15711518 4.449389 8.611501e-06
## ind.1 -0.8114157 0.24632309 -3.294111 9.873342e-04
## ind.2 -0.5230446 0.29622945 -1.765674 7.745058e-02
#prediction from the integrated model
head(predict(object = integ, type = "response"))

## 1 2 3 4 5 6
## 0.5044461 0.0443268 0.1894072 0.8325867 0.1293977 0.1894072

When confronted with varying development samples for the blocks, the importance of a robust model
design becomes paramount. Therefore, conducting and documenting a comprehensive analysis of
the factors contributing to the differences in the samples is highly advisable. Doing so ensures a
well-informed and reliable modeling process that can effectively accommodate diverse data sets.

3.4.3 Analysis of discriminatory power

In addition to the requirements of statistical significance in estimated model parameters and the
consideration of business inputs such as monotonicity and risk factor prioritization, analyzing the
model’s discriminatory power is an essential step. During this analysis, it is crucial to ensure that
our model performs well on the overall development sample as well as different sub-segments.

The most common statistics used for investigating discriminatory power are the AUC and the test
of two proportions.

To assess the AUC distribution in the overall sample, standard approaches include k-fold validation
and bootstrapping. Although these methods do not explicitly perform statistical testing of AUC,
they can be easily extended for such procedures. In R, we can perform these validations using the
functions [Link] and [Link]. Before running these functions, let’s first simulate the model
in use.
#simulate the model
data(loans)
res <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = loans,
[Link] = NULL)
summary(res$model)$coefficients

## Estimate Std. Error z value

## (Intercept) 0.309350061 0.510714268 0.60572042
## Account_Balance2 -0.566423709 0.190227251 -2.97761602
## Account_Balance3 -1.205152471 0.343530929 -3.50813382

107
## Account_Balance4 -1.950714449 0.209762019 -9.29965518
## Duration_of_Credit__month 0.035991508 0.006573616 5.47514566
## Payment_Status_of_Previous_Credit1 -0.017751218 0.486744616 -0.03646926
## Payment_Status_of_Previous_Credit2 -0.908628285 0.377677776 -2.40582937
## Payment_Status_of_Previous_Credit3 -0.940072229 0.440073744 -2.13616977
## Payment_Status_of_Previous_Credit4 -1.472715043 0.401956708 -3.66386482
## Guarantors2 0.570299658 0.380488628 1.49886124
## Guarantors3 -0.917025386 0.393243114 -2.33195536
## Foreign_Worker2 -1.348505220 0.592482512 -2.27602535
## Length_of_current_employment2 0.375963618 0.345582032 1.08791425
## Length_of_current_employment3 -0.009180829 0.326358992 -0.02813107
## Length_of_current_employment4 -0.602072607 0.361008070 -1.66775388
## Length_of_current_employment5 -0.206993037 0.338917075 -0.61074833
## Pr(>|z|)
## (Intercept) 0.54470042146294272988882312
## Account_Balance2 0.00290499669361344269036262
## Account_Balance3 0.00045126198935846098926963
## Account_Balance4 0.00000000000000000001409019
## Duration_of_Credit__month 0.00000004371518857696073222
## Payment_Status_of_Previous_Credit1 0.97090818570141390608796428
## Payment_Status_of_Previous_Credit2 0.01613579915771431311233286
## Payment_Status_of_Previous_Credit3 0.03266557849596266049907456
## Payment_Status_of_Previous_Credit4 0.00024843793297237292154109
## Guarantors2 0.13390963232311420272324654
## Guarantors3 0.01970303987922373059604730
## Foreign_Worker2 0.02284449213754234653261932
## Length_of_current_employment2 0.27663296375722579156786196
## Length_of_current_employment3 0.97755761094495319252217769
## Length_of_current_employment4 0.09536459560651047717705353
## Length_of_current_employment5 0.54136620696644022210364255
#get the model predictions
loans$pred <- unname(predict(object = res$model, type = "response"))
#calculate the AUC
auc <- [Link](predictions = loans$pred,
observed = loans$Creditability)
auc

## [1] 0.7902905

Now that we have the model, we can perform the k-fold and bootstrap validation as follows:

108
[Link](model = res$model,
k = 10,
seed = 1984)

## $iter
## k no amse rmse auc
## 1 1 100 0.1761487 0.4197007 0.7576493
## 2 2 100 0.1330490 0.3647589 0.8853374
## 3 3 100 0.1873784 0.4328723 0.7091996
## 4 4 100 0.1473252 0.3838296 0.7614342
## 5 5 100 0.2093840 0.4575850 0.6734509
## 6 6 100 0.1576803 0.3970897 0.8297151
## 7 7 100 0.1544590 0.3930127 0.8110733
## 8 8 100 0.1960240 0.4427460 0.8083919
## 9 9 100 0.1806967 0.4250844 0.7645862
## 10 10 100 0.1582972 0.3978658 0.7424636
##
## $summary
## amse rmse auc
## 1 0.1700442 0.4114545 0.7743302
[Link](model = res$model,
B = 10,
seed = 1984)

## $iter
## B amse rmse auc
## 1 1 0.1576764 0.3970849 0.7981560
## 2 2 0.1516431 0.3894137 0.8094198
## 3 3 0.1630003 0.4037330 0.7905672
## 4 4 0.1602849 0.4003560 0.7946357
## 5 5 0.1667371 0.4083346 0.7878783
## 6 6 0.1563033 0.3953521 0.7855373
## 7 7 0.1636450 0.4045306 0.7859711
## 8 8 0.1548148 0.3934651 0.8020490
## 9 9 0.1508124 0.3883457 0.8037595
## 10 10 0.1439135 0.3793593 0.8263528
##
## $summary
## amse rmse auc

109
## 1 0.1568831 0.3959975 0.7984327

The results indicate that 10-fold validation produces an average AUC of 77.43%, which is slightly
lower than the AUC from the overall sample at 79.03%. In contrast, the bootstrap procedure yields
a higher average AUC of 79.84% compared to the AUC of the overall sample. It is important
to consider that k-fold validation operates on unseen data and generally provides more reliable
results than the bootstrap method. When the final multivariate model comprises categorical risk
factors with WoE encoding, the k-fold validation should be carefully designed. To ensure AUC
estimation is performed on completely unseen data, we need to re-calculate WoE on the estimation
sample, make predictions on the validation sample, and finally estimate AUC. Although this process
cannot be directly executed within the [Link] function, it can be designed manually. For such
situations, the PDtoolkit package offers useful functions like [Link], [Link], bivariate,
and [Link].

During the discriminatory analysis of the model, we are not only interested in its performance on the
overall sample but also in its performance on different sub-segments, as defined from the business
perspective. Common examples of sub-segments include different geographies, economic activities,
turnover, or exposure groups. Instead of applying the same k-fold and bootstrap validations to
these sub-segments, we explicitly test the AUC of each sub-segment against the AUC of the overall
sample.

In R, we can achieve this by combining a few functions ([Link], [Link]) from the PDtoolkit
package, as illustrated in the following example. This approach enables us to gain deeper insights
into how the model performs across different sub-segments and facilitates a more comprehensive
evaluation of its discriminatory power.
#artificially create some sub-segments for the AUC testing
loans$segment <- cut2(x = loans$"Credit Amount",
g = 2)
table(loans$segment)

##
## [ 250, 2320) [2320,18424]
## 500 500
#overall sample AUC
auc <- [Link](predictions = loans$pred,
observed = loans$Creditability)
auc

## [1] 0.7902905
#test AUC for the sub-segments
sub.s.u <- unique(loans$segment)

110
[Link] <- vector("list", length(sub.s.u))
for (i in 1:length(sub.s.u)) {
sub.s <- sub.s.u[[i]]
[Link][[i]] <- [Link]([Link] = loans[loans$segment%in%sub.s, ],
[Link] = "Creditability",
pdc = "pred",
[Link] = auc,
alternative = "less",
alpha = 0.05)
[Link][[i]] <- [Link]([Link] = sub.s, [Link][[i]])
}
[Link]("rbind", [Link])

## [Link] auc [Link] estimate [Link] [Link] [Link]

## 1 [ 250, 2320) 0.8173140 0.7902905 0.02702354 0.02341298 1.1542118 0.8757933
## 2 [2320,18424] 0.7665402 0.7902905 -0.02375023 0.02415509 -0.9832393 0.1627448
## alpha res
## 1 0.05 H0: AUC >= AUC test
## 2 0.05 H0: AUC >= AUC test

For both sub-segments, the calculated p-values are greater than the selected significance level of
5%; therefore, we cannot reject the null hypothesis that the sub-segment AUC is greater than or
equal to the overall sample AUC. The standard error of AUC within the [Link] function is
AU Csub−segment −AU Cmodel
calculated according to Hanley and McNeil (1982) and the test statistic SEAU Csub−segment is
assumed to follow the standard normal distribution.

In addition to the explicit testing of AUC, an insightful analysis can be conducted by

comparing predicted and observed default rates and identifying segments where our model either
overestimates or underestimates them. Rather than relying on predefined sub-segments, we can
adopt a statistical approach to identify significant ones.

To achieve this, we can utilize the [Link] function from the PDtoolkit package as follows:
[Link] <- [Link](model = res$model,
db = res$[Link],
[Link] = 0.10,
alpha = 0.05)
#print the output elements
names([Link])

## [1] "[Link]" "[Link]" "[Link]"

111
This algorithm runs a decision tree on model residuals against all risk factors from res$[Link],
searching for significant splits. Subsequently, it deploys the test of two proportions to examine
potential model overestimation or underestimation of the observed default rate.
It returns the list of three elements.
The first element is the segment model, which corresponds to the decision tree used to create
segments. We can access it in the following way:
[Link][["[Link]"]]

## n= 1000
##
## node), split, n, deviance, yval
## * denotes terminal node
##
## 1) root 1000 163.0844 -0.00000000000003805845
## 2) Purpose=1,10,2,3,4,8,9 694 101.7526 -0.04150568999999999786 *
## 3) Purpose=0,5,6 306 57.4247 0.09413382000000000693 *

The second element summarises the testing results comparing the observed default rate ([Link])
with modeled default rate ([Link]):
[Link][["[Link]"]]

## segment no [Link] [Link] [Link] [Link] [Link] [Link] [Link]

## 1 2 694 513 484.1951 181 209.80495 0.2608069 0.3023126 0.04150569
## 2 3 306 187 215.8049 119 90.19505 0.3888889 0.2947551 -0.09413382
## [Link] alpha [Link]
## 1 0.0063820544 0.05 overestimate
## 2 0.0003653452 0.05 underestimate

The last, third element provides rules for the identification of these sub-segments. As can be seen
from the output below, algorithm identified two segments. For the first one, where the risk factor
Purpose takes values 1, 10, 2, 3, 4, 8, 9 our model overestimates the default rate on average
by 4.15%, while for another segment for which risk factor Purpose takes values 0, 5, 6 our model
underestimates the default rate on average by 9.14%.
[Link][["[Link]"]]

## avg rule
## 1 -0.04150569 Purpose=1,10,2,3,4,8,9
## 2 0.09413382 Purpose=0,5,6

The above analyses can aid in identifying the following:

1. model bias coming from omitted risk factor(s);

112
 2. model weaknesses through the segments on which the model does not perform well;
3. segment(s) for possible margin of conservatism application.

It’s important to note that this analysis doesn’t necessarily need to be performed precisely at this
stage; it can also be conducted after the final model selection and completed calibration process.

An additional approach to investigate discriminatory power is through confusion matrix

analysis. While this approach is more common in machine learning projects than traditional credit
scoring, where rating grades are often the focus rather than simple binary outcomes, it can still
prove useful in some instances, depending on the model’s application. For conducting confusion
matrix analysis in R, we can rely on the functions [Link] and [Link] from
the PDtoolkit package. Typically, the initial step involves examining different cutoff points that
optimize specific metrics of the confusion matrix.
cop <- [Link](predictions = predict(object = res$model,
type = "response"),
observed = loans$"Creditability",
[Link] = 0.05,
[Link] = 0.01)
cop

## metric min max [Link] [Link]

## 1 accuracy 0.35800000 0.7710000 0.05435566 0.47945213
## 2 error rate 0.22900000 0.6420000 0.47945213 0.05435566
## 3 sensitivity 0.11666667 0.9866667 0.70501352 0.05435566
## 4 specificity 0.08857143 0.9785714 0.05435566 0.70501352
## 5 precision 0.31691649 0.7530864 0.05435566 0.64428546
## 6 [Link] 0.20000000 0.6201550 0.70501352 0.27124161
## 7 false positive 0.02142857 0.9114286 0.70501352 0.05435566
## 8 false discovery 0.24691358 0.6830835 0.64428546 0.05435566

Then, we usually select the optimal cutoff point and inspect other metrics of the confusion matrix.
To do so, we can run the following command in R:
[Link](predictions = predict(object = res$model,
type = "response"),
observed = loans$"Creditability",
cutoff = cop$[Link][cop$metric%in%"[Link]"])

## $[Link]
## predicted
## observed 0 1

113
## 0 466 234
## 1 60 240
##
## $metrics
## metric value
## 1 accuracy 0.7060000
## 2 error rate 0.2940000
## 3 sensitivity 0.8000000
## 4 specificity 0.6657143
## 5 precision 0.5063291
## 6 [Link] 0.6201550
## 7 false positive 0.3342857
## 8 false discovery 0.4936709

3.4.4 Rating scale

After selecting the final model3 , we typically define our rating scale. The rating scale can be created
in different ways, but the two most common are mapping model predictions to a given PD range or
creating a model-specific rating scale. Regarding the mapping process, we usually do this based on
some given internal rating scale or standard external ones such as the one from Standard & Poor’s
or Moody’s.
Regarding the model-specific rating scales, there are two types:

1. continuous;
2. discrete.

This section covers the creation of the model-specific rating scale, outlines the main principles of
the best practice and provides demonstration examples in R.
For the continuous rating scale, we use direct predictions from the final model. In contrast, for
the discrete rating scale, we first define rating grades discretizing final model predictions and then
calculate the average observed default rate per rating grade. For both types of the rating scale,
special attention should be paid to creating a dataset for which model predictions are generated and
which is used to create the rating scale. Typically, the two primary options are the training dataset
and the dataset that reflects the portfolio’s status during what is commonly referred to as a “typical
year.” Essentially, a “typical year” portfolio comprises one or a few snapshots that best capture the
average distribution of cases per rating grade and have an average default rate comparable to the
long-run average default rate of the portfolio in scope. This dataset is also employed for subsequent
modeling in the calibration of the ranking model.
In practice, the discrete rating scale is more commonly used than the continuous one. Regardless of
3
Under the final model, here, we mean overall model design - single model on the consolidated dataset or modular
approach with certain integration method, usually model before calibration is performed.

114
the approach, there are certain principles we typically follow when creating the rating scale. These
principles lead to specific rating scale characteristics, with some being compulsory, while others may
vary from one model to another and are often considered nice-to-have but not mandatory.

Among the compulsory characteristics of the rating scale, we emphasize two: monotonicity and
heterogeneity. Monotonicity ensures the presence of either increasing or decreasing trends of the
PDs throughout the rating grades. In some cases, achieving monotonicity on observed defaults may
be challenging, and it is often addressed by applying additional constraints during the calibration
process, which will be discussed in the next section. Heterogeneity means that the rating scale
sufficiently differentiates the rating grades’ risk profiles. Typically, heterogeneity is assessed among
adjacent rating grades using a one-sided statistical test of two proportions based on observed defaults
from the training dataset or “typical year” portfolio at this stage.

Other nice-to-have characteristics of the rating scale include a lack of concentration, symmetric
distribution of cases per rating grade, and homogeneity. Concentration is typically assessed using the
Herfindahl-Hirschman index (HHI), while distribution symmetry is evaluated visually. Homogeneity
testing requires a larger modeling dataset, necessitating careful design of the testing process. At the
end of this section, we will provide an example of homogeneity analysis.

Note that assessing most of these characteristics requires discretizing final model predictions. In the
case of a continuous rating scale, the standard approach is to create rating grades based on ten
equidistant groups of the model predictions and then assess the characteristics of interest.

We will now introduce a hypothetical final model to illustrate the process of creating a
rating scale in R.
#data import
data(loans)
#binning of the numeric risk factors
[Link] <- sapply(X = loans, FUN = [Link])
[Link] <- names([Link])[!names([Link])%in%"Creditability" & [Link]]
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x)
[Link](x = loans[, x],
y = loans[, "Creditability"])[[2]])
#simulate the final model
res <- stepFWD([Link] = Creditability ~ 1,
[Link] = 0.05,
coding = "WoE",
db = loans)
summary(res$model)$coefficients

115
## Estimate Std. Error z value
## (Intercept) -0.8547612 0.08410677 -10.162811
## Account_Balance -0.8178512 0.10545572 -7.755399
## Duration_of_Credit__month -0.6890414 0.19012993 -3.624055
## Payment_Status_of_Previous_Credit -0.7647498 0.15570583 -4.911504
## Purpose -0.9954891 0.20796242 -4.786870
## Value_Savings_Stocks -0.8025048 0.20015701 -4.009377
## Length_of_current_employment -0.6355607 0.28829249 -2.204569
## Instalment_per_cent -2.0279862 0.54639785 -3.711556
## Credit_Amount -0.7824906 0.28264138 -2.768493
## Age__years -0.7099874 0.26868479 -2.642455
## Sex___Marital_Status -1.0321091 0.40080603 -2.575084
## Guarantors -1.0021026 0.44585850 -2.247580
## Duration_in_Current_address -3.4603174 1.37808336 -2.510964
## Most_valuable_available_asset -0.5488483 0.26242312 -2.091463
## Pr(>|z|)
## (Intercept) 0.000000000000000000000002905754
## Account_Balance 0.000000000000008806625860542650
## Duration_of_Credit__month 0.000290019632586644500633898947
## Payment_Status_of_Previous_Credit 0.000000903805708117542536735728
## Purpose 0.000001694022294845475235056803
## Value_Savings_Stocks 0.000060879280043653676238873951
## Length_of_current_employment 0.027484352144808318202384711526
## Instalment_per_cent 0.000205989185833339177606610138
## Credit_Amount 0.005631626675456159573929237894
## Age__years 0.008230743105964815481412344411
## Sex___Marital_Status 0.010021581619213326339035141643
## Guarantors 0.024602987159298574104671075702
## Duration_in_Current_address 0.012040203783037899468166820327
## Most_valuable_available_asset 0.036486561088916291684114412419
#model predictions
loans$pred <- unname(predict(object = res$model, type = "link"))

Having successfully built the model on the consolidated dataset, we have now assigned its predictions
to the modeling dataset loans. With all the necessary prerequisites in place, we can create our
discrete rating scale.

As a starting point, let’s focus on achieving monotonicity and heterogeneity. To simplify this process,
we can utilize one of the algorithms from the monobin package. To ensure heterogeneity across all
adjacent rating grades, we can use the [Link] function, exemplified as follows:

116
rs <- [Link](x = round(loans$pred, 2),
y = loans$Creditability,
[Link] = "bina")[[1]]
rs

## bin no [Link] [Link] [Link] [Link] [Link] type

## 1 01 (-Inf,-2.72) 170 3 0.01764706 -3.4680588 -5.25 -2.73 complete cases
## 2 02 [-2.72,-2.12) 118 10 0.08474576 -2.4090678 -2.72 -2.13 complete cases
## 3 03 [-2.12,-0.99) 274 47 0.17153285 -1.5613504 -2.12 -1.00 complete cases
## 4 04 [-0.99,-0.5) 100 31 0.31000000 -0.7705000 -0.99 -0.52 complete cases
## 5 05 [-0.5,-0.05) 91 43 0.47252747 -0.2682418 -0.50 -0.06 complete cases
## 6 06 [-0.05,1.23) 196 122 0.62244898 0.5050510 -0.05 1.22 complete cases
## 7 07 [1.23,Inf) 51 44 0.86274510 1.7188235 1.23 2.71 complete cases
## [Link] so sg sb dist.g dist.b woe iv.b
## 1 NA 1000 700 300 0.23857143 0.01000000 3.17208366 0.7250476945
## 2 0.003494655 1000 700 300 0.15428571 0.03333333 1.53224827 0.1853290769
## 3 0.012678789 1000 700 300 0.32428571 0.15666667 0.72750456 0.1219436207
## 4 0.001766004 1000 700 300 0.09857143 0.10333333 -0.04717856 0.0002246598
## 5 0.010645176 1000 700 300 0.06857143 0.14333333 -0.73729697 0.0551217255
## 6 0.008407305 1000 700 300 0.10571429 0.40666667 -1.34725381 0.4054592424
## 7 0.000564560 1000 700 300 0.01000000 0.14666667 -2.68557735 0.3670289039

The algorithm successfully identified seven rating grades with a clear monotonic trend in default
rates. The average default rates span from 1.76% to 86.27%, with statistically significant differences
observed between adjacent rating grades (indicated by the [Link] column in the results above).
Next, we will examine the concentration and distribution of cases per rating grade.
#concentration
hhi(rs$no)

## [1] 0.177198
#distribution of the cases
barplot(height = rs$no,
[Link] = rs$bin,
col = "red",
main = "Number of observations per rating grade",
xlab = "",
ylab = "# of observations",
las = 2,
[Link] = 0.65)

117
 Number of observations per rating grade

250

200
# of observations

150

100

50

0
01 (−Inf,−2.72)

02 [−2.72,−2.12)

03 [−2.12,−0.99)

04 [−0.99,−0.5)

05 [−0.5,−0.05)

06 [−0.05,1.23)

07 [1.23,Inf)
The barplot indicates that the distribution of cases per rating grade lacks a symmetrical shape,
highlighting the need for refinement. We often resort to an iterative process to address this issue,
requiring manual adjustments at specific stages to achieve a more balanced distribution.

For demonstration purposes, let’s begin by creating a helper function that will aid us in generating
grades with a symmetrical number of cases. This function will assist in the process of refining and
balancing the rating scale to achieve a more optimal outcome.
[Link].g <- function(n, [Link], tails) {
q <- seq(-6, 6, [Link] = n - 1)
[Link] <- c(0, pnorm(q = q), 1)
[Link] <- unname(quantile(x = [Link], probs = [Link]))
[Link] <- unname(quantile(x = [Link], probs = c(tails, 1 - tails)))
[Link].f <- sort(c(-Inf,
[Link],
[Link][[Link] > [Link][1] &
[Link] < [Link][2]],
Inf))
[Link] <- cut(x = [Link],
breaks = unique([Link].f))

118
 res <- list(breaks = [Link].f, groups = [Link])
return(res)
}

In the first iteration, we will apply this function to the model predictions to create a new set of
rating grades. Next, we will summarize the data based on these initial rating grades. This will
provide a basis for further analysis and refinement in subsequent iterations.
ndg <- [Link].g(n = 20,
[Link] = round(loans$pred, 2),
tails = 0.005)
db <- [Link](rating = ndg[[2]],
pred = loans$pred,
observed = loans$Creditability)
rs <- db %>%
group_by(rating, .drop = FALSE) %>%
summarise(no = n(),
nd = sum(observed),
dr = mean(observed)) %>%
[Link]()
rs

## rating no nd dr
## 1 (-Inf,-4.48] 5 0 0.00000000
## 2 (-4.48,-4.16] 18 0 0.00000000
## 3 (-4.16,-3.35] 71 1 0.01408451
## 4 (-3.35,-2.27] 159 12 0.07547170
## 5 (-2.27,-1.27] 248 34 0.13709677
## 6 (-1.27,-0.08] 248 86 0.34677419
## 7 (-0.08,0.87] 161 97 0.60248447
## 8 (0.87,1.69] 67 49 0.73134328
## 9 (1.69,2.32] 18 17 0.94444444
## 10 (2.32, Inf] 5 4 0.80000000

After the first iteration, we observe that the first two rating grades have no observed default, and
the last rating grade exhibits reversed monotonicity. To address these issues in the second iteration,
we will merge the first two grades and the last grade with the one preceding it.
levels(db$rating)[levels(db$rating)%in%rs$rating[1:2]] <- "(-Inf, -4.16]"
levels(db$rating)[levels(db$rating)%in%rs$rating[9:10]] <- "(1.69, Inf]"

After completing the second iteration, we will summarize the data and re-evaluate the characteristics

119
of the rating scale.
#rating scale summary
rs <- db %>%
group_by(rating) %>%
summarise(no = n(),
nd = sum(observed),
dr = mean(observed)) %>%
[Link]()
rs

## rating no nd dr
## 1 (-Inf, -4.16] 23 0 0.00000000
## 2 (-4.16,-3.35] 71 1 0.01408451
## 3 (-3.35,-2.27] 159 12 0.07547170
## 4 (-2.27,-1.27] 248 34 0.13709677
## 5 (-1.27,-0.08] 248 86 0.34677419
## 6 (-0.08,0.87] 161 97 0.60248447
## 7 (0.87,1.69] 67 49 0.73134328
## 8 (1.69, Inf] 23 21 0.91304348
#monotonicity
diff(rs$dr)

## [1] 0.01408451 0.06138719 0.06162508 0.20967742 0.25571028 0.12885881 0.18170019

#heterogeneity
options(warn = -1)
rs$[Link] <- NA
for (i in 2:nrow(rs)) {
y.sum1 <- rs$nd[i - 1]
y.sum2 <- rs$nd[i]
no1 <- rs$no[i - 1]
no2 <- rs$no[i]
[Link].i <- [Link](x = c(y.sum1, y.sum2),
n = c(no1, no2),
alternative = "less",
correct = FALSE)$[Link]
rs$[Link][i] <- [Link].i
}
rs

## rating no nd dr [Link]

120
## 1 (-Inf, -4.16] 23 0 0.00000000 NA
## 2 (-4.16,-3.35] 71 1 0.01408451 0.28358907455341
## 3 (-3.35,-2.27] 159 12 0.07547170 0.03127490179662
## 4 (-2.27,-1.27] 248 34 0.13709677 0.02769629279760
## 5 (-1.27,-0.08] 248 86 0.34677419 0.00000002489657
## 6 (-0.08,0.87] 161 97 0.60248447 0.00000018749937
## 7 (0.87,1.69] 67 49 0.73134328 0.03237923033302
## 8 (1.69, Inf] 23 21 0.91304348 0.03526583615422
#concentration
hhi(rs$no)

## [1] 0.184798
#distirbution of cases per rating grade
barplot(height = rs$no,
[Link] = rs$rating,
col = "red",
main = "Number of observations per rating grade",
xlab = "",
ylab = "# of observations",
las = 2,
[Link] = 0.65)

121
 Number of observations per rating grade

200
# of observations

150

100

50

0
(−Inf, −4.16]

(−4.16,−3.35]

(−3.35,−2.27]

(−2.27,−1.27]

(−1.27,−0.08]

(−0.08,0.87]

(0.87,1.69]

(1.69, Inf]
Now, after the second iteration, we can see that the rating scale possesses all desired characteristics.
Only for the heterogeneity, there is one pair of rating grades ((-Inf, -4.16] and (-4.16,-3.35])
for which the test p-value is greater than the selected significance level of 5%. Nevertheless,
considering that this pair contains less than 10% (23 + 71) of the total cases (1000), we can
conclude that the rating scale adequately differentiates the risk profiles.

Coming back to the homogeneity of the rating scale, this analysis aims to test the homo-
geneity of risk profiles within the rating grade concerning a specific segmentation variable. To
conduct this analysis, we employ a two-sided test of two proportions to compare the observed
default rate of one modality of our segmentation variable with the observed default rate of the
remaining modalities of the same variable. Since this test is performed independently for each
rating grade, it necessitates a substantial number of cases per rating grade and modalities of the
segmentation variable.
We can utilize the function homogeneity from the PDtoolkit package, to perform this analysis.
However, it’s essential to note that the function operates only when we have at least 30 observations
in both testing segments. For illustrative purposes, let’s demonstrate the usage of this function,
assuming that our segmentation variable is the Account Balance.
#add the segmentation variable to db
db <- [Link](db, segment = loans$"Account Balance")

122
#run the homogeneity test
homogeneity([Link] = db,
[Link] = "observed",
rating = "rating",
segment = "segment",
alpha = 0.05)

## [Link] rating [Link] no nb [Link] [Link] [Link]

## 1 segment (-Inf, -4.16] 2 23 0 1 22 0
## 2 segment (-Inf, -4.16] 4 23 0 22 1 0
## 3 segment (-4.16,-3.35] 2 71 1 2 69 0
## 4 segment (-4.16,-3.35] 3 71 1 4 67 0
## 5 segment (-4.16,-3.35] 4 71 1 65 6 1
## 6 segment (-3.35,-2.27] 1 159 12 10 149 0
## 7 segment (-3.35,-2.27] 2 159 12 14 145 2
## 8 segment (-3.35,-2.27] 3 159 12 17 142 3
## 9 segment (-3.35,-2.27] 4 159 12 118 41 7
## 10 segment (-2.27,-1.27] 1 248 34 32 216 5
## 11 segment (-2.27,-1.27] 2 248 34 66 182 9
## 12 segment (-2.27,-1.27] 3 248 34 18 230 4
## 13 segment (-2.27,-1.27] 4 248 34 132 116 16
## 14 segment (-1.27,-0.08] 1 248 86 87 161 27
## 15 segment (-1.27,-0.08] 2 248 86 90 158 34
## 16 segment (-1.27,-0.08] 3 248 86 18 230 5
## 17 segment (-1.27,-0.08] 4 248 86 53 195 20
## 18 segment (-0.08,0.87] 1 161 97 91 70 60
## 19 segment (-0.08,0.87] 2 161 97 61 100 33
## 20 segment (-0.08,0.87] 3 161 97 5 156 2
## 21 segment (-0.08,0.87] 4 161 97 4 157 2
## 22 segment (0.87,1.69] 1 67 49 43 24 33
## 23 segment (0.87,1.69] 2 67 49 23 44 16
## 24 segment (0.87,1.69] 3 67 49 1 66 0
## 25 segment (1.69, Inf] 1 23 21 11 12 10
## 26 segment (1.69, Inf] 2 23 21 12 11 11
## [Link] [Link] alpha res
## 1 0 NA 0.05 Less than 30 observations.
## 2 0 NA 0.05 Less than 30 observations.
## 3 1 NA 0.05 Less than 30 observations.
## 4 1 NA 0.05 Less than 30 observations.

123
## 5 0 NA 0.05 Less than 30 observations.
## 6 12 NA 0.05 Less than 30 observations.
## 7 10 NA 0.05 Less than 30 observations.
## 8 9 NA 0.05 Less than 30 observations.
## 9 5 0.19092314 0.05 H0: DR(4) == DR(rest)
## 10 29 0.73571222 0.05 H0: DR(1) == DR(rest)
## 11 25 0.98387263 0.05 H0: DR(2) == DR(rest)
## 12 30 NA 0.05 Less than 30 observations.
## 13 18 0.43784904 0.05 H0: DR(4) == DR(rest)
## 14 59 0.37557865 0.05 H0: DR(1) == DR(rest)
## 15 52 0.43878909 0.05 H0: DR(2) == DR(rest)
## 16 81 NA 0.05 Less than 30 observations.
## 17 66 0.59778953 0.05 H0: DR(4) == DR(rest)
## 18 37 0.09280453 0.05 H0: DR(1) == DR(rest)
## 19 64 0.21298450 0.05 H0: DR(2) == DR(rest)
## 20 95 NA 0.05 Less than 30 observations.
## 21 95 NA 0.05 Less than 30 observations.
## 22 16 NA 0.05 Less than 30 observations.
## 23 33 NA 0.05 Less than 30 observations.
## 24 49 NA 0.05 Less than 30 observations.
## 25 11 NA 0.05 Less than 30 observations.
## 26 10 NA 0.05 Less than 30 observations.

The results indicate that the test could not be performed for most of the pairs due to the limited
number of observations per segment, which is below the required threshold. However, for the pairs
where the test was executed, there is no statistically significant difference between the observed
default rates of the tested modality and the remaining modalities of the selected segment. This
conclusion is supported by the fact that all the values in column [Link] are greater than the
significance level of 5%.

124
4 Ranking model calibration
After finishing the PD ranking model development (risk differentiation function), the next step
usually involves model calibration. Calibration is the process of adjusting the model output to
align with empirical Central Tendency (CT). In practice, CT is often referred to as the Long-Run
Average Default Rate (LRADR), which represents the average default rate calculated over a time
horizon that should encompass at least one business cycle, comprising a mix of both good and bad
years. Although there are no universally accepted standards for the length of the time horizon for
calibration, it is generally advisable to consider a period of at least ten years to calculate the CT
accurately.
Reasons for calibration are numerous, but in general, they all refer to the fact that we have greater
flexibility in the development of risk differentiation function and that modeling samples rarely cover
all observations of the targeted portfolio over the calibration time horizon.
When performing calibration, we typically apply constraints at the rating scale level. Remember that
there are two different types of rating scales - continuous and discrete. For continuous rating scales,
our primary focus is to maintain the ranking order of the model output while directly calibrating the
model output itself. We often enforce additional constraints, such as setting minimum or maximum
PD values. On the other hand, when calibrating discrete rating scales, we start with the observed
average default rate per rating grade as a reference point. In addition to the minimum PD constraint,
we assess the monotonicity of the averages across the rating scale. If the averages do not exhibit a
monotonic trend, we may incorporate monotonicity as an additional constraint during calibration.
To illustrate the calibration process in R, we will use the data frames db and rs from the example
of discrete rating scale creation (previous section) and the [Link] function from the
PDtoolkit package. The [Link] function offers three different types of calibration
methods:

1. linear scaling;
2. optimization of intercept of the logit transformation;
3. optimization of intercept and slope of the logit transformation.

While all three methods support the constraint of a minimum PD, none directly support the
monotonicity constraint. As a result, the ranking of the rating scale should be kept unchanged.
However, it is important to mention that monotonicity is typically ensured during the creation of
the rating scale, making it unnecessary to implement it within the [Link] function. The
calibration process within the [Link] function consists of a two-stage optimization to
meet the minimum PD constraint. The parameters from both stages are exported and should be
considered for further processing.
The forthcoming examples illustrate a scenario where we adjust the rating scale using the portfolio’s
central tendency as a reference point. While this is often the most prevalent scenario in real-world
applications, it’s essential to recognize that other scenarios are also conceivable. Specifically, in
cases involving a discrete rating scale and when sufficient data is available for assigning final ratings

125
to all observations within the calibration sample, central tendency can be computed at the rating
level. This approach is preferable, although it may only be feasible sometimes due to justifiable
constraints in the data collection process.
Let’s walk through the calibration process using the portfolio’s central tendency.
#print the final rating scale from the previous example
rs

## rating no nd dr [Link]
## 1 (-Inf, -4.16] 23 0 0.00000000 NA
## 2 (-4.16,-3.35] 71 1 0.01408451 0.28358907455341
## 3 (-3.35,-2.27] 159 12 0.07547170 0.03127490179662
## 4 (-2.27,-1.27] 248 34 0.13709677 0.02769629279760
## 5 (-1.27,-0.08] 248 86 0.34677419 0.00000002489657
## 6 (-0.08,0.87] 161 97 0.60248447 0.00000018749937
## 7 (0.87,1.69] 67 49 0.73134328 0.03237923033302
## 8 (1.69, Inf] 23 21 0.91304348 0.03526583615422
#calculate the overall default rate
sum(rs$no * rs$dr) / sum(rs$no)

## [1] 0.3
#define the calibration constraints
[Link] <- 3 * 1e-4
ct <- 0.31
#method: scaling
[Link].s <- [Link](rs = rs,
dr = "dr",
w = "no",
ct = ct,
[Link] = [Link],
method = "scaling")
#print the calibration parameters
[Link].s

## $[Link]
## [1] 0.00030000 0.01455367 0.07798569 0.14166351 0.35832536 0.62255343 0.75570457
## [8] 0.94345726
##
## $params
## iter [Link]
## 1 1 1.0333333

126
## 2 2 0.9999777
#assign the calibrated pd to data frame rs
rs$[Link] <- [Link].s[[1]]
#confirm that the calibrated pd match ct
sum(rs$no * rs$[Link]) / sum(rs$no)

## [1] 0.31
#method: intercept (a) optimization of the logit transformation
[Link].a <- [Link](rs = rs,
dr = "dr",
w = "no",
ct = ct,
[Link] = [Link],
method = "[Link].a")
#print the calibration parameters
[Link].a

## $[Link]
## [1] 0.00030000 0.01502567 0.08018132 0.14504862 0.36178869 0.61809442 0.74404283
## [8] 0.91811563
##
## $params
## iter a
## 1 1 0.06569180
## 2 2 0.06563992
#assign the calibrated pd to data frame rs
rs$[Link].a <- [Link].a[[1]]
#confirm that the calibrated pd match ct
sum(rs$no * rs$[Link].a) / sum(rs$no)

## [1] 0.3099989
#method: intercept (a) and slope (b) optimization of the logit transformation
[Link] <- [Link](rs = rs,
dr = "dr",
w = "no",
ct = ct,
[Link] = [Link],
method = "[Link]")
#print the calibration parameters

127
[Link]

## $[Link]
## [1] 0.00030000 0.01661860 0.08419663 0.14937504 0.36189302 0.61119584 0.73525517
## [8] 0.91159906
##
## $params
## iter a b
## 1 1 0.04827028 0.9717867
## 2 2 0.04823773 0.9718057
#assign the calibrated pd to data frame rs
rs$[Link] <- [Link][[1]]
#confirm that the calibrated pd match ct
sum(rs$no * rs$[Link]) / sum(rs$no)

## [1] 0.31

Finally, we can print the rating scale rs, compare the calibrated PD values, and visualize the results.
#print rating scale
rs

## rating no nd dr [Link] [Link] [Link].a

## 1 (-Inf, -4.16] 23 0 0.00000000 NA 0.00030000 0.00030000
## 2 (-4.16,-3.35] 71 1 0.01408451 0.28358907455341 0.01455367 0.01502567
## 3 (-3.35,-2.27] 159 12 0.07547170 0.03127490179662 0.07798569 0.08018132
## 4 (-2.27,-1.27] 248 34 0.13709677 0.02769629279760 0.14166351 0.14504862
## 5 (-1.27,-0.08] 248 86 0.34677419 0.00000002489657 0.35832536 0.36178869
## 6 (-0.08,0.87] 161 97 0.60248447 0.00000018749937 0.62255343 0.61809442
## 7 (0.87,1.69] 67 49 0.73134328 0.03237923033302 0.75570457 0.74404283
## 8 (1.69, Inf] 23 21 0.91304348 0.03526583615422 0.94345726 0.91811563
## [Link]
## 1 0.00030000
## 2 0.01661860
## 3 0.08419663
## 4 0.14937504
## 5 0.36189302
## 6 0.61119584
## 7 0.73525517
## 8 0.91159906

128
#visualize the observed and calibrated PDs
rs.t <- t(rs[, -c(1:3, 5)])
colnames(rs.t) <- rs$rating
[Link] <- c("gray", "green", "lightblue", "red")
barplot(height = rs.t,
main = "Observed and calibrated PDs",
col = [Link],
beside = TRUE,
xlab = "",
ylab = "",
ylim = c(0, 1),
las = 2,
[Link] = 0.70)
legend(x = "topleft",
legend = rownames(rs.t),
fill = [Link])

Observed and calibrated PDs

1.0
dr
[Link]
0.8 [Link].a
[Link]
0.6

0.4

0.2

0.0
(−Inf, −4.16]

(−4.16,−3.35]

(−3.35,−2.27]

(−2.27,−1.27]

(−1.27,−0.08]

(−0.08,0.87]

(0.87,1.69]

(1.69, Inf]

To replicate the exact two-stage optimization process, we need the calculated optimization
parameters and chosen PD minimum. The PD minimum was set to 0.03%, and the parameters are
stored in the function’s output, as shown in the code node below.

129
#method: scaling
[Link].s[["params"]]

## iter [Link]
## 1 1 1.0333333
## 2 2 0.9999777
#method: intercept (a) optimization of the logit transformation
[Link].a[["params"]]

## iter a
## 1 1 0.06569180
## 2 2 0.06563992
#method: intercept (a) and slope (b) optimization of the logit transformation
[Link][["params"]]

## iter a b
## 1 1 0.04827028 0.9717867
## 2 2 0.04823773 0.9718057

For the scaling method, to replicate the calculation, we begin by applying the scaling factor of
1.0333 to the observed default rate. Then, we check if the new PD value is lower than the selected
minimum (0.03%). If the value is lower, we set it to 0.03%. Otherwise, we multiply it by the scaling
factor from the second stage, 0.999.
stage.1 <- rs$dr * [Link].s[["params"]][1, 2]
stage.2 <- ifelse(stage.1 < 3 * 1e-4,
3 * 1e-4,
stage.1 * [Link].s[["params"]][2, 2])
identical(stage.2, rs$[Link])

## [1] TRUE

We replicate the calculation in a slightly different way for the method that optimizes the intercept
of the logit transformation. First, we apply the parameter from the first stage to the observed log
odds of the default rate. Then, we calculate the PDs from the log odds and compare them with the
chosen PD minimum. If any new PD values are lower than the chosen minimum, we set them to
the minimum. If not, we apply the second parameter to the observed log odds of the default rate.
In R, we can replicate the calculation in the following way.
[Link] <- log(rs$dr / (1 - rs$dr))
stage.1 <- exp([Link].a[["params"]][1, 2] + [Link]) /
(1 + exp([Link].a[["params"]][1, 2] + [Link]))

130
stage.2 <- ifelse(stage.1 < 3 * 1e-4,
3 * 1e-4,
exp([Link].a[["params"]][2, 2] + [Link]) /
(1 + exp([Link].a[["params"]][2, 2] + [Link])))
identical(stage.2, rs$[Link].a)

## [1] TRUE

We leave it to the readers to replicate the calculation for the method that optimizes the intercept
and slope of the logit transformation since the logic is the same as for the previously described
method.
Note that in cases where we do not have PD minimum constraint or if all calibrated values exceed
it during the optimization procedure’s first stage, the second stage’s parameters will be reported as
NA. Here is an example to illustrate this.
[Link](rs = rs,
dr = "dr",
w = "no",
ct = ct,
[Link] = 0,
method = "[Link]")

## $[Link]
## [1] 0.00000000 0.01662046 0.08420283 0.14938363 0.36190332 0.61120169 0.73525779
## [8] 0.91159807
##
## $params
## iter a b
## 1 1 0.04827028 0.9717867
## 2 2 NA NA

In order to apply the same procedure for the continuous rating scale, we need to adjust the weights
argument (w) in the [Link] function. To demonstrate this approach, we will first calculate
the within-sample PD scores of the model in use.
#column pred - log odds model scores
head(db)

## rating pred observed segment

## 1 (-0.08,0.87] 0.7840230 0 1
## 2 (-2.27,-1.27] -1.2827122 0 1
## 3 (-1.27,-0.08] -0.7263002 0 2
## 4 (-1.27,-0.08] -1.0983115 0 1

131
## 5 (-1.27,-0.08] -0.6184597 0 1
## 6 (-2.27,-1.27] -1.6311166 0 1
#calculate the probability scores from the log odds
db$pd <- exp(db$pred) / (1 + exp(db$pred))
#check the average PD score
mean(db$pd)

## [1] 0.3

Now, to apply the calibration algorithm to the continuous rating scale, we will add a new column
called weight with a value of 1. After that, we can run one of the calibration algorithms using the
same constraints as in the previous examples: a central tendency of 31% and a PD minimum of
0.03%.
db$weight <- 1
[Link] <- [Link](rs = db,
dr = "pd",
w = "weight",
ct = ct,
[Link] = [Link],
method = "[Link]")
#optimization parameters
[Link][["params"]]

## iter a b
## 1 1 0.04819492 0.9712109
## 2 2 NA NA
#summary calibrated PD (ct matched with mean)
summary([Link][["[Link]"]])

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## 0.006377 0.102645 0.233998 0.310000 0.496366 0.936113

In some instances, the presented two-stage calibration process may not meet the requested
minimum PD constraint and can potentially disrupt monotonicity. This situation typically
arises when the initially provided rating scale lacks heterogeneity, meaning the risk profile
differentiation between adjacent rating grades is insufficient. In such instances, we strongly
recommend that practitioners investigate the underlying cause of this issue and contemplate
adjusting the initial rating scale. Alternatively, another solution would involve extending the
two-stage process into a multi-stage optimization problem or considering another calibration method.

132
We seldom evaluate calibration quality at this stage because the final PD estimate incor-
porates both the calibrated PD and the margin of conservatism, which includes any additional
add-ons tailored to the portfolio or market. In PD modeling, the calibration process, in conjunction
with the Margin of Conservatism (MoC), is commonly known as risk quantification. Once we arrive
at the final PD, the usual practice involves using an out-of-time sample to conduct predictive power
tests. The objective is to ensure that the final PD does not underestimate the observed default rate.
This step is commonly performed during the initial model validation and is also an essential
component of the periodic model validation process.
We direct readers to the section Review of estimates for details.

133
5 Ranking model uncertainty
When building the PD model, our focus usually extends beyond the point estimate. We also aim to
provide a particular interval that accounts for the inherent uncertainty of the ranking model. The
crucial attribute that the method employed to construct these intervals must possess is coverage. In
simple terms, if we assert that our predictor has a 95% interval, we anticipate that, on average, 95%
of the actual observations will fall within the interval generated by our model.
The most common approach in PD modeling for estimating model uncertainty is a bootstrap.
Practitioners typically do not compare the point estimates with observed or expected scores to
check the coverage of the predictor when using a bootstrap method. Instead, their primary focus
revolves around uncertainty in the logistic regression coefficients and a WoE encoding.
Alongside the bootstrap method, the application and utilization of conformal inference in analytics
have experienced a remarkable upsurge. This approach has been gaining significant popularity and
recognition as an effective tool for various analytical tasks. What makes this method particularly
attractive is its unique feature of providing probabilistic guarantees that ensure the true outcome is
covered within the selected interval. In contrast to the previously mentioned usage of the bootstrap
method, conformal inference applied for the regression tasks directly compares point estimates with
observed or expected outcomes. Even though practitioners do not frequently employ this method in
PD modeling, it is an important analysis that can yield valuable information and insights.
From a practical standpoint, both methods can offer valuable insights, and we recommend that
readers explore both approaches to gain a comprehensive understanding and reveal meaningful
information in their analyses.

5.1 Bootstrap method

In this section, we will present three examples of quantification of model uncertainty (in the estimated
coefficients and WoE encoding) based on the bootstrap method. All examples rely on different
modeling approaches; therefore, the quantification of the uncertainty is tailored to the model-specific
design. The first two examples directly associate the confidence interval with the point estimate,
while the third simulates a full-case scenario incorporating the calibrated rating scale.
Let’s start with data preparation. In the first step, we split the loans dataset into development and
application samples. The development sample is utilized for simulating the model in use, whereas
the application sample is reserved for constructing confidence intervals. For the sake of simplicity, in
the first step, we will randomly select only ten observations for the application sample ([Link]),
leaving the rest of the observations to form the development sample ([Link]).
data(loans)
[Link](1991)
idx <- sample(x = 1:nrow(loans),
size = 10,
replace = FALSE)

134
[Link] <- loans[-idx, ]
[Link] <- loans[idx, ]

In the second step, we will discretize the numeric risk factors (on development and application
samples) as we intend to use all categorical risk factors for the following examples.
#define the numeric risk factors
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
[Link].l <- length([Link])
#discretization on the development sample
[Link] <- vector("list", [Link].l)
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
bin.i <- [Link](x = [Link][, [Link].i],
y = [Link]$Creditability)
[Link][[i]] <- [Link](rf = [Link].i,
bin.i[[1]])
[Link][, [Link].i] <- bin.i[[2]]
}
[Link] <- bind_rows([Link])
#discretization on the application sample
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
[Link].i <- [Link][[Link]$rf%in%[Link].i, c("[Link]", "[Link]")]
[Link][, [Link].i] <- [Link](x = [Link][, [Link].i],
mapping = [Link].i)
}

Now, we are ready to run the concrete examples. For the first example, we will simulate the model
in use by customized stepwise regression (stepFWDr) based on dummy encoding of categorical risk
factors.
res.1 <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = [Link])
summary(res.1$model)$coefficients

## Estimate Std. Error z value

## (Intercept) -0.26913377 0.6504045 -0.4137944
## Account_Balance2 -0.63099377 0.1974801 -3.1952267

135
## Account_Balance3 -1.20616314 0.3618635 -3.3331990
## Account_Balance4 -1.99650688 0.2162502 -9.2323927
## Duration_of_Credit__month02 [8,16) 0.80790429 0.4161327 1.9414584
## Duration_of_Credit__month03 [16,45) 1.19684743 0.4089348 2.9267439
## Duration_of_Credit__month04 [45,Inf) 1.66861640 0.5089789 3.2783604
## Length_of_current_employment2 0.33913233 0.3598305 0.9424781
## Length_of_current_employment3 -0.05274157 0.3401185 -0.1550682
## Length_of_current_employment4 -0.70236670 0.3756850 -1.8695626
## Length_of_current_employment5 -0.25135774 0.3524284 -0.7132165
## Credit_Amount02 [3914,7855) 0.44670099 0.2318608 1.9265916
## Credit_Amount03 [7855,Inf) 1.42004222 0.3324012 4.2720727
## Payment_Status_of_Previous_Credit1 -0.13604238 0.5089195 -0.2673161
## Payment_Status_of_Previous_Credit2 -1.00459124 0.3962504 -2.5352432
## Payment_Status_of_Previous_Credit3 -1.04935170 0.4589954 -2.2861923
## Payment_Status_of_Previous_Credit4 -1.62343018 0.4205600 -3.8601632
## Instalment_per_cent2 0.11325605 0.2956364 0.3830923
## Instalment_per_cent3 0.46147488 0.3203231 1.4406542
## Instalment_per_cent4 0.70433299 0.2740045 2.5705164
## Guarantors2 0.46198588 0.3871375 1.1933381
## Guarantors3 -1.00513247 0.4110611 -2.4452143
## Telephone2 -0.36176423 0.1778991 -2.0335360
## Foreign_Worker2 -1.26317851 0.6147405 -2.0548158
## Pr(>|z|)
## (Intercept) 0.67902465778584952804663999
## Account_Balance2 0.00139721047127715583026364
## Account_Balance3 0.00085853518251612006163126
## Account_Balance4 0.00000000000000000002646527
## Duration_of_Credit__month02 [8,16) 0.05220270187952309737244860
## Duration_of_Credit__month03 [16,45) 0.00342530838427836494333723
## Duration_of_Credit__month04 [45,Inf) 0.00104411999645018281970832
## Length_of_current_employment2 0.34594793461059553107972420
## Length_of_current_employment3 0.87676753065320178759378678
## Length_of_current_employment4 0.06154458027898207506112271
## Length_of_current_employment5 0.47571176847112039975939979
## Credit_Amount02 [3914,7855) 0.05403055076408547208188793
## Credit_Amount03 [7855,Inf) 0.00001936643829693082715510
## Payment_Status_of_Previous_Credit1 0.78922578270530929778203699
## Payment_Status_of_Previous_Credit2 0.01123692684029917697452472
## Payment_Status_of_Previous_Credit3 0.02224301364512673226392359

136
## Payment_Status_of_Previous_Credit4 0.00011331130215382958505935
## Instalment_per_cent2 0.70165133118994704730653211
## Instalment_per_cent3 0.14968240090811568698825340
## Instalment_per_cent4 0.01015470309929398726178640
## Guarantors2 0.23273700347380260611274139
## Guarantors3 0.01447661014084333785945091
## Telephone2 0.04199840299159166012721300
## Foreign_Worker2 0.03989680272005460132112020
#rename the columns of [Link] to match those from the model development
names([Link]) <- names(res.1$[Link])
#rename the columns of [Link] to match those from the model development
names([Link]) <- names(res.1$[Link])

Having the model in use simulated, next, we will code the bootstrap regressions function specific
for this model design (all categorical risk factors with dummy encoding in the logistic regression
model), and then the results of this function are used to construct confidence intervals.
#bootstrap regressions function
[Link].1 <- function(model, B, ct, seed) {
#model - glm object (model in use)
#B - number of bootstrap samples
#ct - central tendency used for calibration
#seed - random seed
db <- model$model
frm <- model$formula
[Link] <- nrow(db)
res <- vector("list", B)
params <- vector("list", B)
for (i in 1:B) {
[Link](seed + i)
#bootstrap the development sample
idx <- sample(x = 1:[Link],
size = [Link],
replace = TRUE)
[Link] <- db[idx, ]
#estimate the model on the simulated sample
res[[i]] <- glm(formula = frm,
family = "binomial",
data = [Link])
#calibrate the model

137
 [Link]$pred <- predict(object = res[[i]],
type = "response")
[Link]$w <- 1
calib <- [Link](rs = [Link],
dr = "pred",
w = "w",
ct = ct,
[Link] = 0,
method = "[Link]")
params[[i]] <- calib[[2]][1, ]
}
return(list(regs = res, params = params))
}
#bootstrap regressions
B <- 100
[Link].1 <- [Link].1(model = res.1$model,
B = B,
ct = mean([Link]$Creditability),
seed = 1)
#create 95% confidence interval for the observations from [Link]
[Link] <- nrow([Link])
[Link].1 <- vector("list", [Link])
for (i in 1:[Link]) {
[Link].j <- [Link][i, ]
[Link] <- rep(NA, B)
for (j in 1:B) {
#model estimation
[Link] <- predict(object = [Link].1[[1]][[j]],
type = "link",
newdata = [Link].j)
#model calibration
a <- [Link].1[[2]][[j]][, "a"]
b <- [Link].1[[2]][[j]][, "b"]
[Link][j] <- exp(a + b * [Link]) /
(1 + exp(a + b * [Link]))
}
#confidence interval
ci.i <- quantile(x = [Link], probs = c(0.025, 0.975))
[Link].1[[i]] <- [Link](obs = i, [Link](t(ci.i)))

138
 }
[Link].1 <- bind_rows([Link].1)
names([Link].1) <- c("obs", "2.5%", "97.5%")
#add the model in use predictions
[Link].1 <- predict(object = res.1$model,
type = "response",
newdata = [Link])
[Link].1 <- [Link]([Link].1,
"[Link]" = unname([Link].1))
#confidence intervals
[Link].1

## obs 2.5% 97.5% [Link]

## 1 1 0.259991983 0.58316355 0.42564144
## 2 2 0.118416163 0.40727357 0.22800765
## 3 3 0.284058919 0.66568380 0.45816028
## 4 4 0.863190285 0.98266045 0.94268362
## 5 5 0.021603595 0.20921514 0.07768301
## 6 6 0.002684536 0.02753678 0.01003652
## 7 7 0.358020307 0.62869153 0.49678868
## 8 8 0.060379027 0.29420060 0.13899876
## 9 9 0.029900831 0.09754703 0.05932442
## 10 10 0.185253868 0.50883017 0.34042052

From the demonstration above, it is apparent that the confidence interval is computed using a small
application sample consisting of just ten cases. For larger sample sizes, the execution time may be
considerably higher. Nevertheless, we encourage readers to conduct this analysis on a reasonably
sized sample of observations drawn from the training dataset to understand the confidence interval’s
width better.
The previous example described a model design with dummy encoding; therefore, the only source of
uncertainty comes from the variability of the estimated coefficients. Now, suppose instead of dummy
encoding, we use WoE encoding. In this scenario, we introduce an additional source of uncertainty
arising from the usage of WoE encoding, which relies on the target variable values extracted from
the development sample. Certain practitioners contend that including this uncertainty is not aligned
with the model’s intended use. However, as we train our model on a random sample of data, we find
that utilizing this source of uncertainty is acceptable. Therefore, the following user-defined function
[Link].2 will address this additional source of uncertainty. Before we again simulate the model
in use, we will exclude risk factors Foreign_Worker, Purpose, and Value_Savings_Stocks due to
the low number of observations of some modalities and possible problems with WoE calculation. In
practice, we would not exclude these risk factors by default but rather test additional experts or

139
statistical grouping of their modalities and then decide on their further use.
#exclude "Foreign_Worker" and "Purpose"
[Link] <- c("Foreign_Worker", "Purpose", "Value_Savings_Stocks")
[Link] <- [Link][, !names([Link])%in%[Link]]
#replace WoE
[Link] <- [Link](db = [Link],
target = "Creditability")[[1]]
#run the model
res.2 <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = [Link])
summary(res.2$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.8554885 0.08256242 -10.361718 3.702517e-25
## Account_Balance -0.9341454 0.10360761 -9.016186 1.947520e-19
## Duration_of_Credit__month -0.5899681 0.18053682 -3.267854 1.083661e-03
## Payment_Status_of_Previous_Credit -0.7531714 0.15155104 -4.969754 6.703785e-07
## Length_of_current_employment -0.7659614 0.28226588 -2.713617 6.655310e-03
## Guarantors -1.1451308 0.41452381 -2.762521 5.735683e-03
## Credit_Amount -0.8194957 0.24057493 -3.406405 6.582438e-04
## Instalment_per_cent -2.0351546 0.51997425 -3.913953 9.079748e-05
## Sex___Marital_Status -1.0313511 0.38045912 -2.710807 6.711975e-03
## Age__years -0.6282686 0.26848421 -2.340058 1.928076e-02
## Duration_in_Current_address -3.0242232 1.51339649 -1.998302 4.568393e-02
## Most_valuable_available_asset -0.5060235 0.25574021 -1.978662 4.785406e-02
#run the bivariate analysis (risk factors from the final model)
rfm.b <- bivariate(db = [Link][, c("Creditability", res.2$steps$rf)],
target = "Creditability")[[1]]

Now, we are ready to code and run another bootstrap regression function tailored to this model
design. Note that we usually pay closer attention to the programming of this function due to the
WoE encoding. Namely, in repetitive sampling, for some risk factors, we cannot calculate the WoE
value (modality contains all good or all bad cases); thus, such situations should be covered within
the function flow. At this stage, the importance of the proper binning process comes into play.
If all the preceding modeling steps are correctly performed, we decrease the chances of possible
problems with the WoE calculations. We keep the simple function flow for this example, assuming
all preceding steps were executed correctly.

140
#bootstrap regression function
[Link].2 <- function(model, [Link], woe, B, ct, seed) {
#model - glm object (model in use)
#[Link] - development sample on untransformed risk factors
#woe - woe table for risk factors from the final model
#B - number of bootstrap samples
#ct - central tendency used for calibration
#seed - random seed
frm <- model$formula
[Link] <- nrow([Link])
[Link] <- vector("list", B)
[Link] <- vector("list", B)
params <- vector("list", B)
for (i in 1:B) {
[Link](seed + i)
#bootstrap development sample
idx <- sample(x = 1:[Link],
size = [Link],
replace = TRUE)
[Link] <- [Link][idx, ]
#replace WoE on simulated sample
[Link].i <- [Link](db = [Link],
target = "Creditability")[[1]]
#estimate model on simulated sample
[Link][[i]] <- glm(formula = frm,
family = "binomial",
data = [Link].i)
#store WoE table
[Link][[i]] <- bivariate(db = [Link], target = "Creditability")[[1]]
#calibrate the model
[Link]$pred <- predict(object = [Link][[i]],
type = "response")
[Link]$w <- 1
calib <- [Link](rs = [Link],
dr = "pred",
w = "w",
ct = ct,
[Link] = 0,
method = "[Link]")

141
 params[[i]] <- calib[[2]][1, ]
}
return(list(regs = [Link], [Link] = [Link], params = params))
}
#bootstrap regressions
[Link].2 <- [Link].2(model = res.2$model,
[Link] = [Link][, c("Creditability",
res.2$steps$rf)],
woe = rfm.b,
ct = mean([Link]$Creditability),
B = B,
seed = 984)

After coding the function above, we can proceed with calculating confidence intervals. As the first
step, we must perform WoE encoding for risk factors on the application sample and then run the
simulations.
#WoE encoding on application sample:
#each bootstrap regression has different WoE encoding
[Link] <- vector("list", B)
[Link] <- unique(rfm.b$rf)
for (i in 1:B) {
[Link].i <- [Link]
[Link].i <- [Link].2[["[Link]"]][[i]]
for (j in 1:length([Link])) {
rf.i <- [Link][j]
mapping <- [Link].i[[Link].i$rf%in%rf.i, c("bin", "woe")]
names(mapping) <- c("[Link]", "[Link]")
[Link].i[, rf.i] <- [Link](x = [Link][, rf.i],
mapping = mapping)
}
[Link][[i]] <- [Link].i
}
#create 95% confidence interval for the observations from [Link]
[Link] <- nrow([Link])
[Link].2 <- vector("list", [Link])
for (i in 1:[Link]) {
[Link] <- rep(NA, B)
for (j in 1:B) {
#WoE table for bootstrap regression

142
 [Link].j <- [Link][[j]][i, ]
#model estimation
[Link] <- predict(object = [Link].2[[1]][[j]],
type = "link",
newdata = [Link].j)
#model calibration
a <- [Link].2[[3]][[j]][, "a"]
b <- [Link].2[[3]][[j]][, "b"]
[Link][j] <- exp(a + b * [Link]) /
(1 + exp(a + b * [Link]))
}
#confidence interval
ci.i <- quantile(x = [Link], probs = c(0.025, 0.975))
[Link].2[[i]] <- [Link](obs = i, [Link](t(ci.i)))
}
[Link].2 <- bind_rows([Link].2)
names([Link].2) <- c("obs", "2.5%", "97.5%")
#add the model in use predictions
[Link].b <- [Link]
for (i in 1:length([Link])) {
rf.i <- [Link][i]
mapping <- rfm.b[rfm.b$rf%in%rf.i, c("bin", "woe")]
names(mapping) <- c("[Link]", "[Link]")
[Link].b[, rf.i] <- [Link](x = [Link][, rf.i],
mapping = mapping)
}
[Link].2 <- predict(object = res.2$model,
type = "response",
newdata = [Link].b)
[Link].2 <- [Link]([Link].2,
"[Link]" = unname([Link].2))
#confidence intervals
[Link].2

## obs 2.5% 97.5% [Link]

## 1 1 0.22362727 0.53117852 0.371347158
## 2 2 0.10627979 0.43115521 0.185318819
## 3 3 0.29293168 0.72952223 0.480500928
## 4 4 0.73584942 0.97403045 0.876291070

143
## 5 5 0.03736331 0.21984933 0.112065593
## 6 6 0.00195110 0.03089343 0.008846062
## 7 7 0.43430140 0.68636765 0.593954074
## 8 8 0.04092573 0.23566453 0.115624505
## 9 9 0.02408519 0.09797363 0.050358951
## 10 10 0.25206287 0.53904741 0.400341614

Let’s now extend the model design from the last example, assuming that we created and calibrated
the rating scale after we developed the final model. For this example, we will use the last model
stored in the object res.2 and create a rating scale using the [Link] function from the monobin
package.
#add the model prediction to the development sample
[Link]$pred <- unname(predict(object = res.2$model))
#create the rating scale
[Link] <- [Link](x = [Link]$pred, y = [Link]$Creditability)
[Link]$rating <- [Link][[2]]
rs <- [Link] %>%
group_by(rating) %>%
summarise(no = n(),
nd = sum(Creditability),
dr = mean(Creditability)) %>%
[Link]()
rs

## rating no nd dr
## 1 01 (-Inf,-2.4243) 194 8 0.04123711
## 2 02 [-2.4243,-1.5679) 221 28 0.12669683
## 3 03 [-1.5679,-0.9559) 132 27 0.20454545
## 4 04 [-0.9559,-0.0753) 200 68 0.34000000
## 5 05 [-0.0753,0.3084) 82 48 0.58536585
## 6 06 [0.3084,Inf) 161 117 0.72670807
#average default rate
sum(rs$no * rs$dr / sum(rs$no))

## [1] 0.2989899
#calibrate the rating scale
ct <- 0.33
[Link] <- [Link](rs = rs,
dr = "dr",
w = "no",

144
 ct = ct,
[Link] = 0,
method = "[Link]")
rs$[Link] <- [Link][[1]]
#check
sum(rs$no * rs$[Link] / sum(rs$no))

## [1] 0.33
#print rating scale with calibrated PDs
rs

## rating no nd dr [Link]
## 1 01 (-Inf,-2.4243) 194 8 0.04123711 0.0606322
## 2 02 [-2.4243,-1.5679) 221 28 0.12669683 0.1640790
## 3 03 [-1.5679,-0.9559) 132 27 0.20454545 0.2488778
## 4 04 [-0.9559,-0.0753) 200 68 0.34000000 0.3848536
## 5 05 [-0.0753,0.3084) 82 48 0.58536585 0.6114032
## 6 06 [0.3084,Inf) 161 117 0.72670807 0.7373800

Let’s now create a 95% confidence interval considering the calibrated rating scale and bootstrap
regressions simulated in the previous example (object [Link].2).
#create a 95% confidence interval for the observations from [Link]
[Link] <- nrow([Link])
[Link].3 <- vector("list", [Link])
mapping <- [Link][[1]][, c("[Link]", "[Link]")]
[Link] <- rs$[Link]
names([Link]) <- rs$rating
for (i in 1:[Link]) {
[Link] <- rep(NA, B)
for (j in 1:B) {
[Link] <- predict(object = [Link].2[["regs"]][[j]],
type = "link",
newdata = [Link][[j]][i, ])
a <- [Link].2[[3]][[j]][, "a"]
b <- [Link].2[[3]][[j]][, "b"]
[Link][j] <- a + b * [Link]
}
ratings <- [Link](x = unname([Link]),
mapping = mapping)
[Link] <- unname([Link][ratings])

145
 ci.i <- quantile(x = [Link], probs = c(0.025, 0.975), type = 2)
[Link].3[[i]] <- [Link](obs = i, [Link](t(ci.i)))
}
[Link].3 <- bind_rows([Link].3)
names([Link].3) <- c("obs", "2.5%", "97.5%")
#add the model in use predictions
[Link].3 <- predict(object = res.2$model,
type = "link",
newdata = [Link].b)
#assign the rating
[Link] <- [Link](x = unname([Link].3),
mapping = mapping)
#assign the PD
[Link] <- unname([Link][[Link]])
#add the best estimate to simulation results
[Link].3 <- [Link]([Link].3,
"[Link]" = unname([Link]))
#confidence intervals
[Link].3

## obs 2.5% 97.5% [Link]

## 1 1 0.2488778 0.6114032 0.3848536
## 2 2 0.1640790 0.3848536 0.2488778
## 3 3 0.3848536 0.7373800 0.3848536
## 4 4 0.7373800 0.7373800 0.7373800
## 5 5 0.0606322 0.2488778 0.1640790
## 6 6 0.0606322 0.0606322 0.0606322
## 7 7 0.3848536 0.7373800 0.7373800
## 8 8 0.0606322 0.2488778 0.1640790
## 9 9 0.0606322 0.1640790 0.0606322
## 10 10 0.2488778 0.6114032 0.3848536

Additionally, we can add a rating grade to the estimated intervals as follows:

[Link].3$[Link] <- rs$rating[findInterval(x = [Link].3$"2.5%",
vec = rs$[Link])]
[Link].3$[Link] <- rs$rating[findInterval(x = [Link].3$"97.5%",
vec = rs$[Link])]
[Link].3$[Link] <- rs$rating[findInterval(x = [Link].3$"[Link]",
vec = rs$[Link])]
[Link].3

146
## obs 2.5% 97.5% [Link] [Link]
## 1 1 0.2488778 0.6114032 0.3848536 03 [-1.5679,-0.9559)
## 2 2 0.1640790 0.3848536 0.2488778 02 [-2.4243,-1.5679)
## 3 3 0.3848536 0.7373800 0.3848536 04 [-0.9559,-0.0753)
## 4 4 0.7373800 0.7373800 0.7373800 06 [0.3084,Inf)
## 5 5 0.0606322 0.2488778 0.1640790 01 (-Inf,-2.4243)
## 6 6 0.0606322 0.0606322 0.0606322 01 (-Inf,-2.4243)
## 7 7 0.3848536 0.7373800 0.7373800 04 [-0.9559,-0.0753)
## 8 8 0.0606322 0.2488778 0.1640790 01 (-Inf,-2.4243)
## 9 9 0.0606322 0.1640790 0.0606322 01 (-Inf,-2.4243)
## 10 10 0.2488778 0.6114032 0.3848536 03 [-1.5679,-0.9559)
## [Link] [Link]
## 1 05 [-0.0753,0.3084) 04 [-0.9559,-0.0753)
## 2 04 [-0.9559,-0.0753) 03 [-1.5679,-0.9559)
## 3 06 [0.3084,Inf) 04 [-0.9559,-0.0753)
## 4 06 [0.3084,Inf) 06 [0.3084,Inf)
## 5 03 [-1.5679,-0.9559) 02 [-2.4243,-1.5679)
## 6 01 (-Inf,-2.4243) 01 (-Inf,-2.4243)
## 7 06 [0.3084,Inf) 06 [0.3084,Inf)
## 8 03 [-1.5679,-0.9559) 02 [-2.4243,-1.5679)
## 9 02 [-2.4243,-1.5679) 01 (-Inf,-2.4243)
## 10 05 [-0.0753,0.3084) 04 [-0.9559,-0.0753)

The above examples are simplified yet realistic case studies from practice. We encourage readers to
experiment with different analysis designs, especially in the modular approach for PD rating model
development. In addition to the commonly practiced method of employing empirical quantiles to
derive the confidence interval from the bootstrap distribution, exploring alternative approaches
is also recommended. Examples of such methods include bias-corrected and accelerated (BCa)
intervals or bootstrap-t confidence intervals.
With minor adjustments, this approach can effectively address the margin of conservatism, particu-
larly category C, which pertains to the general estimation error of estimated parameters.

5.2 Conformal inference

Conformal inference is a model-agnostic method used to estimate uncertainty in supervised problems.
Its fundamental ability lies in producing prediction intervals for forthcoming observations, all
without relying on any assumptions about the underlying distribution, except for the prerequisite of
independent and identically distributed (iid) data or, in a broader sense, exchangeable data. There
is a notable distinction between the conformal inference approaches for classification and regression
tasks. For PD modeling, where the interest lies in predicting a continuous outcome, we must assume
that logistic regression is used for the regression task. Adopting this assumption is crucial to ensure

147
the appropriate application of the conformal inference method in this context. Unlike the presented
implementation of the bootstrap method, conformal inference, among other steps, compares point
estimates with observed or expected outcomes. This is achieved using the non-conformity score,
which needs to be defined beforehand. Once we have defined and computed the non-conformity
scores, the next step involves calculating a specific percentile of these scores (non-conformity bound)
and designating it as the conformal band. It is highly recommended to compute the non-conformity
bound on an independent sample, often referred to as the calibration sample. It’s also important to
note that even though the same notation of the samples may be used for both the model calibration
and the calibration sample for the non-conformity bound these two samples serve entirely different
purposes in the analysis. The calibration sample in this context is explicitly utilized to establish
the non-conformity bound, ensuring its accuracy and reliability for future predictions. Subtracting
and adding non-conformity bound from and to the point estimate of our model, we define the lower
and upper prediction intervals, which capture the model uncertainty allowing us to do the same
for all future observations. Verifying the marginal coverage of the chosen conformal predictor is
usually the last step of the conformal inference process. This verification is typically conducted on
a separate evaluation sample. Performing this step is critical to ensure the appropriateness and
reliability of the chosen conformal predictor for making accurate predictions in the future. The
process described is commonly called split conformal prediction.

Before we exemplify the above process in R, let’s simulate the following:

1. application portfolio for creating the conformal prediction intervals;

2. training dataset for simulating a model in use;
3. calibration sample for calculating non-conformity bound;
4. evaluation sample for verifying the predictor’s marginal coverage.
data(loans)
#the same application portfolio as in the bootstrap examples
[Link](1991)
idx <- sample(x = 1:nrow(loans), size = 10, replace = FALSE)
[Link] <- loans[-idx, ]
[Link] <- loans[idx, ]
#reset the row index
[Link]([Link]) <- NULL
#split [Link] on the training, calibration and evaluation sample
[Link](4)
[Link] <- sample(x = rep(1:2, c(790, 200)))
#training dataset
train <- [Link][[Link] == 1, ]
#calibration dataset
calib <- train[sample(1:nrow(train))[c(TRUE, FALSE)], ]

148
#evaluation dataset
evalu <- [Link][[Link] == 2, ]

In the above code, there is an overlap between the training and calibration samples, which is
generally not considered good practice. However, we will still use the overlapping approach for this
example due to the limited number of available observations in the modeling datasets.
In the next step, we will simulate the model in use and prepare the calibration, evaluation, and
application samples to estimate the model predictions. This step also involves discretizing the
numeric risk factors on the mentioned samples.
#define numeric risk factors
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
[Link].l <- length([Link])
#discretization of the numeric risk factors ([Link] function)
[Link] <- vector("list", [Link].l)
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
bin.i <- [Link](x = train[, [Link].i],
y = train$Creditability)
[Link][[i]] <- [Link](rf = [Link].i,
bin.i[[1]])
train[, [Link].i] <- bin.i[[2]]
}
[Link] <- bind_rows([Link])
#build the model in use
res <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = train)
#calculate the final model auc
[Link](predictions = predict(object = res$model),
observed = train$Creditability)

## [1] 0.7856237
#discretization of the numeric risk factors on the calib, evalu, and [Link]
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
[Link].i <- [Link][[Link]$rf%in%[Link].i, c("[Link]", "[Link]")]
#calibration sample
calib[, [Link].i] <- [Link](x = calib[, [Link].i],

149
 mapping = [Link].i)
#evaluation sample
evalu[, [Link].i] <- [Link](x = evalu[, [Link].i],
mapping = [Link].i)
#application sample
[Link][, [Link].i] <- [Link](x = [Link][, [Link].i],
mapping = [Link].i)
}
#rename columns of the calibration, evaluation, and application samples
names(train) <- names(res$[Link])
names(calib) <- names(res$[Link])
names(evalu) <- names(res$[Link])
names([Link]) <- names(res$[Link])
#add predictions to all samples
train$pred <- predict(object = res$model)
calib$pred <- predict(object = res$model,
newdata = calib)
evalu$pred <- predict(object = res$model,
newdata = evalu)
[Link]$pred <- predict(object = res$model,
newdata = [Link])

Now that we have all the necessary components, we can define the non-conformity score. For
this example, we will define the non-conformity score as the absolute difference between the point
estimate and the expected estimate of the perfect model. We define the perfect model as one that
exhibits an ideal rank ordering of the point estimates.
Let’s explore how to implement this in R for our simulated model on the training dataset.
#perfect scores of the training dataset
train <- train[order(train$Creditability, train$pred), ]
train$[Link] <- sort(train$pred)
#check auc of the perfect model
[Link](predictions = train$[Link],
observed = train$Creditability)

## [1] 0.9999962

Note that the AUC of the perfect model is almost 1, exactly as intended. To derive an unbiased
non-conformity bound, we need to find a specific percentile of the non-conformity score on the
calibration sample. So, let’s repeat the same process, using the calibration sample this time.

150
#perfect scores of the calibration dataset
calib <- calib[order(calib$Creditability, calib$pred), ]
calib$[Link] <- sort(calib$pred)
#auc confirmation of the perfect model
[Link](predictions = calib$[Link],
observed = calib$Creditability)

## [1] 0.9999103

Moving forward, our next step involves calculating the non-conformity scores by finding the difference
between point estimates and perfect scores. Additionally, we will compute the non-conformity bound
as the 95th percentile of the non-conformity scores.
#non-conformity scores
calib$ncs <- abs(calib$[Link] - calib$pred)
#non-conformity bound
d <- unname(quantile(x = calib$ncs, probs = 0.95))
d

## [1] 1.3943

Finally, we have to confirm that our conformal predictor ensures at least 95% coverage. To do so
we will utilize the evaluation dataset and construct prediction intervals based on point estimates
and calibrated non-conformity bound as follows:
#perfect scores of the evaluation dataset
evalu <- evalu[order(evalu$Creditability, evalu$pred), ]
evalu$[Link] <- sort(evalu$pred)
#lower bound of the conformal prediction interval
evalu$lwr <- evalu$pred - d
#upper bound of the conformal prediction interval
evalu$upr <- evalu$pred + d
#marginal coverage
evalu$check <- evalu$[Link] < evalu$lwr |
evalu$[Link] > evalu$upr
1 - sum(evalu$check) / nrow(evalu)

## [1] 0.97

Deriving the coverage distribution is commonly recommended as a good practice to prevent reliance
on a single value of the calculated coverage from the evaluation sample. We can derive the coverage
distribution using the re-sampling method as follows:

1. re-sample the calibration and evaluation samples to create disjoint sets;

151
 2. calculate the non-conformity bound on the re-sampled calibration dataset;
3. evaluate the coverage on the re-sampled evaluation dataset;
4. repeat steps from 1 to 3 N times to obtain the coverage distribution;
5. verify if the chosen marginal coverage level falls within the simulated range (e.g., 95% interval
of the simulated coverage).

Let’s demonstrate the above steps in R.

#bind calibration and evaluation sample together
cols <- c("Creditability", "pred")
[Link] <- bind_rows(calib[, cols], evalu[, cols])
#define number of simulations
N <- 1000
#simulate coverage distribution
[Link] <- rep(NA, N)
[Link] <- nrow(calib)
[Link] <- nrow([Link])
for (i in 1:N) {
[Link](i)
#re-sample index
idx <- sample(x = 1:[Link],
size = [Link],
replace = FALSE)
#re-sampled calib and evalu datasets
[Link] <- [Link][idx, ]
[Link] <- [Link][-idx, ]
#calculate non-conformity bound on the [Link] dataset
[Link] <- [Link][order([Link]$Creditability, [Link]$pred), ]
[Link]$[Link] <- sort([Link]$pred)
[Link]$ncs <- abs([Link]$[Link] - [Link]$pred)
[Link] <- unname(quantile(x = [Link]$ncs, probs = 0.95))
#calculate coverage on the [Link] sample
[Link] <- [Link][order([Link]$Creditability, [Link]$pred), ]
[Link]$[Link] <- sort([Link]$pred)
[Link]$lwr <- [Link]$pred - [Link]
[Link]$upr <- [Link]$pred + [Link]
[Link]$check <- [Link]$[Link] < [Link]$lwr |
[Link]$[Link] > [Link]$upr
[Link][i] <- 1 - sum([Link]$check) / nrow([Link])
}

152
#coverage 95% range
quantile(x = [Link], probs = c(0.025, 0.975))

## 2.5% 97.5%
## 0.890 0.985
#coverage distribution
hist(x = [Link],
ylim = c(0, 400),
xlab = "Simulated coverage",
ylab = "Frequency",
main = "Simulated coverage distribution")

Simulated coverage distribution

400
300
Frequency

200
100
0

0.85 0.90 0.95 1.00

Simulated coverage

As observed, our conformal predictor achieves the selected coverage level, indicating its reliability.
Consequently, it is suitable for constructing prediction intervals for observations from the application
portfolio.
#lower bound of the conformal prediction interval (probability scores)
[Link]$lwr <- exp([Link]$pred - d) / (1 + exp([Link]$pred - d))
#upper bound of the conformal prediction interval (probability scores)
[Link]$upr <- exp([Link]$pred + d) / (1 + exp([Link]$pred + d))

153
#point estimates
[Link]$[Link] <- exp([Link]$pred) / (1 + exp([Link]$pred))
#application portfolio summary
app.s <- [Link](obs = 1:nrow([Link]),
[Link][, c("lwr", "upr", "[Link]")])
app.s

## obs lwr upr [Link]

## 1 1 0.117837485 0.68471578 0.35006119
## 2 2 0.108287407 0.66379319 0.32870336
## 3 3 0.112979861 0.67435329 0.33931271
## 4 4 0.602395435 0.96098660 0.85933235
## 5 5 0.045288499 0.43542347 0.16056146
## 6 6 0.005571585 0.08348669 0.02209224
## 7 7 0.163441692 0.76056130 0.44064610
## 8 8 0.042470736 0.41898491 0.15171133
## 9 9 0.023323091 0.27966724 0.08783087
## 10 10 0.082294303 0.59315520 0.26555848

Let’s now visualize the training dataset’s conformal prediction intervals and plot them against the
model log odd scores.
#calculate lower bound of the prediction interval
train$lwr <- train$pred - d
#calculate upper bound of the prediction interval
train$upr <- train$pred + d
#translate log odd scores into probability scores
train$[Link] <- exp(train$lwr) / (1 + exp(train$lwr))
train$[Link] <- exp(train$pred) / (1 + exp(train$pred))
train$[Link] <- exp(train$upr) / (1 + exp(train$upr))
#plot prediction intervals
train <- train[order(train$pred), ]
plot(x = train$pred,
y = train$[Link],
ylim = c(0, 1),
main = "Conformal prediction intervals\nof the point estimates",
xlab = "Log odd scores",
ylab = "Model probability scores",
type = "n")
polygon(x = c(train$pred, rev(train$pred)),

154
 y = c(train$[Link], rev(train$[Link])),
border = FALSE,
col = "lightblue")
lines(x = train$pred,
y = train$[Link])

Conformal prediction intervals

of the point estimates
1.0
Model probability scores

0.8
0.6
0.4
0.2
0.0

−4 −2 0 2

Log odd scores

Note that the width of the conformal prediction intervals relies on the model’s capability to rank
the point estimates accurately. The higher the model’s quality, the narrower the intervals will be.
The primary criticism of this approach is the fixed width of the interval (non-conformity bound d
for the log odds) that it produces. Usually, the residual variance tends to vary nontrivially with
model estimates in real-world scenarios. To address this, we need an additional model for the
residual variance. Adding a new model also affects the calculation of the non-conformity bound.
Common practice involves calculating a scaled non-conformity bound ([Link] from the following
example) and then adjusting the conformal prediction interval based on the model estimate of the
variance for a specific observation. In essence, this process re-scales the non-conformity bound by
the estimated variance, and it is commonly referred to as adaptive conformal inference in practical
applications. To demonstrate how this can be done in R, let’s first visualize the absolute deviations
between point estimates and perfect scores against the model scores on the training dataset.

155
#absolute deviations on the training dataset
train$ad <- abs(train$[Link] - train$pred)
#absolute deviation vs point estimate
train <- train[order(train$pred), ]
plot(x = train$pred,
y = train$ad,
col = ifelse(train$Creditability == 0, "green", "red"),
main = "AD vs models scores",
ylab = "AD",
xlab = "Model scores")
#add the boundaries of the regions with different variability
abline(v = c(-2.1, 1), col = "lightblue")

AD vs models scores
2.5
2.0
1.5
AD

1.0
0.5
0.0

−4 −2 0 2

Model scores

From the presented graph, we can conclude at least the following:

1. there are three regions with different variability levels;

2. two curves refer separately to clients with Creditability equal to 0 (green) and 1 (red) (i.e.,
to the non-defaulted and defaulted clients).

Regarding the first point, the right tail of the graph (from the minimum value of the model
scores up to approximately -2.1) presents the region of the non-defaulted clients, who were mainly

156
appropriately ranked. The second region refers to the left tail of the graph (from the approximate
model score of 1 up to the maximum value of the model scores) and defaulted clients with mild
variability in the ranking order. Finally, the region between model scores of -2.1 and 1 shows the
highest rank-order variability. Having this in mind and the fact that two presented curves refer
to non-defaulted and defaulted clients, we can model variance based on the smoothing splines as
follows:

1. develop the first model for non-defaulted clients (Creditability equal to 0);
2. develop the second model for defaulted clients (Creditability equal to 1);
3. for the model scores between minimum score and -2.1, we apply the first model; for the model
scores from 1 to the maximum score, we apply the second model; and for the model scores
between -2.1 and 1, we apply the maximum between the first and the second model;
4. introduce a constant to adjust the model’s variance predictions and address overly narrow
intervals in the tails while ensuring that the desired level of coverage is maintained.

By setting the model score bounds to denote higher model uncertainty in step 3, we obtain U-shape
prediction intervals for the region between the bounds, as observed in further analysis. The rationale
behind the U-shape is as follows: the earlier the model makes a ranking error for the good client
(Creditability equal to 0), the wider the interval will be in that region. Conversely, the same
logic applies to bad clients (Creditability equal to 1), but in the opposite direction - the later the
model makes a ranking error, the wider the interval will be. In contrast to the regions around the
bounds, the midpoint area is where the model is less uncertain, as we have a greater mix of good
and bad clients. This balance results in a more refined prediction interval, forming the U-shape
interval in the overall region.
Further, without incorporating step 4 in the variance model, we would encounter a situation
where prediction intervals become extremely narrow in the tails, almost constant, while becoming
excessively wide in regions with higher model uncertainty. To better comprehend the impact of step 4,
readers are encouraged to conduct simulations with the constant shift set to both 0 and a reasonable
value. We have opted for a constant value of 0.5 in the given example. Furthermore, readers can
consider the values of the constant and the limits of higher uncertainty as hyperparameters and
experiment with tuning them for their specific cases to achieve optimal prediction intervals while
maintaining the desired level of coverage. Additionally, we encourage readers to explore smoothing
techniques for the variance model’s predictions in regions with higher uncertainty.

Let’s perform the above steps and check the marginal coverage of our new conformal predictor. We
will begin with the model for non-defaulted clients.
[Link].0 <- [Link](y = train$ad[train$Creditability == 0],
x = train$pred[train$Creditability == 0],
df = 5)
[Link] <- predict(object = [Link].0,
x = train$pred[train$Creditability == 0])$y

157
#visualize the model fit
plot(x = train$pred[train$Creditability == 0],
y = train$ad[train$Creditability == 0],
main = "MAD vs point estimate\nCreditability == 0",
ylab = "MAD",
xlab = "Point estimate")
lines(x = train$pred[train$Creditability == 0],
y = [Link],
col = "green")
legend(x = "topleft",
legend = c("observed mad", "mad model 0"),
fill = c("black", "green"))

MAD vs point estimate

Creditability == 0
2.5

observed mad
mad model 0
2.0
1.5
MAD

1.0
0.5
0.0

−4 −2 0 2

Point estimate

Let’s do the same for the defaulted clients.

[Link].1 <- [Link](y = train$ad[train$Creditability == 1],
x = train$pred[train$Creditability == 1],
df = 5)
[Link] <- predict(object = [Link].1,
x = train$pred[train$Creditability == 1])$y

158
#visualize the model fit
plot(x = train$pred[train$Creditability == 1],
y = train$ad[train$Creditability == 1],
main = "MAD vs point estimate\nCreditability == 1",
ylab = "MAD",
xlab = "Point estimate")
lines(x = train$pred[train$Creditability == 1],
y = [Link],
col = "red")
legend(x = "topright",
legend = c("observed mad", "mad model 1"),
fill = c("black", "red"))

MAD vs point estimate

Creditability == 1
2.5

observed mad
mad model 1
2.0
1.5
MAD

1.0
0.5
0.0

−3 −2 −1 0 1 2

Point estimate

Visualize these two models with the regions for the model implementation and constant to address
narrow intervals in the tails.
#limits for the model implementation
[Link].0 <- 1
[Link].1 <- -2.1
#model shift

159
[Link] <- 0.5
#mad graph (train dataset)
plot(x = train$pred,
y = train$ad,
main = "MAD vs point estimate\n(training dataset)",
ylab = "MAD",
xlab = "Point estimate")
abline(v = c([Link].0, [Link].1), col = "lightblue")
lines(x = train$pred[train$Creditability == 0],
y = [Link] + [Link],
col = "green")
lines(x = train$pred[train$Creditability == 1],
y = [Link] + [Link],
col = "red")
legend(x = -2,
y = max(train$ad),
legend = c("mad model 0", "mad model 1", "bounds"),
fill = c("green", "red", "lightblue"))

MAD vs point estimate

(training dataset)
2.5

mad model 0
mad model 1
2.0

bounds
1.5
MAD

1.0
0.5
0.0

−4 −2 0 2

Point estimate

Finally, let’s code the last step of the model implementation rule. For this purpose, we will create a

160
user-defined function called [Link].
[Link] <- function(m0, m1, s0, s1, shift, x) {
options(warn = -1)
pred <- rep(NA, length(x))
#m0 predictions
p.0 <- predict(object = m0,
x = x[x < s1])$y
#ensure the prediction from m0 are always greater than 0
pred[x < s1] <- ifelse(p.0 < 0,
pmin(min(p.0[p.0 > 0]), 1e-6),
p.0)
#m1 predictions
p.1 <- predict(object = m1,
x = x[x > s0])$y
#ensure the prediction from m1 are always greater than 0
pred[x > s0] <- ifelse(p.1 < 0,
pmin(min(p.1[p.1 > 0]), 1e-6),
p.1)
#m0 & m1 predictions combination
p.m.0 <- predict(object = m0,
x = x[x <= s0 & x >= s1])$y
p.m.1 <- predict(object = m1,
x = x[x <= s0 & x >= s1])$y
p.m.01 <- mapply(FUN = "max", p.m.0, p.m.1)
#ensure the combined predictions are always greater than 0
p.m.01 <- ifelse(p.m.01 < 0,
pmin(min(p.m.01[p.m.01 > 1e-6]), 0),
p.m.01)
pred[x <= s0 & x >= s1] <- p.m.01
#add model shift
pred <- pred + shift
return(pred)
}

Following the same procedure as earlier, we must define scaled non-conformity bound on the
calibration sample.
#apply mad model on the calibration dataset
calib$ad <- [Link](m0 = [Link].0,
m1 = [Link].1,

161
 s0 = [Link].0,
s1 = [Link].1,
shift = [Link],
x = calib$pred)
#calculate scaled non-conformity scores
calib$[Link] <- calib$ncs / calib$ad
#find scaled non-conformity bound for the 95% level
[Link] <- unname(quantile(x = calib$[Link], probs = 0.95))
[Link]

## [1] 0.7951014

Ultimately, we need to verify the coverage of our new conformal predictor. To accomplish this, we
will follow the same steps as in the previous example but now to derive the new predictor’s coverage
distribution.
#bind calibration and evaluation sample together
cols <- c("Creditability", "pred")
[Link] <- bind_rows(calib[, cols], evalu[, cols])
#define number of simulations
N <- 1000
#simulate coverage distribution
[Link] <- rep(NA, N)
[Link] <- nrow(calib)
[Link] <- nrow([Link])
for (i in 1:N) {
[Link](i)
#re-sample index
idx <- sample(x = 1:[Link],
size = [Link],
replace = FALSE)
#simulated re-sampled calib and evalu datasets
[Link] <- [Link][idx, ]
[Link] <- [Link][-idx, ]
#calculate non-conformity bound on the [Link] dataset
[Link] <- [Link][order([Link]$Creditability, [Link]$pred), ]
[Link]$[Link] <- sort([Link]$pred)
[Link]$ncs <- abs([Link]$[Link] - [Link]$pred)
[Link]$ad <- [Link](m0 = [Link].0,
m1 = [Link].1,
s0 = [Link].0,

162
 s1 = [Link].1,
shift = [Link],
x = [Link]$pred)
[Link]$[Link] <- [Link]$ncs / [Link]$ad
[Link] <- unname(quantile(x = [Link]$[Link], probs = 0.95))
#calculate coverage on the [Link] sample
[Link] <- [Link][order([Link]$Creditability, [Link]$pred), ]
[Link]$[Link] <- sort([Link]$pred)
[Link]$ad <- [Link](m0 = [Link].0,
m1 = [Link].1,
s0 = [Link].0,
s1 = [Link].1,
shift = [Link],
x = [Link]$pred)
[Link]$[Link] <- [Link]$pred - [Link]$ad * [Link]
[Link]$[Link] <- [Link]$pred + [Link]$ad * [Link]
[Link]$[Link] <- [Link]$[Link] < [Link]$[Link] |
[Link]$[Link] > [Link]$[Link]
[Link][i] <- 1 - sum([Link]$[Link]) / nrow([Link])
}
#coverage 95% range
quantile(x = [Link], probs = c(0.025, 0.975))

## 2.5% 97.5%
## 0.89 0.99
#coverage distribution
hist(x = [Link],
ylim = c(0, 400),
xlab = "Simulated coverage",
ylab = "Frequency",
main = "Simulated coverage distribution")

163
 Simulated coverage distribution
400
300
Frequency

200
100
0

0.80 0.85 0.90 0.95 1.00

Simulated coverage

As we can see, in terms of marginal coverage, our conformal predictor performs as expected, and we
continue creating the conformal prediction intervals on the application sample.
#mad model for the application sample
[Link]$ad <- [Link](m0 = [Link].0,
m1 = [Link].1,
s0 = [Link].0,
s1 = [Link].1,
shift = [Link],
x = [Link]$pred)
#lower bound of the prediction interval (probability scores)
[Link]$lwr.s <- exp([Link]$pred - [Link]$ad * [Link]) /
(1 + exp([Link]$pred - [Link]$ad * [Link]))
#upper bound of the prediction interval (probability scores)
[Link]$upr.s <- exp([Link]$pred + [Link]$ad * [Link]) /
(1 + exp([Link]$pred + [Link]$ad * [Link]))
#application portfolio summary
app.s <- [Link](obs = 1:nrow([Link]),
[Link][, c("lwr", "upr", "[Link]")],
[Link][, c("ad", "lwr.s", "upr.s")])

164
app.s

## obs lwr upr [Link] ad lwr.s upr.s

## 1 1 0.117837485 0.68471578 0.35006119 1.1360062 0.17916567 0.57064173
## 2 2 0.108287407 0.66379319 0.32870336 1.2037514 0.15826960 0.56046490
## 3 3 0.112979861 0.67435329 0.33931271 1.1695231 0.16850666 0.56550408
## 4 4 0.602395435 0.96098660 0.85933235 0.6326366 0.78696804 0.90992881
## 5 5 0.045288499 0.43542347 0.16056146 1.9410005 0.03926562 0.47233721
## 6 6 0.005571585 0.08348669 0.02209224 0.5000010 0.01495355 0.03252636
## 7 7 0.163441692 0.76056130 0.44064610 1.0265915 0.25830738 0.64053892
## 8 8 0.042470736 0.41898491 0.15171133 1.9975453 0.03524697 0.46680133
## 9 9 0.023323091 0.27966724 0.08783087 0.5301324 0.05941689 0.12798390
## 10 10 0.082294303 0.59315520 0.26555848 1.4316868 0.10380802 0.53022831

To conclude, we adjusted the prediction intervals based on the model’s confidence when considering
the variance model. In simpler terms, observations with higher model certainty, such as observations
4, 6, and 9, have considerably tighter intervals than the remaining observations, where the model
exhibits more significant uncertainty.
Let’s visualize the prediction interval of the new conformal predictor on the training dataset.
#model-based variance estimaion on the training dataset
train$[Link] <- [Link](m0 = [Link].0,
m1 = [Link].1,
s0 = [Link].0,
s1 = [Link].1,
shift = [Link],
x = train$pred)
#lower bound of the conformal prediction interval
train$lwr.m <- train$pred - train$[Link] * [Link]
#uper bound of the conformal prediction interval
train$upr.m <- train$pred + train$[Link] * [Link]
#probability scores
train$[Link].m <- exp(train$lwr.m) / (1 + exp(train$lwr.m))
train$[Link].m <- exp(train$upr.m) / (1 + exp(train$upr.m))
#plot prediction intervals
train <- train[order(train$pred), ]
plot(x = train$pred,
y = train$[Link],
ylim = c(0, 1),
main = "Conformal prediction intervals\nof the point estimates",
xlab = "Log odd scores",

165
 ylab = "Model probability scores",
type = "n")
polygon(x = c(train$pred, rev(train$pred)),
y = c(train$[Link].m, rev(train$[Link].m)),
border = FALSE,
col = "gray")
lines(x = train$pred,
y = train$[Link])

Conformal prediction intervals

of the point estimates
1.0
Model probability scores

0.8
0.6
0.4
0.2
0.0

−4 −2 0 2

Log odd scores

The same conclusion regarding the width of the prediction interval holds for the training dataset
and suggests lower model performance with high uncertainty in certain regions. As mentioned
earlier, the U-shaped trend observed in the mid-region of the prediction scores directly arises from
the definition of the scaled non-conformity measure. Readers who may feel uncomfortable utilizing
or presenting such a trend can halt the analysis before constructing the variance model keeping a
constant width of the non-conformity bound.

For the end of the section, let’s demonstrate how the model performance directly affects
the unscaled non-conformity bound. We will utilize the training dataset and adjust the perfect score
to simulate a significantly improved model, reaching an approximate AUC of 90% - far superior to
the previously presented one (AUC 78.56%). Let’s begin with data preparation.

166
#simulation dataset
[Link] <- train[, c("Creditability", "[Link]")]
#simulate scores with cca. 90% auc
[Link]$[Link] <- [Link]$[Link]
[Link](1)
[Link] <- sample(x = 1:nrow([Link]),
size = 0.2 * nrow([Link]))
[Link]$[Link][[Link]] <- sample(x = [Link]$[Link][[Link]])
#check auc
[Link](predictions = [Link]$[Link],
observed = train$Creditability)

## [1] 0.9027747
#reconstruct the perfect model
[Link] <- [Link][order([Link]$Creditability,
[Link]$[Link]), ]
[Link]$[Link] <- sort([Link]$[Link])
#confirm auc for the perfect model
[Link](predictions = [Link]$[Link],
observed = [Link]$Creditability)

## [1] 0.9999962
#non-conformity scores
[Link]$ncs <- abs([Link]$[Link] - [Link]$[Link])
#95th non-conformity bound
[Link] <- unname(quantile(x = [Link]$ncs, probs = 0.95))
[Link]

## [1] 0.6460693
#create prediction bounds
[Link]$lwr <- exp([Link]$[Link] - [Link]) /
(1 + exp([Link]$[Link] - [Link]))
[Link]$prob <- exp([Link]$[Link]) /
(1 + exp([Link]$[Link]))
[Link]$upr <- exp([Link]$[Link] + [Link]) /
(1 + exp([Link]$[Link] + [Link]))
#plot prediction intervals
[Link] <- [Link][order([Link]$[Link]), ]
plot(x = [Link]$[Link],

167
 y = [Link]$prob,
ylim = c(0, 1),
main = "Simulated conformal prediction intervals",
xlab = "Log odd scores",
ylab = "Model probability scores",
type = "n")
polygon(x = c([Link]$[Link], rev([Link]$[Link])),
y = c([Link]$lwr, rev([Link]$upr)),
border = FALSE,
col = "gray")
lines(x = [Link]$[Link],
y = [Link]$prob)

Simulated conformal prediction intervals

1.0
Model probability scores

0.8
0.6
0.4
0.2
0.0

−4 −2 0 2

Log odd scores

When comparing this graph with the same one generated using our simulated model in use, which
possesses significantly lower discriminatory power, we can readily observe a noticeable disparity in
the width of the prediction intervals.

While the presented examples may not fully represent a real-world scenario due to the
limited number of observations in the modeling datasets and the relatively lower model performance,

168
it still provides valuable insights. They demonstrate how model performance directly influences
the prediction interval and how we can identify the regions with a poor model performance. In
conclusion, we encourage readers to explore and experiment with alternative non-conformity
measures suitable for their models and consider different variance models and significance levels in
their analyses. Similarly, as the bootstrap method, this approach can be effortlessly extended to a
model incorporating calibrated rating grades.

169
6 Margin of conservatism
After completing the model development phase, we usually address overall model uncertainties by
defining the so-called Margin of Conservatism (MoC). The European Banking Authority (EBA)
defines three categories for distinct sources of uncertainty in the estimated parameters:

1. category A: covers the uncertainty related to the data and methodology deficiencies;
2. category B: covers the uncertainty related to changes in risk appetite and internal processes;
3. category C: covers the statistical uncertainty from the estimated parameter.

The overall MoC is represented as a sum of MoCs for each category and should be added to the
best estimate of the risk parameter. Each of the above categories covers different aspects of model
uncertainties and deficiencies and can be further split into specific sub-categories. Generally, the
MoC pertains to all risk parameters Probability of Default (PD), Loss Given Default (LGD), and
Exposure At Default (EAD). However, in this section, we will focus solely on the PD models and
address the following sources of uncertainties:

1. special cases (such as missing values or outdated information) in ranking model development;
2. change of the portfolio structure;
3. general estimation error of the calibration (central tendency variability).

The first uncertainty is classified under MoC category A, the second under MoC category B, and
the third under MoC category C. As no specific prescribed quantification methodology exists for
these MoC categories, we will present a general framework that can be further adapted to specific
requirements.
Now, let’s proceed by preparing the data and simulating the model for which we will quantify the
uncertainty arising from the special cases.
data(loans)
#randomly shuffle the observations
[Link](21)
loans <- loans[sample(x = 1:nrow(loans)), ]
#artificially add some missing values
loans$"Account Balance"[1:150] <- "SC"
loans$"Duration of Credit (month)"[101:200] <- NA
loans$"Age (years)"[121:150] <- NA
#discretize the numeric risk factors
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
loans[, [Link]] <- sapply(X = [Link],
FUN = function(x) {
[Link](x = loans[, x],

170
 y = loans$Creditability)[[2]]})
#replace WoE
[Link] <- [Link](db = loans, target = "Creditability")[[1]]
#run stepFWDr regression
res <- stepFWDr([Link] = Creditability ~ 1,
[Link] = 0.05,
db = [Link])
#rename the loans column to match the development db columns
names(loans) <- names(res$[Link])
#get WoE table
[Link] <- bivariate(db = loans[, c("Creditability", res$steps$rf)],
target = "Creditability")[[1]]
#create the rating scale
loans$pred <- unname(predict(object = res$model))
loans$rating <- [Link](x = loans$pred, y = loans$Creditability)[[2]]
rs <- loans %>%
group_by(rating) %>%
summarise(no = n(),
nd = sum(Creditability),
dr = mean(Creditability),
[Link] = min(pred),
[Link] = max(pred)) %>%
[Link]()
#calibrate the rating scale
ct <- 0.33
[Link] <- [Link](rs = rs,
dr = "dr",
w = "no",
ct = ct,
[Link] = 0,
method = "[Link]")
params <- [Link][["params"]]
rs$[Link] <- [Link][["[Link]"]]
#calculate the portfolio calibrated pd
sum(rs$[Link] * rs$no / sum(rs$no))

## [1] 0.33
#assign the calibrated PD to the loans dataset
pd <- rs$[Link]

171
names(pd) <- rs$rating
loans$[Link] <- unname(pd[loans$rating])

After preparing the model, we take the following steps to evaluate the uncertainty arising from
special cases:

1. identify risk factors with the special cases;

2. for each combination of the special cases, create the new variable that takes the value 1 if the
special case exists; otherwise, 0;
3. run the decision tree on the variables created in step 2 (incuding interactions) against the risk
factors from the model that do not constitute the target variable;
4. randomly select one of the special case combinations with probability proportional to the size
of the special case combinations;
5. given the number of observations affected by the selected combination of special cases (step
4), randomly select the observations for permutations with probability proportional to the
probabilities obtained from decision tree predictions;
6. calculate the predictions based on the model in use and assign the calibrated PD for the
permuted dataset;
7. calculate the mean absolute deviation between the simulated PDs and those from the original
model;
8. repeat the steps from 4 to 7 N times and calculate the (simple or weighted) average of the
simulated mean absolute deviations.

The value obtained from the final step represents the uncertainty arising from special cases, assuming
a constant share of special cases over time and their distribution based on the probabilities derived
from the decision tree predictions in step 3.
Before delving into the specific R implementation, let’s clarify the fundamental assumptions under-
lying this approach.
When developing the ranking model, one of our primary objectives is to ensure the stability of
the risk factors. This entails maintaining consistency in the occurrence of specific cases related
to the analyzed risk factor between the training dataset and the production environment. In the
approach described above, achieving this consistency is accomplished by sampling combinations of
these special cases in proportion to their real representation in the training dataset (step 4).
The second crucial assumption pertains to the permutation of values for the risk factors contributing
to the special case indicator. During this permutation process, we select row indices based on the
probabilities derived from the decision tree model (step 3). This selection mechanism safeguards
against improbable permutations of the risk factors. For a clearer grasp of this concept, readers
are directed to the code line sapply(X = [Link], FUN = table) subsequent to estimating the
decision tree models. Alternatively, practitioners can opt for any suitable machine learning algorithm
designed for binary classification tasks rather than solely relying on the decision tree.

172
The third assumption revolves around the flexibility for special cases to assume values proportional
to the probabilities the decision tree model predicted. This implies that practitioners must exercise
caution when determining which special cases qualify for inclusion in this simulation. Notably, not
all special cases may meet this stipulated requirement.
Now, let’s run the above procedure in R.
#import rpart library
library(rpart)
#identify the risk factors with special cases ("SC")
[Link].c <- colSums(loans[, res$steps$rf] == "SC")
[Link] <- names([Link].c)[[Link].c > 0]
[Link]

## [1] "Account_Balance" "Duration_of_Credit__month"

## [3] "Age__years"
#special cases dummy variables creation and summary function
[Link] <- function(rf, sc, db) {
mapping <- [Link](rf = c(),
ind = c())
rf.l <- length(rf)
#single risk factor sc dummy
for (i in 1:rf.l) {
rf.i <- [Link][i]
db <- [Link](db,
ind = ifelse(db[, rf.i]%in%sc, 1, 0))
col.n <- paste0("ind_", i)
names(db)[ncol(db)] <- col.n
mapping.i <- [Link](rf = rf.i, ind = col.n)
mapping <- rbind(mapping, mapping.i)
}
#store original sc indicators
[Link] <- paste0("ind_", 1:rf.l)
[Link] <- db[, [Link]]
#check for the combinations of sc between the risk factors
sc.c <- db %>%
group_by_at([Link]) %>%
summarise(no = n()) %>%
[Link]()
[Link] <- apply(X = sc.c[, -ncol(sc.c)],
MARGIN = 1,

173
 FUN = function(x) sum(x) > 1)
#extract combination of sc
idx.e <- apply(X = sc.c[, -ncol(sc.c)],
MARGIN = 1,
FUN = function(x) !all(x == 0))
sc.c <- sc.c[idx.e, ]
#if there is overlap then create all new sc indicators
if (sum([Link]) > 0) {
#prepare sc summary data frame
sc.c.i <- sc.c[, -ncol(sc.c)]
#delete previously added sc indicators
db <- db[, !names(db)%in%[Link]]
#reset mapping table
mapping <- [Link](rf = c(),
ind = c())
#create new sc indicators
for (i in 1:nrow(sc.c.i)) {
#indicator combination
ind.c <- sc.c.i[i, ]
#name of the indicator combination
ind.n <- names(sc.c.i)[which(ind.c == 1)]
#indicator value
ind.v <- apply(X = [Link][, , drop = FALSE],
MARGIN = 1,
FUN = function(x) {
ifelse(all(x[ind.n] == 1) &
all(x[!names(x)%in%ind.n] == 0),
1,
0)
})
ind.v <- unname(ind.v)
#add indicator to db
db <- [Link](db, ind.v)
#rename the last added column of db
[Link] <- [Link](gsub(pattern = "[ˆ0-9]",
replacement = "",
x = ind.n))
col.n <- paste0("ind_",
paste([Link], collapse = ""))

174
 names(db)[ncol(db)] <- col.n
#add indicator mapping
mapping.i <- [Link](rf = rf[[Link]],
ind = col.n)
mapping <- rbind(mapping, mapping.i)
}
}
#sc summary table
ds <- sc.c %>%
mutate(pct = no / sum(no))
rownames(ds) <- NULL
return(list(db = db,
mapping = mapping,
[Link] = ds))
}
dcs <- [Link](rf = [Link], sc = "SC", db = loans)
names(dcs)

## [1] "db" "mapping" "[Link]"

[Link] <- dcs$db
head([Link])[, grepl("ind_", names([Link]))]

## ind_2 ind_1 ind_12 ind_123

## 319 0 1 0 0
## 161 0 1 0 0
## 771 0 1 0 0
## 825 0 1 0 0
## 426 0 1 0 0
## 815 0 1 0 0
dcs$mapping

## rf ind
## 1 Duration_of_Credit__month ind_2
## 2 Account_Balance ind_1
## 3 Account_Balance ind_12
## 4 Duration_of_Credit__month ind_12
## 5 Account_Balance ind_123
## 6 Duration_of_Credit__month ind_123
## 7 Age__years ind_123

175
dcs$[Link]

## ind_1 ind_2 ind_3 no pct

## 1 0 1 0 50 0.25
## 2 1 0 0 100 0.50
## 3 1 1 0 20 0.10
## 4 1 1 1 30 0.15
#run the decision tree model on sc indicators
ind.u <- unique(dcs$mapping$ind)
ind.l <- length(ind.u)
[Link] <- vector("list", ind.l)
for (i in 1:ind.l) {
ind.i <- ind.u[i]
[Link] <- dcs$mapping$rf[dcs$mapping$ind%in%ind.i]
[Link] <- res$steps$rf[!res$steps$rf%in%[Link]]
frm <- paste(ind.i, " ~ ", paste0([Link], collapse = " + "))
dt.i <- rpart(formula = frm,
data = [Link],
control = [Link](minsplit = 5,
minbucket = 5,
cp = 0),
method = "class")
[Link] <- [Link](unname(predict(object = dt.i,
type = "prob")[, "1"]))
names([Link]) <- ind.i
[Link][[i]] <- [Link]
}
[Link] <- bind_cols([Link])
#decision tree probabilities per indicator combination
sapply(X = [Link], FUN = table)

## $ind_2
##
## 0 0.0227272727272727 0.0271604938271605 0.0283687943262411
## 167 44 405 141
## 0.0344827586206897 0.05 0.0576923076923077 0.0666666666666667
## 58 20 52 30
## 0.117647058823529 0.157894736842105 0.2 0.285714285714286
## 17 19 5 7

176
## 0.3 0.571428571428571 0.6 0.666666666666667
## 10 14 5 6
##
## $ind_1
##
## 0 0.0185185185185185 0.0480769230769231 0.0555555555555556
## 143 162 104 18
## 0.0740740740740741 0.0813953488372093 0.0816326530612245 0.0909090909090909
## 27 172 98 11
## 0.0919540229885058 0.111111111111111 0.142857142857143 0.157894736842105
## 87 9 7 19
## 0.166666666666667 0.181818181818182 0.2 0.272727272727273
## 42 22 5 11
## 0.285714285714286 0.375 0.4 0.6
## 7 8 5 5
## 0.666666666666667 0.8
## 18 20
##
## $ind_12
##
## 0.02
## 1000
##
## $ind_123
##
## 0 0.00719424460431655 0.0182421227197347 0.0202020202020202
## 48 139 603 99
## 0.0285714285714286 0.0714285714285714 0.285714285714286 0.4
## 70 14 7 5
## 0.571428571428571 0.625
## 7 8
#quantify the special case uncertainty (steps from 4 to 8)
N <- 1000
sim <- rep(NA, N)
[Link] <- rep(NA, N)
pd <- rs$[Link]
names(pd) <- rs$rating
nr <- nrow([Link])
[Link] <- nrow(dcs$[Link])

177
[Link] <- c(ncol(dcs$[Link]) - 1, ncol(dcs$[Link]))
for (i in 1:N) {
[Link](i)
#randomly select one special case combination with the probability
#proportional to the number of occurrences of the special cases
idx.i <- sample(x = 1:nrow(dcs$[Link]),
size = 1,
prob = dcs$[Link]$pct)
[Link][i] <- idx.i
ind.i <- dcs$[Link][idx.i, ]
[Link] <- names(ind.i)[which(ind.i[, -[Link]] == 1)]
[Link] <- paste(gsub(pattern = "[ˆ0-9]",
replacement = "",
x = [Link]),
collapse = "")
[Link] <- paste0("ind_", [Link])
#identify the risk factors from the randomly selected
#special case combination
rf.i <- dcs$mapping$rf[dcs$mapping$ind%in%[Link]]
[Link] <- ind.i$no
#randomly select [Link] observations with the probability
#proportional to the predictions from the decision tree model
[Link] <- sample(x = 1:nr,
size = [Link],
prob = [Link][, [Link]])
#permute
prm <- sample(x = [Link])
#model development sample with the WoE coding (from the model in use)
[Link] <- res$[Link]
#permute the values of the risk factor(s) from the special case indicators
[Link][[Link], rf.i] <- [Link][prm, rf.i]
#model prediction scores
[Link]$pred <- predict(object = res$model,
type = "response",
newdata = [Link])
#calibration
[Link]$w <- 1
[Link]$[Link] <- [Link](rs = [Link],
dr = "pred",

178
 w = "w",
ct = mean(res$[Link]$Creditability),
[Link] = 0,
method = "[Link]")[[1]]
[Link]$[Link] <- log([Link]$[Link] / (1 - [Link]$[Link]))
#assign the PD based on the rating scale
[Link] <- [Link](x = [Link]$[Link],
mapping = rs[, c("[Link]", "[Link]")])
[Link] <- unname(pd[[Link]])
sim[i] <- mean(abs(loans$[Link] - [Link]))
}
#summary of the simulated PD change
summary(sim)

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## 0.001229 0.003414 0.006331 0.007341 0.011239 0.015436
#distribution of the simulated PD change
hist(x = sim,
col = "red",
main = "Distribution of simulated mean absolute deviations",
xlab = "Mean absolute deviation")

179
 Distribution of simulated mean absolute deviations
150
Frequency

100
50
0

0.005 0.010 0.015

Mean absolute deviation

#weighted average MoC

sum(tapply(X = sim, INDEX = [Link], FUN = mean) * dcs$[Link]$pct)

## [1] 0.00743554

We can analyze the above results to determine which risk factors combination impact the overall
MoC most.
#average absolute deviation per indicator combination
tapply(X = sim, INDEX = [Link], FUN = mean)

## 1 2 3 4
## 0.003192925 0.011272808 0.003014398 0.004663097
#find indicator combination for maximum absolute deviation
dcs$[Link][2, ]

## ind_1 ind_2 ind_3 no pct

## 2 1 0 0 100 0.5
#print mapping of ind_1
dcs$mapping[dcs$mapping$ind%in%"ind_1", ]

180
## rf ind
## 2 Account_Balance ind_1

The example provided above demonstrates just one potential model design. In practice, we
often tailor and align the modeling approach based on specific requirements and constraints.
This becomes particularly critical in the case of a modular approach, where the design can
be more intricate, making it essential to carefully plan the process of quantifying uncer-
tainty arising from special cases. Additionally, if a specific approach for handling special cases is
adopted during the development phase, it should be accounted for in the design of the MoC quantifier.

Another potential source of uncertainty is the variability in portfolio structure. It often

occurs that the composition of the sample used to develop the ranking model or calculate the
central tendency differs from the recent or future expectations of the portfolio structure. Typically,
we address this uncertainty either in the ranking model development or the calibration phase, but
not in both, to avoid double-counting effects. When we handle this uncertainty in the calibration
phase, we simulate the adjusted default rate for the years when the change in portfolio structure is
anticipated. Subsequently, we re-calculate the central tendency using the adjusted rates. Finally,
the updated central tendency is used to calibrate the rating scale, impacting all rating grades in the
case of a discrete rating scale. Alternatively, if we have the possibility to address this uncertainty in
the ranking model development phase, we can employ re-sampling methods to handle it at the
rating grade level. In this scenario, the first step involves identifying the segment representing the
population affected by the portfolio change. Then, we proceed to re-sample the observations of that
segment and calculate the PD change by comparing the PD from the model in use against the
simulated PD.
In summary, the MoC, specifically designed to handle uncertainty arising from portfolio changes,
can be integrated into the central tendency as a modification of the portfolio PD. Additionally, in
certain scenarios, we can address this MoC at the individual rating grade levels. This targeted
approach proves especially beneficial when we need to anticipate and account for the impact of
portfolio changes on specific creditworthiness segments.
Let’s consider a scenario where we anticipate a 100% increase in loans with a maturity of 45 months
or longer. This expected increase is determined using the average number of clients with such loans
over the period used for ranking model development. Upon examining the simulated model, we
observe that the risk factor Duration_of_Credit__month is already incorporated into the model,
with modality 04 [45,Inf) being the relevant category to identify the target population for further
re-sampling.
#Duration_of_Credit__month
summary(res$model)$coefficients

## Estimate Std. Error z value

## (Intercept) -0.8559946 0.08445479 -10.135537

181
## Account_Balance -0.8084061 0.10609602 -7.619571
## Duration_of_Credit__month -0.6684951 0.17099313 -3.909485
## Payment_Status_of_Previous_Credit -0.7526522 0.15656811 -4.807187
## Purpose -1.0028118 0.20872634 -4.804433
## Value_Savings_Stocks -0.8284939 0.20208252 -4.099780
## Length_of_current_employment -0.6947687 0.28989520 -2.396620
## Instalment_per_cent -2.1257074 0.54581072 -3.894587
## Credit_Amount -0.8449450 0.27465312 -3.076408
## Age__years -0.7234351 0.24025854 -3.011069
## Guarantors -1.0575465 0.44449512 -2.379208
## Duration_in_Current_address -3.5478613 1.39134008 -2.549960
## Sex___Marital_Status -0.9860117 0.40153262 -2.455621
## Most_valuable_available_asset -0.5754116 0.26272494 -2.190167
## Pr(>|z|)
## (Intercept) 0.00000000000000000000000384257
## Account_Balance 0.00000000000002545208065437252
## Duration_of_Credit__month 0.00009249304199219028015110933
## Payment_Status_of_Previous_Credit 0.00000153068533036701593906537
## Purpose 0.00000155190284166206673532699
## Value_Savings_Stocks 0.00004135426546123075353805776
## Length_of_current_employment 0.01654706964022627582733271367
## Instalment_per_cent 0.00009836615707825215212251058
## Credit_Amount 0.00209511196681977157271759005
## Age__years 0.00260329587080414606714562353
## Guarantors 0.01734986797967079386051381107
## Duration_in_Current_address 0.01077353371851641310186220579
## Sex___Marital_Status 0.01406415873594838578108934257
## Most_valuable_available_asset 0.02851210824828657661167419235
#Duration_of_Credit__month WoE table
[Link][[Link]$rf%in%"Duration_of_Credit__month", ]

## rf bin no ng nb pct.o pct.g

## 6 Duration_of_Credit__month 01 (-Inf,8) 80 71 9 0.080 0.10142857
## 7 Duration_of_Credit__month 02 [8,16) 307 231 76 0.307 0.33000000
## 8 Duration_of_Credit__month 03 [16,45) 451 291 160 0.451 0.41571429
## 9 Duration_of_Credit__month 04 [45,Inf) 62 24 38 0.062 0.03428571
## 10 Duration_of_Credit__month SC 100 83 17 0.100 0.11857143
## pct.b dr so sg sb dist.g dist.b woe
## 6 0.03000000 0.1125000 1000 700 300 0.10142857 0.03000000 1.2181574

182
## 7 0.25333333 0.2475570 1000 700 300 0.33000000 0.25333333 0.2643865
## 8 0.53333333 0.3547672 1000 700 300 0.41571429 0.53333333 -0.2491484
## 9 0.12666667 0.6129032 1000 700 300 0.03428571 0.12666667 -1.3068302
## 10 0.05666667 0.1700000 1000 700 300 0.11857143 0.05666667 0.7383294
## iv.b iv.s auc
## 6 0.08701125 0.3030178 0.6368476
## 7 0.02026963 0.3030178 0.6368476
## 8 0.02930460 0.3030178 0.6368476
## 9 0.12072622 0.3030178 0.6368476
## 10 0.04570611 0.3030178 0.6368476

To simulate the anticipated portfolio change, we will conduct a re-sampling of 62 observations from
the identified segment, effectively mimicking the expected 100% increase in loans with a maturity of
45 months or longer.
[Link](984)
#we use prepared [Link] data frame from the previous example
#[Link] already contains rating grades and calibrated PD values
idx <- which([Link]$"Duration_of_Credit__month"%in%"04 [45,Inf)")
[Link] <- sample(x = idx,
size = 62,
replace = TRUE)
[Link]

## [1] 451 733 572 701 974 610 864 572 974 300 300 964 427 597 421 421 678 300 296
## [20] 650 803 246 79 820 530 690 898 828 572 932 597 354 217 653 680 572 451 896
## [39] 701 803 574 621 326 370 246 691 574 506 932 820 506 986 94 543 548 79 459
## [58] 986 986 458 543 932

After conducting the re-sampling to simulate the portfolio change, we will modify our development
dataset accordingly and then re-calculate the PDs based on the adjusted data. This will allow us to
evaluate the impact of the anticipated change on the PDs for the affected segment.
#simulation dataset
[Link] <- rbind([Link]([Link], [Link] = FALSE),
[Link]([Link][[Link], ], [Link] = TRUE))
#compare simulated and observed DR on portfolio level
c([Link] = mean([Link]$[Link]),
[Link] = mean([Link]$[Link][![Link]$boot]),
[Link] = mean([Link]$[Link]) - mean([Link]$[Link][![Link]$boot]))

## [Link] [Link] [Link]

## 0.34919443 0.32999996 0.01919446

183
Based on the simulation results, we observe that the default rate on the portfolio level has increased
by approximately 1.99 percentage points. Now, let’s examine the rating distribution for the simulated
observations to understand how the portfolio change affects the rating grades.
table([Link]$rating[[Link]$[Link]])

##
## 03 [-2.0281,-0.6332) 04 [-0.6332,0.2382) 05 [0.2382,0.9585)
## 11 6 7
## 06 [0.9585,Inf)
## 38

From the rating distribution for the simulated observations, we can observe that no instances
fall into the ratings 01 (-Inf,-2.7193) and 02 [-2.7193,-2.0591). Consequently, applying the
add-on to the central tendency for all ratings would lead to an unjustified overestimation of the
re-calibrated PDs. Given this scenario, it would be more appropriate to derive the MoC on each
rating grade’s level, considering the portfolio change’s specific impact on individual creditworthiness
segments. This approach ensures that the MoC is accurately tailored to reflect the uncertainties
and changes within each rating grade, providing more precise adjustments for the different segments
of the portfolio.
#auxilary function for scaling
scaling <- function(no.o, no.n, [Link]) {
#new PD
pd.p.n <- sum(no.n / sum(no.n) * [Link])
#ratings with no change
n.a <- no.n - no.o
zc <- sum(no.o[n.a == 0] / sum(no.o) * [Link][n.a == 0])
#remaining PD value
dr.r <- sum(no.o[n.a > 0] / sum(no.o) * [Link][n.a > 0])
#scaling factor
[Link] <- (pd.p.n - zc) / dr.r
return([Link])
}
#rating grade MoC
rg.c <- [Link] %>%
group_by(rating) %>%
summarise(no = n(),
[Link] = sum(![Link]),
[Link] = sum([Link]),
[Link] = mean([Link])) %>%

184
 ungroup() %>%
mutate([Link] = ifelse([Link] == 0,
1,
scaling(no.o = [Link],
no.n = no,
[Link] = [Link])),
[Link] = [Link] * [Link],
moc = [Link] - [Link]) %>%
[Link]()
rg.c

## rating no [Link] [Link] [Link] [Link] [Link]

## 1 01 (-Inf,-2.6707) 187 187 0 0.02565806 1.000000 0.02565806
## 2 02 [-2.6707,-2.0281) 125 125 0 0.12855914 1.000000 0.12855914
## 3 03 [-2.0281,-0.6332) 341 330 11 0.25124510 1.062091 0.26684528
## 4 04 [-0.6332,0.2382) 166 160 6 0.50254561 1.062091 0.53374941
## 5 05 [0.2382,0.9585) 120 113 7 0.69217465 1.062091 0.73515279
## 6 06 [0.9585,Inf) 123 85 38 0.79527172 1.062091 0.84465132
## moc
## 1 0.00000000
## 2 0.00000000
## 3 0.01560018
## 4 0.03120380
## 5 0.04297815
## 6 0.04937960
#check - portfolio DR
sum(rg.c$[Link] * rg.c$[Link] / sum(rg.c$[Link]))

## [1] 0.33
#check - PD with MoC
sum(rg.c$[Link] * rg.c$[Link] / sum(rg.c$[Link]))

## [1] 0.3491944

As shown in the example, the new portfolio PD, calculated as the weighted average of rating grades’
PDs, aligns with the simulated portfolio PD but was achieved through targeted adjustments of the
PDs on specific rating grades. To address the potential bias resulting from a single simulation, it
is advisable to repeat the process with multiple simulations. By doing so, we can calculate the
average values of the MoC at the grade level, providing a more robust estimate of the uncertainty.
An alternative adjustment to the example above can also be made during the scaling step. Instead

185
of using linear scaling, we could explore optimization methods based on logit transformation, as
demonstrated for the calibration purpose - optimization of the intercept or intercept and slope.
Furthermore, to comprehensively assess the model’s performance, we can simulate a full-case
scenario and conduct the same analysis after calibrating the model. These modifications are left for
readers to explore and experiment with, tailoring the approach to their specific needs and preferences.

The calculation of the central tendency presents another source of uncertainty. Simply
the fact that central tendency is the mean of the sample of default rates over a certain period
indicates variability associated with its calculation. Different approaches are available in practice to
address this variability and account for over-optimism in the calculation of central tendency.
The following examples will cover central tendency add-ons based on empirical quantile, Clopper-
Pearson’s upper confidence bound, and Jeffreys’ upper confidence bound. The last two methods are
associated with calculating confidence intervals for the binomial proportion.
Before we demonstrate the implementation of these methods in R, let’s simulate the calibration
dataset based on the following assumptions: calibration covers a period of 120 months, and the
number of observations at each monthly snapshot varies between 500 and 800 with an average
default rate simulated from the normal distribution with a mean of 5% and a standard deviation of
0.5%.
[Link](2022)
#default rate simulation
dr <- rnorm(n = 120, mean = 0.05, sd = 0.005)
#number of observations per snapshot
no <- sample(x = 500:800,
size = 120,
replace = TRUE)
#number of defaults per snapshot
nd <- round(no * dr)
#snapshot dates
date <- seq(from = [Link]("2013-01-01"),
by = "1 month",
[Link] = 120)
[Link] <- [Link](date, no, nd, dr)
#head of the simulated dataset
head([Link])

## date no nd dr
## 1 2013-01-01 781 43 0.05450071
## 2 2013-02-01 622 27 0.04413327
## 3 2013-03-01 582 26 0.04551257

186
## 4 2013-04-01 792 34 0.04277749
## 5 2013-05-01 630 30 0.04834493
## 6 2013-06-01 566 20 0.03549686
#central tendency of the simulated default rates
ct <- mean([Link]$dr)
ct

## [1] 0.05049698

Each method that accounts for the uncertainty of central tendency requires defining the confidence
level. For illustration purposes, we will select an 80% confidence level. Although this is probably
the most common choice of confidence level, we encourage readers to experiment and test other
levels as well, depending on the observed distribution and variability of the default rates over the
calibration period.
cl <- 0.8

Let’s begin by calculating the empirical quantile for the chosen confidence interval.
#quantile calculation
eq <- quantile(x = [Link]$dr,
prob = cl)
#moc - difference between empirical quantile and central tendency
[Link] <- unname(eq - ct)
[Link]

## [1] 0.004546016
#adjusted central tendency
[Link] <- ct + [Link]
[Link]

## [1] 0.055043

The next two examples demonstrate the implementation of Clopper-Pearson and Jeffreys upper
confidence bounds.
#Clopper-Pearson upper confidence bound
cp <- qbeta(p = cl,
shape1 = [Link]$nd + 1,
shape2 = [Link]$no - [Link]$nd)
#moc - difference between simulate average default rate and central tendency
[Link] <- mean(cp) - ct
[Link]

187
## [1] 0.008642755
#adjusted central tendency
[Link] <- ct + [Link]
[Link]

## [1] 0.05913974
#Jeffreys upper confidence bound
jf <- qbeta(p = cl,
shape1 = [Link]$nd + 0.5,
shape2 = [Link]$no - [Link]$nd + 0.5)
#moc - difference between simulate average default rate and central tendency
[Link] <- mean(jf) - ct
[Link]

## [1] 0.007806867
#adjusted central tendency
[Link] <- ct + [Link]
[Link]

## [1] 0.05830385

As we can see, both Clopper-Pearson and Jeffreys’ upper confidence bounds rely on quantiles of the
beta distribution, with slight differences in the definition of shape parameters (alpha and beta).
Pluto and Tasche (2011) provided a straightforward extension of the Clopper-Pearson upper
confidence bounds for the rating grade level. However, we won’t delve into the calculations in this
section as they tend to produce overly conservative estimates for portfolios with high default rates
and a heterogeneous rating scale. For more in-depth information, readers can refer to the cited
paper.

188
7 Periodic model validation
Validation is a critical part of the PD model lifecycle. By the term model validation, we typically
refer to a robust system consisting of clearly defined tests and processes that validate the accuracy
of estimated parameters, data quality, model governance, etc. Therefore, model validation involves
a set of qualitative and quantitative checks, with the ultimate aim of assessing whether the model
under investigation is still suitable for its intended purpose. The validation procedures usually
include the steps for constructing the so-called validation sample. This validation sample comprises
data from one or more snapshots but with a completed model outcome indicator. Just as when
preparing datasets for modeling, it is essential to have adequate data history for validation purposes.
This historical data is crucial for determining the outcome of the process under investigation, such
as the default indicator for different timeframes (e.g., 6-month, 12-month, 24-month). It is essential
to align the performance window used during development and validation to ensure accurate and
reliable results. Note that the validation sample for this purpose differs from the validation sample
used during the development stage. Periodic model validation is carried out on the dataset that
was not part of the model development nor available at that moment. Additionally, sometimes the
validation sample is referred to as an application portfolio. Although an application portfolio can
consist of observations with uncompleted outcomes, throughout the book, we will assume that we
have the completed outcome for each observation.
This section will cover only the quantitative part of model validation. Concretely, we will present a
set of statistical tests and metrics used for three different areas of model validation:

1. PD model structure;
2. review of estimates;
3. margin of conservatism challengers.

The final decision on the validation outcome is usually made as a combination of the results of tests
and metrics from the areas mentioned above. In practice, there are no clear guidelines on the final
validation result, but the most common approach is the so-called traffic light approach. In this
approach, banks usually first assign weights to each test and metric, then calculate the overall
validation result and compare it with the defined threshold. Often, this is a more expert-based
decision than a statistical one.

In the developmental stage, practitioners typically strive to structure the entire modeling
process to enable statistical tests and metrics to yield meaningful outcomes considering the volume
of cases and defaults. Within this framework, the ranking model and the rating scale are two
pivotal components. Ensuring a sufficient discriminatory capacity is vital for the ranking model
while providing adequate granularity and substantiating the final number of rating grades (in
the case of a discrete rating scale) through rigorous statistical analysis are essential for the rating scale.

Before we dive deep into a specific validation area, let’s perform data preparation and

189
simulate the model in use. As a first step, we simulate development and validation samples based
on the dataset loans.
data(loans)
[Link](6422)
idx <- sample(x = 1:nrow(loans),
size = 0.7 * nrow(loans),
replace = FALSE)
[Link] <- loans[idx, ]
[Link] <- loans[-idx, ]

Next, we will build a model in use on the development sample. For this purpose, we make a
few assumptions: all numeric risk factors are discretized, we perform statistical binning of the
categorical risk factors, WoE encoding is used within the customized stepwise logistic regression
implemented in the stepFWD algorithm from the PDtoolkit package, and lastly, the discrete rating
scale is calibrated to the central tendency of 31%.
#define target
target <- "Creditability"
#define the numeric risk factors
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
#discretize the numeric risk factors
[Link].l <- length([Link])
[Link] <- vector("list", [Link].l)
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
[Link].i <- [Link](x = [Link][, [Link].i],
y = [Link][, target])
[Link][[i]] <- [Link](rf = [Link].i,
[Link].i[[1]])
[Link][, [Link].i] <- [Link].i[[2]]
}
[Link] <- bind_rows([Link])
#check if there are some risk factors that did not survive binning process
[Link] %>%
filter(bin != "SC") %>%
group_by(rf) %>%
summarise(n = n(),
survived = ifelse(n > 1, TRUE, FALSE)) %>%
[Link]()

190
## rf n survived
## 1 Age (years) 5 TRUE
## 2 Credit Amount 3 TRUE
## 3 Duration of Credit (month) 7 TRUE
#statistical binning of the categorical risk factors
[Link] <- names(loans)[!names(loans)%in%c([Link], target)]
[Link].l <- length([Link])
[Link] <- vector("list", [Link].l)
[Link] <- vector("list", [Link].l)
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
#statistical binning
[Link].i <- [Link](x = [Link][, [Link].i],
y = [Link][, target],
sc = "SC",
[Link] = "closest",
[Link] = 0.05,
[Link] = 0.01,
[Link] = 5,
[Link] = "modalities")
[Link][[i]] <- [Link](rf = [Link].i,
[Link].i[[1]])
#mapping old to new modalities
[Link][[i]] <- [Link](rf = [Link].i,
[Link] = [Link][, [Link].i],
[Link] = [Link].i[[2]]) %>%
group_by(rf, [Link]) %>%
summarise([Link] = unique([Link])) %>%
[Link]()
#replacing old with new values of the risk factors
[Link][, [Link].i] <- [Link].i[[2]]
}
[Link] <- bind_rows([Link])
[Link] <- bind_rows([Link])
#check if there are some risk factors that did not survive the binning process
[Link] %>%
filter(bin != "SC") %>%
group_by(rf) %>%
summarise(n = n(),

191
 survived = ifelse(n > 1, TRUE, FALSE)) %>%
[Link]()

## rf n survived
## 1 Account Balance 4 TRUE
## 2 Concurrent Credits 2 TRUE
## 3 Duration in Current address 4 TRUE
## 4 Foreign Worker 1 FALSE
## 5 Guarantors 2 TRUE
## 6 Instalment per cent 4 TRUE
## 7 Length of current employment 5 TRUE
## 8 Most valuable available asset 4 TRUE
## 9 No of Credits at this Bank 2 TRUE
## 10 No of dependents 2 TRUE
## 11 Occupation 3 TRUE
## 12 Payment Status of Previous Credit 4 TRUE
## 13 Purpose 5 TRUE
## 14 Sex & Marital Status 3 TRUE
## 15 Telephone 2 TRUE
## 16 Type of apartment 3 TRUE
## 17 Value Savings/Stocks 4 TRUE
#exclude the risk factor "Foreign Worker" from the further modeling process
[Link] <- [Link][, !names([Link])%in%"Foreign Worker"]
[Link] <- [Link][, !names([Link])%in%"Foreign Worker"]
#built the multivariate model
frm <- [Link](paste0(target, " ~ 1"))
[Link] <- stepFWD([Link] = frm,
[Link] = 0.05,
coding = "WoE",
db = [Link])
[Link]$steps

## rf aic [Link]
## 1 Account_Balance 750.1375 0.00000000000000000005694633
## 2 Duration_of_Credit__month 724.8604 0.00000053309602884888775774
## 3 Payment_Status_of_Previous_Credit 705.8125 0.00000758734036838198398940
## 4 Value_Savings_Stocks 692.5214 0.00016563229547305482569457
## 5 Purpose 682.8871 0.00076455727644333200312271
## 6 Credit_Amount 674.2297 0.00118102904950643421491674

192
## 7 Instalment_per_cent 663.2526 0.00038873973649577433977370
## 8 Sex___Marital_Status 655.7348 0.00211053835532626311508042
## 9 Age__years 651.5967 0.01340127502146087890011472
## [Link] [Link]
## 1 TRUE TRUE
## 2 TRUE TRUE
## 3 TRUE TRUE
## 4 TRUE TRUE
## 5 TRUE TRUE
## 6 TRUE TRUE
## 7 TRUE TRUE
## 8 TRUE TRUE
## 9 TRUE TRUE
#rename columns of the development sample
names([Link]) <- names([Link]$[Link])
#create the rating scale
[Link]$pred <- predict(object = [Link]$model)
[Link]$rating <- [Link](x = [Link]$pred,
y = [Link][, target])[[2]]
rs <- [Link] %>%
group_by(rating) %>%
summarise(no = n(),
nd = sum(!!sym(target)),
dr = mean(!!sym(target)),
[Link] = min(pred),
[Link] = max(pred)) %>%
[Link]()
#calibrate the rating scale to the central tendeny of 31%
ct <- 0.31
rs$[Link] <- [Link](rs = rs,
dr = "dr",
w = "no",
ct = ct,
[Link] = 0,
method = "[Link]")[["[Link]"]]
#check
sum(rs$no * rs$[Link] / sum(rs$no))

## [1] 0.31

193
#bring the calibrated pds to the development sample
[Link] <- rs$[Link]
names([Link]) <- rs$rating
[Link]$[Link] <- [Link][[Link]$rating]

Finally, after simulating the model in use, we will prepare a validation sample accordingly.
#discretize the numeric risk factors
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
mapping <- [Link][[Link]$rf%in%[Link].i,
c("[Link]", "[Link]")]
[Link][, [Link].i] <- [Link](x = [Link][, [Link].i],
mapping = mapping)
}
#map the categorical risk factors
[Link] <- [Link][![Link]%in%"Foreign Worker"]
[Link].l <- length([Link])
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
mapping <- [Link][[Link]$rf%in%[Link].i,
c("[Link]", "[Link]")]
[Link][, [Link].i] <- [Link](x = [Link][, [Link].i],
mapping = mapping)
}
#rename the columns to match the development samples
[Link] <- names([Link]$[Link])
names([Link]) <- names([Link])
names([Link]) <- names([Link]$[Link])
[Link]$rf <- unname([Link][[Link]$rf])
[Link] <- [Link][![Link]$rf%in%"Foreign Worker", ]
[Link]$rf <- unname([Link][[Link]$rf])
#validation sample with the WoE encoding
[Link] <- c("rf", "bin", "woe")
[Link] <- bind_rows([Link][, [Link]],
[Link][, [Link]])
names([Link]) <- c("rf", "[Link]", "[Link]")
[Link] <- [Link]$steps$rf
[Link].l <- length([Link])
[Link] <- [Link]

194
for (i in 1:[Link].l) {
[Link].i <- [Link][i]
mapping <- [Link][[Link]$rf%in%[Link].i,
c("[Link]", "[Link]")]
[Link][, [Link].i] <- [Link](x = [Link][, [Link].i],
mapping = mapping)
}
#prediction scores based on the final model
[Link]$pred <- predict(object = [Link]$model,
newdata = [Link])
#create the predicted rating
[Link]$rating <- [Link](x = [Link]$pred,
mapping = rs[, c("[Link]", "[Link]")])
#bring the calibrated pds to the validation sample
[Link]$[Link] <- [Link][[Link]$rating]

We now have all elements ([Link], [Link], [Link], [Link]$model, rs) ready to
perform the validation tasks. Note that most of the tests and metrics presented in the following
sections are similar to those shown in the bivariate and the multivariate sections but with an
essential difference in the validation sample creation and purpose of the exercise.

7.1 PD model structure

The tests and metrics in this section aim to assess whether the model in use sufficiently differentiates
risk between the observations from the validation portfolio. In general, various aspects of the model
are validated, such as changes in discriminatory power over time, stability of risk factors from the
model, heterogeneity, homogeneity of the rating scale, and the concentration of the rating scale.
Let’s see how this analysis can be conducted in R using the PDtoolkit package.
We begin by testing the change in discriminatory power of the model. For this task, we typically
examine whether the discriminatory power, measured by AUC, deteriorates from the moment of
development to the moment of validation. To do so, we will first calculate the AUC from the model
development phase and compare it with the AUC on the validation sample.
#AUC on the development sample
[Link] <- [Link](observed = [Link][, target],
predictions = [Link]$[Link])
[Link]

## [1] 0.8355808

195
#test change of the AUC from the moment of development
[Link]([Link] = [Link],
[Link] = target,
pdc = "[Link]",
[Link] = [Link],
alternative = "less",
alpha = 0.05)

## auc [Link] estimate [Link] [Link] [Link] alpha

## 1 0.7461591 0.8355808 -0.08942176 0.03267651 -2.736577 0.003104107 0.05
## res
## 1 H1: AUC < AUC test

Based on the test results, we can conclude that there was a significant drop in model discriminatory
power for the significance level of 5%. In absolute values, AUC decreases by 8.94% percentage
points. Just as we assess discriminatory power during the initial model validation process across
various business-defined sub-segments, we can also incorporate this analysis as part of our periodic
model validation activities. Readers can consult the section Analysis of Discriminatory Power for
additional information.
In the next task, we will test the stability of the risk factors from the model in use. For the sake
of simplicity, we consider a significant change in risk factor distribution, if observed PSI is greater
than 0.25.
#select the risk factors from the final model
[Link] <- [Link]$steps$rf
#calculate psi for each risk factor
[Link].l <- length([Link])
[Link] <- vector("list", [Link].l)
for (i in 1:[Link].l) {
rf.i <- [Link][i]
#development sample used as a base while validation as a target
psi.i <- psi(base = [Link][, rf.i],
target = [Link][, rf.i])
[Link][[i]] <- [Link](rf = rf.i,
psi = psi.i[[1]]$psi)
}
[Link] <- bind_rows([Link])
#check if any psi is greater than threshold
[Link][[Link]$psi > 0.25, ]

## [1] rf psi

196
## <0 rows> (or 0-length [Link])

From the PSI testing, we can conclude that there are no risk factors with significant changes in
distribution in the development sample compared to the application portfolio.
The next test is the heterogeneity of the rating scale. This test is implemented entirely on the
application portfolio, and as input from the development sample, it requires only rating grades.
[Link] <- heterogeneity([Link] = [Link],
[Link] = target,
rating = "rating",
alpha = 0.05)
[Link]

## rating no nb dr [Link] alpha

## 1 01 (-Inf,-2.795) 47 3 0.06382979 NA 0.05
## 2 02 [-2.795,-1.3517) 95 20 0.21052632 0.012783185 0.05
## 3 03 [-1.3517,-0.4454) 68 17 0.25000000 0.276509742 0.05
## 4 04 [-0.4454,0.4678) 53 24 0.45283019 0.009674613 0.05
## 5 05 [0.4678,Inf) 37 28 0.75675676 0.002037247 0.05
## res
## 1 <NA>
## 2 H1: DR(02 [-2.795,-1.3517)) > DR(01 (-Inf,-2.795))
## 3 H0: DR(03 [-1.3517,-0.4454)) <= DR(02 [-2.795,-1.3517))
## 4 H1: DR(04 [-0.4454,0.4678)) > DR(03 [-1.3517,-0.4454))
## 5 H1: DR(05 [0.4678,Inf)) > DR(04 [-0.4454,0.4678))

Although we recorded a significant decrease in discriminatory power measured by AUC, hetero-

geneity shows good results with only one pair of rating grades (02 [-2.795,-1.3517) and 03
[-1.3517,-0.4454)) which deviates from the tested hypothesis for a significance level of 5%. In
practice, we usually calculate a weighted p-value to make an overall decision on heterogeneity. Often,
the number of observations or exposure amount in two adjacent rating grades is used as a weight.
In R, this can be implemented as follows.
#weights
w <- ([Link]$no + lag([Link]$no, n = 1))[-1]
#p-values
[Link] <- [Link]$[Link][-1]
#weighted p-value
sum(w * [Link] / sum(w))

## [1] 0.09348892

Heterogeneity is usually followed by homogeneity testing, but as it requires a significantly higher

197
number of observations and defaults per rating grade, we will skip it in this section and move to the
metric which assesses concentration. As mentioned in the Rating scale section, the standard metric
of concentration is the Herfindahl-Hirschman index (HHI). Often in practice, it is applied on the
number of observations per rating grade, but also on exposure amounts. The following examples
demonstrate the calculation of HHI based on the number of observations and compare it with a
threshold of 0.25.
hhi(x = table([Link]$rating))

## [1] 0.2226222

Note that although the comparison to the fixed threshold is the most commonly used in practice, we
can deploy the bootstrap method to derive a distribution of HHI and translate the testing conclusion
in terms of probabilities.
#define number of bootstrap samples
B <- 1000
#number of observations in validation sample
[Link] <- nrow([Link])
#HHI bootstrap distribution
[Link](991)
[Link] <- rep(NA, B)
for (i in 1:B) {
idx <- sample(x = 1:[Link],
size = [Link],
replace = TRUE)
[Link] <- table([Link]$rating[idx])
[Link][i] <- hhi(x = [Link])
}
#histogram of the bootstrapped HHI values
hist(x = [Link],
main = "Histogram of bootstrapped HHI values",
xlab = "HHI")

198
 Histogram of bootstrapped HHI values
250
200
150
Frequency

100
50
0

0.21 0.22 0.23 0.24 0.25 0.26

HHI

#p-value of the hypothesis that HHI is less than 0.25

mean([Link] < 0.25)

## [1] 0.992

The identical approach can be applied to assess the statistical significance of the HHI within the
validation sample when compared to the development sample. Furthermore, it can also be used to
determine the statistical significance of the change in HHI between the validation and development
samples.

7.2 Review of estimates

The review of estimates, in essence, assesses the predictive power of the model in use. Therefore, it
is closely related to the calibration and risk quantification. The predictive power analysis aims to
ensure that the PD parameter adequately predicts the occurrence of defaults, i.e., that PD estimates
constitute reliable forecasts of default rates.
In practice, the four statistical tests are commonly used, and they are exact binomial, Jeffreys’,
z-score, and Hosmer-Lemeshow test. Only the Hosmer-Lemeshow test is designed for the overall
rating scale, while others are usually applied on the level of the rating grade. We can use the
[Link] function from the PDtoolkit package to perform these tests in R. The null hypothesis
for the exact binomial, Jeffreys’, and z-score tests is that the observed default rate is less than

199
or equal to the predicted PD value. In contrast, the Hosmer-Lemeshow test postulates that the
predicted PD is the true one without specifying a directional relationship.
#prepare the rating level data of the validation sample
[Link] <- [Link] %>%
group_by(rating) %>%
summarise(no = n(),
nd = sum(!!sym(target)),
dr = mean(!!sym(target)),
pdc = mean([Link])) %>%
[Link]()
#run predictive power tests
[Link]([Link] = [Link]$rating,
pdc = [Link]$pdc,
no = [Link]$no,
nb = [Link]$nd,
alpha = 0.05)

## rating no nb odr pdc alpha binomial

## 1 01 (-Inf,-2.795) 47 3 0.06382979 0.03065976 0.05 0.174315686
## 2 02 [-2.795,-1.3517) 95 20 0.21052632 0.11608515 0.05 0.005872107
## 3 03 [-1.3517,-0.4454) 68 17 0.25000000 0.29069078 0.05 0.807275485
## 4 04 [-0.4454,0.4678) 53 24 0.45283019 0.55144457 0.05 0.942743863
## 5 05 [0.4678,Inf) 37 28 0.75675676 0.76484545 0.05 0.633218374
## [Link] jeffreys [Link] zscore [Link]
## 1 H0: ODR <= PDC 0.101339628 H0: ODR <= PDC 0.093570599 H0: ODR <= PDC
## 2 H1: ODR > PDC 0.003963794 H1: ODR > PDC 0.002028972 H1: ODR > PDC
## 3 H0: ODR <= PDC 0.767302917 H0: ODR <= PDC 0.770032363 H0: ODR <= PDC
## 4 H0: ODR <= PDC 0.925185817 H0: ODR <= PDC 0.925561298 H0: ODR <= PDC
## 5 H0: ODR <= PDC 0.559591842 H0: ODR <= PDC 0.546179809 H0: ODR <= PDC
## [Link] [Link]
## 1 0.02698655 H1: PDC is not TRUE
## 2 0.02698655 H1: PDC is not TRUE
## 3 0.02698655 H1: PDC is not TRUE
## 4 0.02698655 H1: PDC is not TRUE
## 5 0.02698655 H1: PDC is not TRUE

Based on the tests on the rating grade level, we see that only for rating grade 02 [-2.795,-1.3517)
there is evidence that the observed default rate is greater than the predicted PD for the significance
level of 5%. Conversely, utilizing the Hosmer-Lemeshow test for the overall rating scale, we deduce
that the predicted PD does not align with the actual one, offering statistical evidence of a significant

200
disparity between the observed default rate and the predicted PD. With a substantial proportion of
cases ((47+95)/300) and defaults ((3+20)/92) within the application portfolio concentrated in the
first two rating grades where the observed default rate surpasses the predicted PD in absolute terms,
the Hosmer-Lemeshow test offers supplementary evidence pointing to the potential underestimation
of PD for these particular rating grades. Situations like this, where there is no clear conclusion if
the predicted PD is underestimated or not, are often in practice, especially in cases of validation
samples with a limited number of observations.
To arrive at a conclusive decision in this analysis, the PDtoolkit package introduces an additional
function known as power. This function leverages Monte Carlo simulations to assess the statistical
power of the four tests, providing valuable insights into their capacity to detect significant deviations
between observed and predicted values within a specified validation framework. Specifically, for the
exact binomial, Jeffreys’, and z-score tests, as well as for rating grades where the observed default
rate exceeds the predicted PD, power analysis is employed to gauge their effectiveness in identifying
genuine differences. On the other hand, in the case of rating grades where the observed default
rate is equal to or lower than the predicted PD, power analysis aids in controlling type I errors.
Within the power analysis framework, the Hosmer-Lemeshow test is applied independently of any
consideration for the relationship between the observed default rate and the predicted PD at the
application portfolio level.
power([Link] = [Link]$rating,
pdc = [Link]$pdc,
no = [Link]$no,
nb = [Link]$nd,
alpha = 0.05,
[Link] = 1000,
seed = 2211)

## $[Link]
## rating no nb odr pdc binomial jeffreys zscore
## 1 01 (-Inf,-2.795) 47 3 0.06382979 0.03065976 0.171 0.343 0.343
## 2 02 [-2.795,-1.3517) 95 20 0.21052632 0.11608515 0.790 0.790 0.790
## 3 03 [-1.3517,-0.4454) 68 17 0.25000000 0.29069078 0.004 0.004 0.013
## 4 04 [-0.4454,0.4678) 53 24 0.45283019 0.55144457 0.001 0.001 0.001
## 5 05 [0.4678,Inf) 37 28 0.75675676 0.76484545 0.030 0.030 0.030
##
## $[Link]
##
## 1 01 (-Inf,-2.795) + 02 [-2.795,-1.3517) + 03 [-1.3517,-0.4454) + 04 [-0.4454,0.4678) + 05 [
## [Link]
## 1 0.799

201
The above results suggest that when the observed default rate accurately represents the true rate
and for rating grades where the observed default rate surpasses the predicted PD, both the Jeffreys’
test (with power values of 34.3% and 79%) and the z-score test (with power values of 34.3%
and 79%) demonstrate greater power in detecting real differences when compared to the exact
binomial test (with power values of 17.1% and 79%). However, it’s important to note that all three
tests reached their maximum power of 79% for the second rating grade. The Hosmer-Lemeshow
test shows a high score of almost 80% of statistical power for this concrete validation sample.
Considering the robust ability to detect actual differences (evident in the grade-level tests for the
second rating grade and the Hosmer-Lemeshow test on the overall rating scale), it is reasonable to
deduce that there are indications of potential PD underestimation. Therefore, it is advisable to
conduct further investigation for rating grades 01 (-Inf,-2.795) and 02 [-2.795,-1.3517).

Practitioners often employ the presented tests to assess various PD estimates, including
the PD best estimate, the PD best estimate with MoCs, and the PD best estimate with MoCs,
along with any extra add-ons tailored to the portfolio or market. Among these outcomes, the
primary emphasis should be on the ultimate PD, which encompasses MoCs and other supplementary
add-ons.

7.3 Margin of conservatism challengers

Due to the variety of possible sources of model uncertainty, the challengers of the margin of
conservatism are oriented toward uncertainty that comes from general estimation error. Moreover,
they are usually limited to the variability of the long-run default rates (on a portfolio or rating grade
level) and are based on the confidence interval of binomial proportion. Therefore, the challengers
used for this purpose are similar to those presented in Margin of conservatism (general estimation
error of the calibration). A significant difference is in using the results from the challengers and the
fact that the calibration dataset is updated with recent periods.
In our repeated exercise, it is crucial to remember that we will be comparing the calculated MoCs
with add-ons to the PD best estimate. First, let’s simulate the calibration dataset with an extension
of additional 24 months.
[Link](2022)
#default rate simulation
dr <- rnorm(n = 120 + 24, mean = 0.05, sd = 0.005)
#number of observations per snapshot
no <- sample(x = 500:800,
size = 120 + 24,
replace = TRUE)
#number of defaults per snapshot
nd <- round(no * dr)

202
#snapshot dates
date <- seq(from = [Link]("2013-01-01"),
by = "1 month",
[Link] = 120 + 24)
[Link] <- [Link](date, no, nd, dr)
#head of the simulated dataset
head([Link])

## date no nd dr
## 1 2013-01-01 554 30 0.05450071
## 2 2013-02-01 782 35 0.04413327
## 3 2013-03-01 647 29 0.04551257
## 4 2013-04-01 515 22 0.04277749
## 5 2013-05-01 633 31 0.04834493
## 6 2013-06-01 560 20 0.03549686
#central tendency of the simulated default rates
ct <- mean([Link]$dr)
ct

## [1] 0.05043464

Now we are ready to calculate the MoC challengers for a confidence level of 80%.
#define confidence level
cl <- 0.8
#empirical quantile
eq <- quantile(x = [Link]$dr,
prob = cl)
#moc - difference between the empirical quantile and the central tendency
[Link] <- unname(eq - ct)
[Link]

## [1] 0.004689121
#Clopper-Pearson upper confidence bound
cp <- qbeta(p = cl,
shape1 = [Link]$nd + 1,
shape2 = [Link]$no - [Link]$nd)
#moc - difference between the simulate average default rate
#and the central tendency
[Link] <- mean(cp) - ct
[Link]

203
## [1] 0.008721838
#Jeffreys' upper confidence bound
jf <- qbeta(p = cl,
shape1 = [Link]$nd + 0.5,
shape2 = [Link]$no - [Link]$nd + 0.5)
#moc - difference between the simulate average default rate
#and the central tendency
[Link] <- mean(jf) - ct
[Link]

## [1] 0.007882823

To reach a final conclusion regarding the level of empirical MoCs, it is necessary to compare the
calculated MoC with the empirical MoCs added to the model’s best estimate. In practice, the
final PD estimate typically comprises the best estimate, and on top of it, regulatory and other
MoC factors are added. In this context, we usually compare the MoC challengers to the add-ons
used alongside the PD best estimate. The same analysis is performed on the rating grade level if
sufficient data is available.

While it may not be frequently employed in practice, MoC challengers can be substan-
tially improved by addressing an additional source of uncertainty related to the ranking model. One
approach to achieving this is by implementing conformal inference, as detailed in section Ranking
model uncertainty.

204
8 Fairness analysis
The primary purpose of the PD models is to discriminate between clients based on their creditwor-
thiness. However, during the development of risk differentiation functions, there is a possibility that
the model also discriminates based on protected attributes, such as gender, age, or race, among
clients with and without these attributes. Such discrimination may influence loan approvals or
risk-based pricing decisions. Analysis that deals with this issue is usually called fairness analysis.
In the PDtoolkit package, we adopted the framework proposed by Hurlin, Pérignon, and Saurin
(2022) for the fairness analysis. In contrast to other fairness frameworks that often compare metrics
with commonly accepted thresholds, this framework utilizes statistical tests to assess model fairness.
It implements three essential fairness metrics:

1. statistical parity: a metric that evaluates whether different sensitive classes receive the same
treatment or outcome for a specific decision;
2. conditional statistical parity: a metric that evaluates whether different sensitive classes receive
the same treatment or outcome for a specific decision conditional on a particular segment
variable;
3. equal odds: a metric that evaluates whether different sensitive classes receive the same
treatment or outcome for a specific decision conditional on the observed outcome.

Translated into the proposed framework, we say that a model satisfies the following:

1. the statistical parity assumption if the predicted label and the sensitive attribute are indepen-
dent;
2. the conditional statistical parity assumption if the predicted label and the sensitive attribute
are independent, conditional on a subset of non-protected attributes;
3. the equal odds property if the predicted outcome and the protected attribute are independent
conditional on the actual outcome.

Besides the binary model outcome, the proposed framework can be easily extended to test the model
fairness for multiclass classification problems and continuous outcomes (e.g., interest rate). In a
nutshell, the proposed framework relies on the chi-square test and the assumption that a sum of two
independent variables that follow a chi-squared distribution with degrees of freedom df.1 and df.2
is also a variable chi-squared distributed with df.1 + df.2 degrees of freedom. Consequently, the
aggregated diagnosis of individual tests is the sum of chi-squared statistics and individuals’ degrees
of freedom.
Before we demonstrate how to perform fairness validation, let’s build a hypothetical model in use
and prepare the data for further analysis.
#build a hypothetical model
data(loans)
res <- stepFWDr([Link] = Creditability ~ 1,
db = loans,

205
 [Link] = 0.05)
#print the coefficients
summary(res$model)$coefficients

## Estimate Std. Error z value

## (Intercept) 0.309350061 0.510714268 0.60572042
## Account_Balance2 -0.566423709 0.190227251 -2.97761602
## Account_Balance3 -1.205152471 0.343530929 -3.50813382
## Account_Balance4 -1.950714449 0.209762019 -9.29965518
## Duration_of_Credit__month 0.035991508 0.006573616 5.47514566
## Payment_Status_of_Previous_Credit1 -0.017751218 0.486744616 -0.03646926
## Payment_Status_of_Previous_Credit2 -0.908628285 0.377677776 -2.40582937
## Payment_Status_of_Previous_Credit3 -0.940072229 0.440073744 -2.13616977
## Payment_Status_of_Previous_Credit4 -1.472715043 0.401956708 -3.66386482
## Guarantors2 0.570299658 0.380488628 1.49886124
## Guarantors3 -0.917025386 0.393243114 -2.33195536
## Foreign_Worker2 -1.348505220 0.592482512 -2.27602535
## Length_of_current_employment2 0.375963618 0.345582032 1.08791425
## Length_of_current_employment3 -0.009180829 0.326358992 -0.02813107
## Length_of_current_employment4 -0.602072607 0.361008070 -1.66775388
## Length_of_current_employment5 -0.206993037 0.338917075 -0.61074833
## Pr(>|z|)
## (Intercept) 0.54470042146294272988882312
## Account_Balance2 0.00290499669361344269036262
## Account_Balance3 0.00045126198935846098926963
## Account_Balance4 0.00000000000000000001409019
## Duration_of_Credit__month 0.00000004371518857696073222
## Payment_Status_of_Previous_Credit1 0.97090818570141390608796428
## Payment_Status_of_Previous_Credit2 0.01613579915771431311233286
## Payment_Status_of_Previous_Credit3 0.03266557849596266049907456
## Payment_Status_of_Previous_Credit4 0.00024843793297237292154109
## Guarantors2 0.13390963232311420272324654
## Guarantors3 0.01970303987922373059604730
## Foreign_Worker2 0.02284449213754234653261932
## Length_of_current_employment2 0.27663296375722579156786196
## Length_of_current_employment3 0.97755761094495319252217769
## Length_of_current_employment4 0.09536459560651047717705353
## Length_of_current_employment5 0.54136620696644022210364255

206
#prepare the data frame for the fairness validation
[Link] <- [Link](Creditability = loans$Creditability,
mpred = predict(object = res$model,
type = "response",
newdata = res$[Link]))
#cutoff palette
cop <- [Link](predictions = [Link]$mpred,
observed = [Link]$"Creditability",
[Link] = 0.05,
[Link] = 0.01)
cop

## metric min max [Link] [Link]

## 1 accuracy 0.35800000 0.7710000 0.05435566 0.47945213
## 2 error rate 0.22900000 0.6420000 0.47945213 0.05435566
## 3 sensitivity 0.11666667 0.9866667 0.70501352 0.05435566
## 4 specificity 0.08857143 0.9785714 0.05435566 0.70501352
## 5 precision 0.31691649 0.7530864 0.05435566 0.64428546
## 6 [Link] 0.20000000 0.6201550 0.70501352 0.27124161
## 7 false positive 0.02142857 0.9114286 0.70501352 0.05435566
## 8 false discovery 0.24691358 0.6830835 0.64428546 0.05435566
#confusion matrix for the highest f1 score
[Link] <- cop$[Link][cop$metric%in%"[Link]"]
[Link](predictions = [Link]$mpred,
observed = [Link]$"Creditability",
cutoff = [Link])

## $[Link]
## predicted
## observed 0 1
## 0 466 234
## 1 60 240
##
## $metrics
## metric value
## 1 accuracy 0.7060000
## 2 error rate 0.2940000
## 3 sensitivity 0.8000000
## 4 specificity 0.6657143

207
## 5 precision 0.5063291
## 6 [Link] 0.6201550
## 7 false positive 0.3342857
## 8 false discovery 0.4936709
#add the hypothetical reject/accept indicator (the highest f1 score)
[Link]$rai <- ifelse([Link]$mpred > cop$[Link][cop$metric%in%"[Link]"], 1, 0)
#add the hypothetical sensitive attribute
#"Sex & Marital Status"
[Link]$sensitive.1 <- ifelse(loans$"Sex & Marital Status"%in%4, 1, 0)
#"Age (years)"
[Link] <- quantile(x = loans$"Age (years)", prob = 0.50)
[Link]$sensitive.2 <- ifelse(loans$"Age (years)" > [Link], 1, 0)
#add some attributes for the calculation of conditional statistical parity
[Link]$"Credit Amount" <- cut2(loans$"Credit Amount", g = 3)
head([Link])

## Creditability mpred rai sensitive.1 sensitive.2 Credit Amount

## 1 0 0.4651680 1 0 0 [ 250, 1555)
## 2 0 0.2997220 1 0 1 [1555, 3378)
## 3 0 0.2081890 0 0 0 [ 250, 1555)
## 4 0 0.1101556 0 0 1 [1555, 3378)
## 5 0 0.1101556 0 0 1 [1555, 3378)
## 6 0 0.1447988 0 0 1 [1555, 3378)

We will now conduct the fairness validation based on the binary outcome (reject/accept indicator
rai) and two hypothetical sensitive attributes, namely sensitive.1 (Sex & Marital Status) and
sensitive.2 (Age in years). For the analysis of conditional statistical parity, we have chosen
Credit amount as the controlled risk attribute.
#discrete model outcome sensitive attribute sex
[Link](db = [Link],
sensitive = "sensitive.1",
[Link] = "Creditability",
[Link] = "rai",
conditional = "Credit Amount",
[Link] = "disc",
[Link] = 0.05)

## $SP
## nobs statistic df [Link] res
## 1 1000 0.01774882 1 0.8940157 H0: independence assumption cannot be rejected.

208
##
## $CSP
## attribute modality nobs statistic df [Link]
## 1 Credit Amount [ 250, 1555) 334 0.2001057 1 0.6546355
## 2 Credit Amount [1555, 3378) 333 0.1380294 1 0.7102480
## 3 Credit Amount [3378,18424] 333 1.8800589 1 0.1703275
## 4 Credit Amount overall 1000 2.2181940 3 0.5283736
## res
## 1 H0: independence assumption cannot be rejected.
## 2 H0: independence assumption cannot be rejected.
## 3 H0: independence assumption cannot be rejected.
## 4 H0: independence assumption cannot be rejected.
##
## $EO
## metric modality nobs statistic df [Link]
## 1 equal opportunity 0 700 0.02695521 1 0.8695891
## 2 predictive equality 1 300 0.00000000 1 1.0000000
## 3 equal odds overall 1000 0.02695521 2 0.9866128
## res
## 1 H0: independence assumption cannot be rejected.
## 2 H0: independence assumption cannot be rejected.
## 3 H0: independence assumption cannot be rejected.
#discrete model outcome sensitive attribute age
[Link](db = [Link],
sensitive = "sensitive.2",
[Link] = "Creditability",
[Link] = "rai",
conditional = "Credit Amount",
[Link] = "disc",
[Link] = 0.05)

## $SP
## nobs statistic df [Link] res
## 1 1000 13.84417 1 0.0001986119 H0: independence assumption rejected.
##
## $CSP
## attribute modality nobs statistic df [Link]
## 1 Credit Amount [ 250, 1555) 334 6.537306 1 0.01056352
## 2 Credit Amount [1555, 3378) 333 6.387682 1 0.01149150

209
## 3 Credit Amount [3378,18424] 333 2.694931 1 0.10066786
## 4 Credit Amount overall 1000 15.619919 3 0.00135669
## res
## 1 H0: independence assumption rejected.
## 2 H0: independence assumption rejected.
## 3 H0: independence assumption cannot be rejected.
## 4 H0: independence assumption rejected.
##
## $EO
## metric modality nobs statistic df [Link]
## 1 equal opportunity 0 700 7.163461151 1 0.007440349
## 2 predictive equality 1 300 0.003482056 1 0.952944982
## 3 equal odds overall 1000 7.166943207 2 0.027779093
## res
## 1 H0: independence assumption rejected.
## 2 H0: independence assumption cannot be rejected.
## 3 H0: independence assumption rejected.

Based on the results above, we see that for the first sensitive attribute, sensitive.1 the independence
assumption cannot be rejected for all three fairness metrics. Therefore, we conclude that the model
is fair for the analyzed protected attribute.
For the second sensitive attribute, sensitive.2 and fairness matrices conditional statistical parity
and equal odds, we rejected the independence assumption, thus concluding that our model does not
satisfy these two assumptions for the significance level of 5%.
Before exploring how to address situations where the model fails to meet certain fairness assumptions,
let’s expand on the previous example by introducing rating grades and testing the average interest
rate on approved loans concerning the same protected attributes. As already mentioned, the
proposed framework can readily handle continuous model outcomes.
#add the rating grades
[Link]$score <- [Link](probs = [Link]$mpred)
[Link]$rating <- [Link](x = [Link]$score,
y = [Link]$Creditability)[[2]]
table([Link]$rating)

##
## 01 (-Inf,471.758) 02 [471.758,492.2173) 03 [492.2173,516.6698)
## 87 163 230
## 04 [516.6698,550.9402) 05 [550.9402,Inf)
## 297 223

210
#add the interest rate associated with the rating grades
ir.r <- seq(0.02, 0.07, [Link] = 5)
names(ir.r) <- sort(unique([Link]$rating))
[Link]$ir <- ir.r[[Link]$rating]
table([Link]$rating, [Link]$ir)

##
## 0.02 0.0325 0.045 0.0575 0.07
## 01 (-Inf,471.758) 87 0 0 0 0
## 02 [471.758,492.2173) 0 163 0 0 0
## 03 [492.2173,516.6698) 0 0 230 0 0
## 04 [516.6698,550.9402) 0 0 0 297 0
## 05 [550.9402,Inf) 0 0 0 0 223

Now, we can perform fairness validation based on the same protected attributes and interest rates as
continuous model outcomes. To further analyze the data and simplify the process, we will perform
fairness validation based on a subset of the original dataset.
#select [Link] sample
[Link](991)
[Link] <- sample(x = 1:nrow([Link]),
size = 300,
replace = FALSE)
[Link] <- [Link][[Link], ]
#continuous model outcome sensitive attribute sex
[Link](db = [Link],
sensitive = "sensitive.1",
[Link] = "Creditability",
[Link] = "ir",
conditional = "Credit Amount",
[Link] = "cont",
[Link] = 0.05)

## $SP
## nobs statistic df [Link] res
## 1 300 0.408485 1 0.5227395 H0: average equality cannot be rejected.
##
## $CSP
## attribute modality nobs statistic df [Link]
## 1 Credit Amount [ 250, 1555) 96 0.20037640 1 0.6544172
## 2 Credit Amount [1555, 3378) 97 0.05552585 1 0.8137126

211
## 3 Credit Amount [3378,18424] 107 0.37285498 1 0.5414522
## 4 Credit Amount overall 300 0.62875722 3 0.8898186
## res
## 1 H0: average equality cannot be rejected.
## 2 H0: average equality cannot be rejected.
## 3 H0: average equality cannot be rejected.
## 4 H0: average equality cannot be rejected.
##
## $EO
## metric modality nobs statistic df [Link]
## 1 equal opportunity 0 209 0.1319835 1 0.7163843
## 2 predictive equality 1 91 0.1847450 1 0.6673268
## 3 equal odds overall 300 0.3167285 2 0.8535388
## res
## 1 H0: average equality cannot be rejected.
## 2 H0: average equality cannot be rejected.
## 3 H0: average equality cannot be rejected.
#continuous model outcome sensitive attribute age
[Link](db = [Link],
sensitive = "sensitive.2",
[Link] = "Creditability",
[Link] = "ir",
conditional = "Credit Amount",
[Link] = "cont",
[Link] = 0.05)

## $SP
## nobs statistic df [Link] res
## 1 300 8.975584 1 0.002736111 H0: average equality rejected.
##
## $CSP
## attribute modality nobs statistic df [Link]
## 1 Credit Amount [ 250, 1555) 96 1.829544 1 0.176181430
## 2 Credit Amount [1555, 3378) 97 3.389920 1 0.065596146
## 3 Credit Amount [3378,18424] 107 7.465171 1 0.006290406
## 4 Credit Amount overall 300 12.684634 3 0.005370696
## res
## 1 H0: average equality cannot be rejected.
## 2 H0: average equality cannot be rejected.

212
## 3 H0: average equality rejected.
## 4 H0: average equality rejected.
##
## $EO
## metric modality nobs statistic df [Link]
## 1 equal opportunity 0 209 5.283262 1 0.02153137
## 2 predictive equality 1 91 1.996470 1 0.15766608
## 3 equal odds overall 300 7.279731 2 0.02625587
## res
## 1 H0: average equality rejected.
## 2 H0: average equality cannot be rejected.
## 3 H0: average equality rejected.

The above fairness validation leads to similar results as for the binary model outcome, so we cannot
reject the independence assumption for the first sensitive attribute. In contrast, the hypothesis is
rejected for the significance level of 5% for the second sensitive attribute and all three fairness metrics.

Various approaches have been suggested to address the issue of model fairness. They are
usually known as fairness processors, and depending on the development stage to which they are
introduced, the literature distinguishes three methods of intervention: pre-processing, in-processing,
and post-processing. Given the highly regulated environment of credit risk model development and
a variety of fairness metrics and approaches, this section will present two possible strategies for the
post-processing method. Adjustments of presented approaches to different fairness metrics are left
to the readers, and we encourage them to design and select the fairness processor which suits their
needs.
For the first example in this section, where we had the binary model outcome - reject/accept
indicator rai and the protected attribute - sensitive.2 assumption of equal odds was not satisfied.
A possible solution for this issue could be selecting another cutoff point for the model outcome. So,
let’s see how this can be done in R. We begin with data preparation and testing the equal odds
metric at various cutoff points.
#current cutoff point for the model in use
[Link]

## [1] 0.2712416
#cufoff candidates
cop.c <- seq(from = 0.1,
to = 0.9,
[Link] = 100)
#helper function for the selection of a fair cutoff point among candidates

213
[Link] <- function(db, cop, [Link], margin = 0.03) {
db$rai <- ifelse(db$mpred > cop, 1, 0)
fair.m <- [Link](db = db,
sensitive = "sensitive.2",
[Link] = "Creditability",
[Link] = "rai",
conditional = NULL,
[Link] = "disc",
[Link] = [Link])$EO
[Link] <- fair.m$[Link][fair.m$metric%in%"equal odds"]
cop.c <- ifelse([Link] > ([Link] + margin), TRUE, FALSE)
return(cop.c)
}
#run cutoff point analysis
cop.a <- sapply(X = cop.c,
FUN = function(x) [Link](db = [Link], cop = x, [Link] = 0.05))
cop.a

## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [73] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [85] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE
## [97] TRUE TRUE FALSE FALSE
#select the fair cutoffs
cop.s <- cop.c[cop.a]
cop.s

## [1] 0.6010101 0.6090909 0.6171717 0.6252525 0.6333333 0.6414141 0.6494949

## [8] 0.6575758 0.6656566 0.6737374 0.6818182 0.6898990 0.6979798 0.7060606
## [15] 0.7141414 0.7222222 0.7303030 0.7383838 0.7464646 0.7545455 0.7626263
## [22] 0.7707071 0.7787879 0.7868687 0.7949495 0.8030303 0.8111111 0.8191919
## [29] 0.8272727 0.8353535 0.8434343 0.8515152 0.8595960 0.8757576 0.8838384

Based on the simulations above, we observe that other possible cutoff points satisfy the assumption
of equal odds (cop.s). To determine the most suitable cutoff point among all candidates, we will
conduct another simulation and select the one that maximizes the [Link], the same metric used

214
to define the initial cutoff point ([Link]).
#helper function for finding the optimal cutoff based on the f1 score
[Link] <- function(db, cop) {
cm <- [Link](predictions = db$mpred,
observed = db$"Creditability",
cutoff = cop)[["metrics"]]
[Link] <- cm$value[cm$metric%in%"[Link]"]
return([Link])
}
#calcularte the f1 scores
cop.f1 <- sapply(X = cop.s,
FUN = function(x) [Link](db = [Link], cop = x))
#find a new optimal cutoff
[Link].n <- cop.s[[Link](cop.f1)]
[Link].n

## [1] 0.6010101
#compare the summary of confusion matrix of the "rai" indicator for the initial
#and the new cutoff point
#initial cutoff - [Link]
[Link](predictions = [Link]$mpred,
observed = [Link]$"Creditability",
cutoff = [Link])[["metrics"]]

## metric value
## 1 accuracy 0.7060000
## 2 error rate 0.2940000
## 3 sensitivity 0.8000000
## 4 specificity 0.6657143
## 5 precision 0.5063291
## 6 [Link] 0.6201550
## 7 false positive 0.3342857
## 8 false discovery 0.4936709
#new cutoff - [Link].n
[Link](predictions = [Link]$mpred,
observed = [Link]$"Creditability",
cutoff = [Link].n)[["metrics"]]

## metric value

215
## 1 accuracy 0.7450000
## 2 error rate 0.2550000
## 3 sensitivity 0.2666667
## 4 specificity 0.9500000
## 5 precision 0.6956522
## 6 [Link] 0.3855422
## 7 false positive 0.0500000
## 8 false discovery 0.3043478

We observe that changing the cutoff point also influences the values of other metrics in the confusion
matrix summary. Consequently, it is essential for readers to thoroughly investigate this change,
considering that altering the initial cutoff point comes with certain costs. Finally, to achieve fairness,
we can define a new reject/accept indicator and re-run the fairness validation specifically for the
equal odds metric.
#define the new (fair) reject/accept indicator (rai.n)
[Link]$rai.n <- ifelse([Link]$mpred > [Link].n, 1, 0)
#re-run fairness validation for the new reject/accept indicator
[Link](db = [Link],
sensitive = "sensitive.2",
[Link] = "Creditability",
[Link] = "rai.n",
conditional = NULL,
[Link] = "disc",
[Link] = 0.05)$EO

## metric modality nobs statistic df [Link]

## 1 equal opportunity 0 700 2.281774 1 0.1309021
## 2 predictive equality 1 300 1.296591 1 0.2548369
## 3 equal odds overall 1000 3.578365 2 0.1670967
## res
## 1 H0: independence assumption cannot be rejected.
## 2 H0: independence assumption cannot be rejected.
## 3 H0: independence assumption cannot be rejected.

As observed, the new cutoff point ensures that the equal odds assumption is now satisfied, at least
for the significance level of 16.71%
For the second example, we use the same fairness metric (equal odds) and the protected attribute
(sensitive.2) but now analyze the average interest rate as a continuous model outcome. To
recapitulate exercise assumptions, we have five rating grades to which different interest rates are
assigned, and they range from 2% to 7%. For the sake of simplicity and execution time of fairness

216
post-processor, we run this exercise on the sample of the initial dataset ([Link]). The following
code node summarises these assumptions for the sample of 300 observations and provides testing
results for the equal odds metric.
#interest rate per rating grade
table([Link]$rating, [Link]$ir)

##
## 0.02 0.0325 0.045 0.0575 0.07
## 01 (-Inf,471.758) 28 0 0 0 0
## 02 [471.758,492.2173) 0 50 0 0 0
## 03 [492.2173,516.6698) 0 0 71 0 0
## 04 [516.6698,550.9402) 0 0 0 89 0
## 05 [550.9402,Inf) 0 0 0 0 62
#fairness validation of equal odds metric
[Link](db = [Link],
sensitive = "sensitive.2",
[Link] = "Creditability",
[Link] = "ir",
conditional = NULL,
[Link] = "cont",
[Link] = 0.05)$EO

## metric modality nobs statistic df [Link]

## 1 equal opportunity 0 209 5.283262 1 0.02153137
## 2 predictive equality 1 91 1.996470 1 0.15766608
## 3 equal odds overall 300 7.279731 2 0.02625587
## res
## 1 H0: average equality rejected.
## 2 H0: average equality cannot be rejected.
## 3 H0: average equality rejected.

For this concrete case, we will create the post-processor by defining the new interest rates that
minimize the difference between the observed p-value of the equal odds metric and the target p-value
plus an additional margin. We set the target p-value to 5% and introduce an additional margin of
3%. Adding the margin is voluntary, but it is recommended due to the variability of the validation
sample and application portfolio. Another condition added to the optimization procedure is the
monotonicity of the interest rates per rating grade. All constraints of this exercise are defined in
the helper function presented in the following code node.

217
#optimization function for adjusted interest rate
[Link] <- function(db, ir, margin = 0.03, [Link] = 0.05) {
db$ir <- ir[1:nrow(db)]
db$ir <- ave(x = db$ir, db$rating, FUN = mean)
ir.s <- tapply(X = db$ir,
INDEX = db$rating,
FUN = mean)
#monotonicity condition for interest rate
#has to be carefully investigated due to jumps in optimization function
if (any(diff(ir.s) < 0)) {
return(50)
}
fair.m <- [Link](db = db,
sensitive = "sensitive.2",
[Link] = "Creditability",
[Link] = "ir",
conditional = NULL,
[Link] = "cont",
[Link] = [Link])$EO
[Link] <- fair.m$[Link][fair.m$metric%in%"equal odds"]
[Link] <- ([Link] - ([Link] + margin))ˆ2
return([Link])
}

Now, we are ready to run the optimization procedure to determine the new interest rates that satisfy
the fairness constraints. Once the optimization is complete, we will re-run fairness validation to
assess whether the equal odds assumption is satisfied.
#optimize interest rate
#note that this procedure can take some time to execute
[Link] <- optim(par = [Link]$ir,
fn = [Link],
db = [Link],
lower = rep(0.02, nrow([Link])),
upper = rep(0.07, nrow([Link])),
method = "L-BFGS-B")
#assign the optimized interest rates to the dataset
[Link]$ir.o <- [Link]$par
#new interest rate summary per rating
ir.s <- tapply(X = [Link]$ir.o,

218
 INDEX = [Link]$rating,
FUN = mean)
#bring the optimized average interest rate to validation dataset
[Link]$ir.n <- ir.s[[Link]$rating]
#comparison between the initial and the new interest rates
#initial interest rate
ir.i <- tapply(X = [Link]$ir,
INDEX = [Link]$rating,
FUN = mean)
ir.i

## 01 (-Inf,471.758) 02 [471.758,492.2173) 03 [492.2173,516.6698)

## 0.0200 0.0325 0.0450
## 04 [516.6698,550.9402) 05 [550.9402,Inf)
## 0.0575 0.0700
#optimized interest rate
ir.s

## 01 (-Inf,471.758) 02 [471.758,492.2173) 03 [492.2173,516.6698)

## 0.02000006 0.03534646 0.04309444
## 04 [516.6698,550.9402) 05 [550.9402,Inf)
## 0.05701767 0.07000000
#re-run the fairness validation on the new interest rates
[Link](db = [Link],
sensitive = "sensitive.2",
[Link] = "Creditability",
[Link] = "ir.n",
conditional = NULL,
[Link] = "cont",
[Link] = 0.05)$EO

## metric modality nobs statistic df [Link]

## 1 equal opportunity 0 209 3.927657 1 0.04749808
## 2 predictive equality 1 91 1.123801 1 0.28910148
## 3 equal odds overall 300 5.051458 2 0.07999998
## res
## 1 H0: average equality rejected.
## 2 H0: average equality cannot be rejected.
## 3 H0: average equality cannot be rejected.

219
As we can see, the assumption of equal odds is satisfied with the adjusted interest rates for
the significance level of 8%. Additionally, the interest rates for the first (01 (-Inf,471.758))
and the last (05 [550.9402,Inf)) rating grades remained almost unchanged, while the most
significant adjustments are recorded for rating grades two (02 [471.758,492.2173)) and three
(03 [492.2173,516.6698)), and a slight adjustment is observed for rating grade four (04
[516.6698,550.9402)). In particular, rating grades three (03 [492.2173,516.6698)) and four
(04 [516.6698,550.9402)), experienced a decrease in interest rates.
To grasp the differences, let’s visually present the initial and optimized interest rates per rating:
plot(x = ir.i,
type = "l",
col = "red",
ylab = "Interest rate",
xlab = "",
xaxt = "n",
main = "Interest rate comparison")
axis(side = 1,
at = 1:length(ir.i),
labels = names(ir.i),
[Link] = 0.60)
lines(x = 1:length(ir.i),
y = ir.s,
col = "green")
legend(x = "topleft",
legend = c("Initial IR", "Optimized IR"),
fill = c("red", "green"))

220
 Interest rate comparison
0.07

Initial IR
Optimized IR
0.06
Interest rate

0.05
0.04
0.03
0.02

01 (−Inf,471.758) 02 [471.758,492.2173) 03 [492.2173,516.6698) 04 [516.6698,550.9402) 05 [550.9402,Inf)

The presented fairness processors are merely illustrative examples of possible solutions for addressing
the most common tasks encountered in practical scenarios. Still, we encourage readers, once again,
to pay greater attention to the design of the fairness validation process. This is especially important
because the selection of different fairness metrics, validation samples (size and structure), and
optimization constraints can significantly affect the final results and effectiveness of the selected
method.

221
9 Machine learning support for the ranking model development
The adoption of Machine Learning (ML) in credit risk modeling and management has significantly
increased in the last few years. The main benefits this brings to the banks include improved
model accuracy, overcoming data deficiencies and inconsistencies, and discovering new risk segments
or patterns. Whereas ML might help in estimating risk parameters more precisely, the increase
in predictive power comes at the cost of complexity, leading to a loss in explainability. Besides
methodological complexity, IT-infrastructure-related requirements present an additional layer of
complexity with adopting ML. Therefore, banks’ main challenge is finding the right balance between
the benefits and complexity of using ML for credit modeling. One option to address this challenge
is to design models that combine the best of both worlds - traditional methods and ML methods.
Due to the variety of options for using ML in PD modeling, this section is dedicated to a few case
studies that demonstrate possible areas and ways to combine traditional and ML methods. All case
studies focus on ML support for the ranking model development.

9.1 Case study 1: Machine learning for risk factor engineering

One of the ways to improve the predictive power of traditional models is through data pre-processing
and risk factor engineering, including exploring their interactions. This approach not only enhances
predictive power but also addresses issues related to non-linearity and the limited number of available
risk factors. Tree-based methods provide a straightforward means of deriving interactions between
risk factors. This case study demonstrates the extraction of interactions from decision trees and
random forests and how they are combined with the traditional logistic regression method.
Let’s begin with the interaction transformers from the decision tree. We will use the dataset loans
and the function [Link] from the PDtoolkit package for this exercise. First,
we load the data and then define the target variable and the risk factors.
data(loans)
target <- "Creditability"
rf <- names(loans)[!names(loans)%in%target]
rf

## [1] "Account Balance" "Duration of Credit (month)"

## [3] "Payment Status of Previous Credit" "Purpose"
## [5] "Credit Amount" "Value Savings/Stocks"
## [7] "Length of current employment" "Instalment per cent"
## [9] "Sex & Marital Status" "Guarantors"
## [11] "Duration in Current address" "Most valuable available asset"
## [13] "Age (years)" "Concurrent Credits"
## [15] "Type of apartment" "No of Credits at this Bank"
## [17] "Occupation" "No of dependents"

222
## [19] "Telephone" "Foreign Worker"

As observed, we have a total of 20 risk factors. To derive interactions between them, we begin by
creating all possible combinations of two out of the 20 risk factors. Subsequently, we run a decision
tree on each combination, using the target variable against the combination of risk factors, and
extract the new combined risk factor.
#risk factor combination matrix
[Link] <- 2
[Link] <- combn(x = rf, m = [Link])
#print the first 5 combinations
[Link][, 1:5]

## [,1] [,2]
## [1,] "Account Balance" "Account Balance"
## [2,] "Duration of Credit (month)" "Payment Status of Previous Credit"
## [,3] [,4] [,5]
## [1,] "Account Balance" "Account Balance" "Account Balance"
## [2,] "Purpose" "Credit Amount" "Value Savings/Stocks"
#derive interactions
[Link].l <- ncol([Link])
[Link] <- vector("list", [Link].l)
[Link] <- vector("list", [Link].l)
[Link] <- 2
for (i in 1:[Link].l) {
[Link].i <- [Link][, i]
rf.i <- paste0("rf.", i)
#interaction transformer
inter.i <- [Link](db = loans,
rf = [Link].i,
target = target,
[Link] = 0.05,
[Link] = 0.01,
[Link] = [Link],
monotonicity = TRUE,
[Link] = TRUE)
#result extraction
[Link].i <- inter.i[["[Link]"]]
[Link].i <- [Link]([Link] = rf.i, [Link].i)
[Link].i <- inter.i[["interaction"]]
names([Link].i) <- rf.i

223
 #result storing
[Link][[i]] <- [Link].i
[Link][[i]] <- [Link].i
}
[Link] <- bind_rows([Link])
[Link] <- bind_cols([Link])
#new risk factors
ncol([Link])

## [1] 190
#names of the risk factors
names([Link])[1:10]

## [1] "rf.1" "rf.2" "rf.3" "rf.4" "rf.5" "rf.6" "rf.7" "rf.8" "rf.9"
## [10] "rf.10"
#bind the target and the interaction data frame
[Link] <- [Link](loans[, target, drop = FALSE],
[Link])

In the code node above, we have generated 190 new risk factors. Instructions on how to derive these
new risk factors are stored in the data frame [Link]. Let’s take an example of the first risk
factor, rf.1, for which the following summary is provided:
[Link][[Link]$[Link]%in%"rf.1", ]

## [Link] node rf nobs

## 1 rf.1 1 <NA> 1000
## 2 rf.1 2 `Account Balance` 543
## 3 rf.1 3 `Account Balance` 457
## 4 rf.1 4 `Duration of Credit (month)` 306
## 5 rf.1 5 `Duration of Credit (month)` 237
## filter
## 1 <NA>
## 2 `Account Balance`%in%c('1', '2')
## 3 !`Account Balance`%in%c('1', '2')
## 4 `Account Balance`%in%c('1', '2') & `Duration of Credit (month)` < 24
## 5 `Account Balance`%in%c('1', '2') & `Duration of Credit (month)` >= 24
## terminal ind
## 1 parent NA
## 2 parent NA
## 3 leaf 1

224
## 4 leaf 2
## 5 leaf 3

The column filter contains instructions on creating this new risk factor, rf.1. We can observe that
rf.1 results from combining Account Balance and Duration of Credit (month), leading to three
possible modalities (column ind). The [Link] parameter in the [Link]
function controls the final number of modalities in the new risk factors. For our purposes in this
example and the subsequent one involving interactions from the random forest, we intentionally
set [Link] to 2, which ensures a high level of explainability for the new combined risk factors.
Additionally, the [Link] function offers the monotonicity argument, which we
set to TRUE. This is to address a common requirement in PD model development. When set to TRUE,
the function selects possible cutoff points that maintain the split’s monotonicity with the prevailing
trend between the risk factor and the target variable in the overall dataset. This condition applies
explicitly to numeric risk factors, while for categorical ones, the function tests the optimal binary
split by sorting the modalities of risk factors in alphabetical order. This approach assumes that
categorical risk factors were prepared with some prior expectation of the relationship between the
analyzed risk factor and the target variable before running the process.
During the execution of the [Link], it is possible to encounter interactions that
consist of only one risk factor. This occurs when the decision tree identifies an optimal split in both
iterations based solely on the same risk factor. An example of such an interaction is demonstrated
in the code node below for the interaction labeled as rf.4. In this case, the Credit Amount is not
utilized to derive a new risk factor, resulting in a single risk factor interaction.
#interaction info for "rf.4"
[Link][[Link]$[Link]%in%"rf.4", ]

## [Link] node rf nobs

## 16 rf.4 1 <NA> 1000
## 17 rf.4 2 `Account Balance` 543
## 18 rf.4 3 `Account Balance` 457
## 19 rf.4 4 `Account Balance` 274
## 20 rf.4 5 `Account Balance` 269
## filter terminal ind
## 16 <NA> parent NA
## 17 `Account Balance`%in%c('1', '2') parent NA
## 18 !`Account Balance`%in%c('1', '2') leaf 1
## 19 `Account Balance`%in%c('1', '2') & `Account Balance`%in%c('1') leaf 2
## 20 `Account Balance`%in%c('1', '2') & !`Account Balance`%in%c('1') leaf 3
#original risk factors used for derivation of "rf.4"
[Link][, 4, drop = FALSE]

225
## [,1]
## [1,] "Account Balance"
## [2,] "Credit Amount"

Optionally, we can exclude all interactions which do not combine both analyzed risk factors.
#check the risk factors used for interactions
[Link] <- [Link] %>%
group_by([Link]) %>%
summarise(rf.n = length(unique(rf[]))) %>%
[Link]()
head([Link])

## [Link] rf.n
## 1 rf.1 2
## 2 rf.10 1
## 3 rf.100 1
## 4 rf.101 2
## 5 rf.102 1
## 6 rf.103 1
#identify the interactions with only one risk factor
[Link].1 <- [Link]$[Link][[Link]$rf.n == 1]
#number of the interaction with only one risk factors
length([Link].1)

## [1] 100
#exclude the interaction with only one risk factor (optional step)
[Link] <- [Link][, names([Link])[!names([Link])%in%[Link].1]]

Out of the 190 interactions, we excluded 100 interactions that consisted of only one risk factor.
We are now ready to conduct stepwise regression on the remaining 90 interactions. To do so, we will
first apply WoE encoding and then employ the stepFWDr function from the PDtoolkit package.
#change the interaction type to the character
[Link][, -1] <- sapply(X = [Link][, -1], FUN = [Link])
#woe encoding
biv.a <- bivariate(db = [Link],
target = target)[["results"]]
rf.u <- unique(biv.a$rf)
[Link] <- [Link]
for (i in 1:length(rf.u)) {
rf.u.i <- rf.u[i]

226
 woe <- biv.a[biv.a$rf%in%rf.u.i , ]
mapping <- [Link]([Link] = woe$bin,
[Link] = woe$woe)
[Link][, rf.u.i] <- [Link](x = [Link][, rf.u.i],
mapping = mapping)
}

#run the stepwise regression

frm <- [Link](paste0(target, " ~ 1"))
res <- stepFWDr([Link] = frm,
[Link] = 0.05,
db = [Link])
#print the model summary
summary(res$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.8402996 0.0823108 -10.208862 0.000000000000000000000001809745
## rf.1 -0.3663660 0.1827629 -2.004597 0.045006144385433259624829105405
## rf.88 -0.9499396 0.1809381 -5.250080 0.000000152033067563663527943865
## rf.63 -1.1556517 0.2370634 -4.874863 0.000001088837445171980772848710
## rf.31 -0.7275060 0.2053280 -3.543140 0.000395392416619342809691595164
## rf.104 -0.6829338 0.1939344 -3.521468 0.000429164769132795700847665676
## rf.121 -1.3469827 0.3477284 -3.873663 0.000107211660730634295653380950
## rf.136 -2.2166511 0.6307330 -3.514405 0.000440740779594535315132064479
## rf.188 -2.3746919 0.7188462 -3.303477 0.000954937730436259324048875463
## rf.2 -0.5548659 0.1841686 -3.012815 0.002588363123825859063442678121
## rf.119 -0.8603841 0.3164504 -2.718859 0.006550750645252983138389080153
## rf.83 -0.5272509 0.2609422 -2.020566 0.043324756712446801931726270141
#auc
[Link](observed = res$[Link][, target],
predictions = predict(object = res$model))

## [1] 0.8114476

The results above show that the final model consists of 11 interactions with an AUC of 81.14%.
We can additionally inspect the original risk factors that constitute interactions selected in the final
model.
#original risk factors that appear in the final model
[Link] <- res$steps$rf

227
[Link] <- [Link]$rf[[Link]$[Link]%in%[Link]]
[Link] <- unique([Link][])
gsub(pattern = "`", replacement = "", x = [Link])

## [1] "Account Balance" "Duration of Credit (month)"

## [3] "Payment Status of Previous Credit" "Concurrent Credits"
## [5] "Purpose" "Age (years)"
## [7] "No of dependents" "Credit Amount"
## [9] "Value Savings/Stocks" "Sex & Marital Status"
## [11] "Most valuable available asset" "Length of current employment"
## [13] "Type of apartment" "Instalment per cent"
## [15] "Occupation" "Guarantors"
## [17] "Duration in Current address" "Telephone"

We see that 18 out of 20 risk factors are combined in the final model. To maintain the high
explainability of the model, we aim to understand the relationship between the original risk factors
and the model outcome. For that purpose, we use the idea of partial dependence to derive this
relationship. Before delving into the concrete code, let’s explain the central concept and crucial
steps of this task. Partial dependence represents the expected target response when considering
specific features of interest. In this case, we focus on understanding how PD changes based on
alterations of the original risk factors that constitute the derived interactions. To achieve this, we
simulate the average PD value by replacing the values of a standalone risk factor in the modeling
dataset with plausible values, one at a time. The approach for numeric and categorical risk factors
differs. For numeric risk factors, we simulate ten equidistant points and perform ten simulations,
replacing all existing values with one simulated value at a time. On the other hand, for categorical
risk factors, we replace all current values with the unique values of the analyzed risk factor, one at
a time, and evaluate the resulting PD values accordingly.
In the following code node, we demonstrate how to implement this in R, considering the specific
design of the model in use.
#helper functions
interactions <- function(db, [Link]) {
rf.u <- unique([Link]$[Link])
rf.l <- length(rf.u)
res <- vector("list", rf.l)
for (i in 1:rf.l) {
rf.u.i <- rf.u[i]
[Link].i <- [Link][[Link]$[Link]%in%rf.u.i, ]
inter.i <- PDtoolkit:::[Link](db = db,
[Link] = [Link].i)

228
 names(inter.i) <- rf.u.i
res[[i]] <- inter.i
}
res <- bind_cols(res)
res <- [Link](sapply(X = res, FUN = [Link]))
return(res)
}
[Link] <- function(db, tbl) {
for (i in 1:ncol(db)) {
rf.i <- names(db)[i]
mapping <- [Link]([Link] = tbl$bin[tbl$rf%in%rf.i],
[Link] = tbl$woe[tbl$rf%in%rf.i])
db[, rf.i] <- [Link](x = db[, rf.i],
mapping = mapping)
}
return(db)
}
#partial dependence
rf.l <- length([Link])
[Link] <- gsub(pattern = "`", replacement = "", x = [Link])
[Link] <- res$steps$rf
[Link] <- vector("list", rf.l)
for (i in 1:rf.l) {
#original risk factor
rf.i <- [Link][i]
#cleaned name
[Link].i <- [Link][i]
#check the risk factor type
[Link] <- ifelse([Link](loans[, [Link].i]), "num", "chr")
if ([Link]%in%"chr") {
mod.u <- sort(unique(loans[, [Link].i]))
} else {
[Link] <- min(loans[, [Link].i])
[Link] <- max(loans[, [Link].i])
mod.u <- seq(from = [Link], to = [Link], [Link] = 10)
mod.u <- round(mod.u, 0)
}
#extract the interactions which contain the analyzed risk factor
[Link].i <- unique([Link]$[Link][[Link]$rf%in%rf.i])

229
 [Link].i <- [Link][[Link]%in%[Link].i]
#simulate a risk factor modalities/cut points
[Link] <- loans
[Link].i <- [Link][[Link]$[Link]%in%[Link].i, ]
[Link] <- vector("list", length(mod.u))
for (j in 1:length(mod.u)) {
mod.u.i <- mod.u[j]
[Link][, [Link].i] <- mod.u.i
#create interactions on simulated db
inter.j <- interactions(db = [Link],
[Link] = [Link].i)
#woe encoding of the simulated interactions
[Link].j <- [Link](db = inter.j,
tbl = biv.a[biv.a$rf%in%[Link].i, ])
[Link] <- res$[Link]
[Link][, [Link].i] <- [Link].j
#model predictions on simulated db
[Link] <- predict(object = res$model,
newdata = [Link],
type = "response")
[Link][[j]] <- [Link](rf = [Link].i,
value = [Link](mod.u.i),
pd = mean([Link], [Link] = TRUE))
}
[Link] <- bind_rows([Link])
[Link][[i]] <- [Link]
}
[Link] <- bind_rows([Link])
head([Link], 20)

## rf value pd
## 1 Account Balance 1 0.4019044
## 2 Account Balance 2 0.4019044
## 3 Account Balance 3 0.1574311
## 4 Account Balance 4 0.1574311
## 5 Duration of Credit (month) 4 0.2631447
## 6 Duration of Credit (month) 12 0.2631447
## 7 Duration of Credit (month) 19 0.2631447
## 8 Duration of Credit (month) 27 0.2989442

230
## 9 Duration of Credit (month) 34 0.4143001
## 10 Duration of Credit (month) 42 0.4143001
## 11 Duration of Credit (month) 49 0.4143001
## 12 Duration of Credit (month) 57 0.4143001
## 13 Duration of Credit (month) 64 0.4143001
## 14 Duration of Credit (month) 72 0.4143001
## 15 Payment Status of Previous Credit 0 0.3621322
## 16 Payment Status of Previous Credit 1 0.3621322
## 17 Payment Status of Previous Credit 2 0.2908693
## 18 Payment Status of Previous Credit 3 0.2908693
## 19 Payment Status of Previous Credit 4 0.2908693
## 20 Concurrent Credits 1 0.3476540

As we wrap up this exercise, let’s visually present the relationship between the numeric risk factors
and the target.
[Link] <- c("Age (years)", "Credit Amount",
"Duration of Credit (month)")
layout(matrix(data = c(1,2,3,3),
nrow = 2,
ncol = 2,
byrow = TRUE))
for (i in 1:length([Link])) {
[Link].i <- [Link][i]
main.i <- paste0("Simulated average PD\n", [Link].i)
barplot(height = [Link]$pd[[Link]$rf%in%[Link].i],
[Link] = [Link]$value[[Link]$rf%in%[Link].i],
ylim = c(0, 0.40),
col = "red",
main = main.i,
xlab = "Simulated cut points",
ylab = "PD",
las = 2,
[Link] = 0.80)
}

231
 Simulated average PD Simulated average PD
Age (years) Credit Amount
0.4 0.4
0.3 0.3
PD

PD
0.2 0.2
0.1 0.1
0.0 0.0
19
25
31
38
44
50
56
63
69
75

250
2269
4289
6308
8327
10347
12366
14385
16405
18424
Simulated cut points Simulated cut points

Simulated average PD
Duration of Credit (month)
0.4
0.3
PD

0.2
0.1
0.0
4

12

19

27

34

42

49

57

64

72
Simulated cut points

To conclude, in this exercise, we first derived interactions between each combination of two risk
factors and then used them as new inputs for our stepwise regression. Additionally, to keep the
explainability of interactions at a high level, we decided to use a short-depth (two splits) decision
tree, along with a monotonicity condition in the splitting nodes. Finally, to inspect the relationship
between the original risk factors and the final model, we utilized the idea of a partial dependence
and derived the expected change of the model output for the change of modality of the original risk
factor.

When adopting this approach, it’s crucial to be mindful of the limitations of partial dependence.
Specifically, if the analyzed risk factors are correlated, the partial dependence function may generate
unrealistic data points. Although we typically strive to ensure that the final PD models do not
contain correlated risk factors, there is still a possibility of encountering implausible data points
during this process. To address this issue, a tailored partial dependence function can be created,
focusing on each risk factor individually. A straightforward way to achieve this is by running a
decision tree for one risk factor against the others and using the model’s estimations as probabilities
or ranges to derive the simulated values in partial dependence. Doing so can significantly reduce
the likelihood of obtaining unrealistic data points, making the partial dependence function more
reliable. We leave this exercise for the readers to perform by adjusting the provided codes accordingly.

As the second part of this case study, we repeat the same exercise but now use a random

232
forest instead of a decision tree to derive risk factor interactions. For this exercise, we use the
function [Link] from the PDtoolkit package and repeat very similar steps
as we did in the first part of the case study.
The full R implementation is available in the following code nodes, with a short description of each
step.
Step 1: Derive the 200 interactions from the random forest, limiting the tree depth to only two
splits and considering the monotonicity condition in the splitting node.
#risk factor list
[Link] <- names(loans)[!names(loans)%in%target]
#number of decision trees
[Link] <- 200
#max tree depth
[Link] <- 2
#extract interactions from random forest
[Link] <- [Link](db = loans,
rf = [Link],
target = target,
[Link] = NA,
[Link] = [Link],
[Link] = 0.05,
[Link] = 0.01,
[Link] = [Link],
monotonicity = TRUE,
[Link] = TRUE,
seed = 579)
names([Link])

## [1] "[Link]" "interaction"

#tree info
[Link] <- [Link][["[Link]"]]
#bind the target and the interaction data frame
[Link] <- [Link](loans[, target, drop = FALSE],
[Link][["interaction"]])
names([Link])[1:10]

## [1] "Creditability" "tree.1" "tree.2" "tree.3"

## [5] "tree.4" "tree.5" "tree.6" "tree.7"
## [9] "tree.8" "tree.9"

233
#check the risk factors used for interactions
[Link] <- [Link] %>%
group_by(tree) %>%
summarise(rf.n = length(unique(rf[]))) %>%
[Link]()
head([Link])

## tree rf.n
## 1 1 2
## 2 2 1
## 3 3 1
## 4 4 2
## 5 5 1
## 6 6 2

Step 2: Identify and exclude the interactions with only one risk factor.
#identify the interactions with only one risk factor
[Link].1 <- [Link]$tree[[Link]$rf.n == 1]
[Link].1 <- paste0("tree.", [Link].1)
#exclude the interaction with only one risk factor (optional step)
[Link] <- [Link][, names([Link])[!names([Link])%in%[Link].1]]
#change the interaction type to character
[Link][, -1] <- sapply(X = [Link][, -1], FUN = [Link])

Step 3: Perform WoE encoding on the remaining interactions and run the stepwise regression.
#woe encoding
biv.a <- bivariate(db = [Link],
target = target)[["results"]]
rf.u <- unique(biv.a$rf)
[Link] <- [Link]
for (i in 1:length(rf.u)) {
rf.u.i <- rf.u[i]
woe <- biv.a[biv.a$rf%in%rf.u.i , ]
mapping <- [Link]([Link] = woe$bin,
[Link] = woe$woe)
[Link][, rf.u.i] <- [Link](x = [Link][, rf.u.i],
mapping = mapping)
}
#run stepwise regression
frm <- [Link](paste0(target, " ~ 1"))

234
res <- stepFWDr([Link] = frm,
[Link] = 0.05,
db = [Link])
#print the model summary
summary(res$model)$coefficients

## Estimate Std. Error z value Pr(>|z|)

## (Intercept) -0.8615807 0.08477582 -10.163047 0.000000000000000000000002898716
## tree.120 -0.3477743 0.15081541 -2.305960 0.021112880114077553495022243624
## tree.25 -0.6291935 0.16168333 -3.891517 0.000099619228475185883035086798
## tree.138 -0.6166645 0.19950666 -3.090947 0.001995191593834879598828857539
## tree.126 -1.4841295 0.34681957 -4.279255 0.000018751974208793812834775161
## tree.195 -0.6634585 0.18066412 -3.672331 0.000240347884285453802441501203
## tree.81 -0.8096304 0.25582721 -3.164755 0.001552135499272621135813388094
## tree.178 -1.3014000 0.32693140 -3.980652 0.000068726646141908565479546056
## tree.7 -0.7113304 0.24120356 -2.949088 0.003187136105428271717204813385
## tree.16 -0.8093455 0.28172806 -2.872790 0.004068645985581315419055137284
## tree.133 -0.5022130 0.15692295 -3.200380 0.001372466344843502631875575837
## tree.33 -0.8262428 0.27566660 -2.997254 0.002724235475665420010832340481
## tree.105 -0.5071284 0.23397869 -2.167413 0.030203406273509186136250193044
## tree.35 -0.2876824 0.14276314 -2.015103 0.043893902826903891112308997435
#auc
[Link](observed = res$[Link][, target],
predictions = predict(object = res$model))

## [1] 0.8322905

Step 4: Identify the original risk factors that constitute interactions selected in the stepwise process.
#original risk factors that appear in the final model
[Link] <- [Link](gsub(pattern = "[ˆ0-9]",
replacement = "",
x = res$steps$rf))
[Link] <- [Link]$rf[[Link]$tree%in%[Link]]
[Link] <- unique([Link][])
gsub(pattern = "`", replacement = "", x = [Link])

## [1] "Most valuable available asset" "Type of apartment"

## [3] "Length of current employment" "Guarantors"
## [5] "Value Savings/Stocks" "Duration of Credit (month)"
## [7] "No of dependents" "Credit Amount"

235
## [9] "Account Balance" "Payment Status of Previous Credit"
## [11] "Sex & Marital Status" "Age (years)"
## [13] "Purpose" "Telephone"
## [15] "Instalment per cent" "Concurrent Credits"

Step 5: Estimate the relationship between the original risk factors and modeled target.
#relationship between original risk factor and model output
#helper function
[Link] <- function(db, [Link]) {
rf.u <- unique([Link]$tree)
rf.l <- length(rf.u)
res <- vector("list", rf.l)
for (i in 1:rf.l) {
rf.u.i <- rf.u[i]
[Link].i <- [Link][[Link]$tree%in%rf.u.i, ]
inter.i <- PDtoolkit:::[Link](db = db,
[Link] = [Link].i)
names(inter.i) <- paste0("tree.", rf.u.i)
res[[i]] <- inter.i
}
res <- bind_cols(res)
res <- [Link](sapply(X = res, FUN = [Link]))
return(res)
}
#partial dependence
rf.l <- length([Link])
[Link] <- gsub(pattern = "`", replacement = "", x = [Link])
[Link] <- res$steps$rf
[Link] <- vector("list", rf.l)
for (i in 1:rf.l) {
#original risk factor
rf.i <- [Link][i]
#cleaned name
[Link].i <- [Link][i]
#check the risk factor type
[Link] <- ifelse([Link](loans[, [Link].i]), "num", "chr")
if ([Link]%in%"chr") {
mod.u <- sort(unique(loans[, [Link].i]))
} else {

236
 [Link] <- min(loans[, [Link].i])
[Link] <- max(loans[, [Link].i])
mod.u <- seq(from = [Link], to = [Link], [Link] = 10)
mod.u <- round(mod.u, 0)
}
#extract the interactions which contain analyzed risk factor
[Link].i <- unique([Link]$tree[[Link]$rf%in%rf.i])
[Link].i <- [Link][[Link]%in%paste0("tree.", [Link].i)]
#simulate a risk factor modalities/cut points
[Link] <- loans
[Link].i <- [Link][paste0("tree.",
[Link]$tree)%in%[Link].i, ]
[Link] <- vector("list", length(mod.u))
for (j in 1:length(mod.u)) {
mod.u.i <- mod.u[j]
[Link][, [Link].i] <- mod.u.i
inter.j <- [Link](db = [Link],
[Link] = [Link].i)
[Link].j <- [Link](db = inter.j,
tbl = biv.a[biv.a$rf%in%[Link].i, ])
[Link] <- res$[Link]
[Link][, [Link].i] <- [Link].j
[Link] <- predict(object = res$model,
newdata = [Link],
type = "response")
[Link][[j]] <- [Link](rf = [Link].i,
value = [Link](mod.u.i),
pd = mean([Link], [Link] = TRUE))
}
[Link] <- bind_rows([Link])
[Link][[i]] <- [Link]
}
[Link] <- bind_rows([Link])
head([Link], 20)

## rf value pd
## 1 Most valuable available asset 1 0.2860162
## 2 Most valuable available asset 2 0.2860162
## 3 Most valuable available asset 3 0.2860162

237
## 4 Most valuable available asset 4 0.3646331
## 5 Type of apartment 1 0.3424852
## 6 Type of apartment 2 0.2892000
## 7 Type of apartment 3 0.2892000
## 8 Length of current employment 1 0.3230556
## 9 Length of current employment 2 0.3230556
## 10 Length of current employment 3 0.3230556
## 11 Length of current employment 4 0.2639795
## 12 Length of current employment 5 0.2639795
## 13 Guarantors 1 0.3098681
## 14 Guarantors 2 0.3098681
## 15 Guarantors 3 0.1501653
## 16 Value Savings/Stocks 1 0.3392293
## 17 Value Savings/Stocks 2 0.2636523
## 18 Value Savings/Stocks 3 0.2126744
## 19 Value Savings/Stocks 4 0.2126744
## 20 Value Savings/Stocks 5 0.2126744

As we can see with the random forest approach, we have a slight increase of AUC compared to the
decision tree approach, combining 16 instead of 18 original risk factors.
Readers are encouraged to experiment with the parameters of the [Link]
function, particularly with [Link], [Link], [Link], and monotonicity. The main goal of
this investigation is to find the optimal combination of original risk factors and achieve the best
model fit based on the desired metric.
Finally, we can compare the relationship between the original risk factors and the target variable in
the decision tree and random forest approach for interaction extraction.
#bring the results together into "[Link]" data frame
[Link] <- merge(x = [Link],
y = [Link],
by.x = c("rf", "value"),
by.y = c("rf", "value"),
all = TRUE,
suffixes = c(".dt", ".rf"))
[Link] <- [Link][order([Link]$rf, [Link]([Link]$value)), ]
#see difference in the risk factors
colSums([Link]([Link]))

## rf value [Link] [Link]

## 0 0 0 8

238
[Link][[Link]([Link]$[Link]), ]

## rf value [Link] [Link]

## 28 Duration in Current address 1 0.2682744 NA
## 29 Duration in Current address 2 0.3054192 NA
## 30 Duration in Current address 3 0.3054192 NA
## 31 Duration in Current address 4 0.3054192 NA
## 60 Occupation 1 0.2510887 NA
## 61 Occupation 2 0.2510887 NA
## 62 Occupation 3 0.3165598 NA
## 63 Occupation 4 0.3165598 NA
#comparison of the selected risk factors
[Link] <- c("Account Balance", "Duration of Credit (month)")
[Link][[Link]$rf%in%[Link], ]

## rf value [Link] [Link]

## 1 Account Balance 1 0.4019044 0.4269486
## 2 Account Balance 2 0.4019044 0.3517369
## 3 Account Balance 3 0.1574311 0.2157276
## 4 Account Balance 4 0.1574311 0.1542831
## 36 Duration of Credit (month) 4 0.2631447 0.1911857
## 32 Duration of Credit (month) 12 0.2631447 0.2820913
## 33 Duration of Credit (month) 19 0.2631447 0.3196254
## 34 Duration of Credit (month) 27 0.2989442 0.3196254
## 35 Duration of Credit (month) 34 0.4143001 0.3761975
## 37 Duration of Credit (month) 42 0.4143001 0.3761975
## 38 Duration of Credit (month) 49 0.4143001 0.3761975
## 39 Duration of Credit (month) 57 0.4143001 0.3761975
## 40 Duration of Credit (month) 64 0.4143001 0.3761975
## 41 Duration of Credit (month) 72 0.4143001 0.3761975
#visual comparison
layout(matrix(data = c(1:(length([Link]) * 2)),
nrow = length([Link]),
ncol = length([Link]),
byrow = TRUE))
for (i in 1:length([Link])) {
[Link].i <- [Link][i]
[Link] <- paste0("Decision tree - average PD\n", [Link].i)
[Link] <- paste0("Random forest - average PD\n", [Link].i)

239
[Link] <- [Link]$value[[Link]$rf%in%[Link].i]
#decision tree partial dependence
barplot(height = [Link]$[Link][[Link]$rf%in%[Link].i],
[Link] = [Link],
ylim = c(0, 0.50),
col = "red",
main = [Link],
xlab = "Simulated cut points",
ylab = "PD",
las = 2,
[Link] = 0.80)
#random forest partial dependence
barplot(height = [Link]$[Link][[Link]$rf%in%[Link].i],
[Link] = [Link],
ylim = c(0, 0.50),
col = "red",
main = [Link],
xlab = "Simulated cut points",
ylab = "PD",
las = 2,
[Link] = 0.80)
}

240
 Decision tree − average PD Random forest − average PD
Account Balance Account Balance
0.5 0.5
0.4 0.4
0.3 0.3
PD

PD
0.2 0.2
0.1 0.1
0.0 0.0
1

4
Simulated cut points Simulated cut points

Decision tree − average PD Random forest − average PD

Duration of Credit (month) Duration of Credit (month)
0.5 0.5
0.4 0.4
0.3 0.3
PD

0.2 PD 0.2
0.1 0.1
0.0 0.0
4
12
19
27
34
42
49
57
64
72

4
12
19
27
34
42
49
57
64
72
Simulated cut points Simulated cut points

Upon analyzing the risk factors Account Balance and Duration of Credit (month), we observe
a greater level of granularity in their effects on the model outcome when using the tested random
forest design compared to the decision tree design. This outcome is generally expected, particularly
for risk factors with high discriminatory power, since random forest fits decision trees on significantly
higher numbers of bootstrapped samples than just one sample as in the decision tree. Consequently,
this leads to higher predictive power in the random forest design compared to the decision tree.
However, it is essential to remember that these performance observations are based solely on the
training dataset. Additional testing on an out-of-sample dataset is necessary to determine which
method performs better.

9.2 Case study 2: Risk factor selection and non-linearity identification with
model challenger
In this case study, we build a model challenger to identify the most important risk factors and
possibly the non-linear relationship between analyzed numeric risk factors and the target variable.
Methods presented here are model agnostic; thus, the selection of the type of the challenger model is
entirely up to the readers, while we decided to use a customized decision tree algorithm implemented
in the [Link] function from the PDtoolkit package. The customization of this algorithm in
comparison to the standard decision tree models used for binary classification problems is mainly in
the splitting criterion and monotonicity condition. As a splitting criterion, this function implements

241
a test of two proportions; thus, additional tree pruning is unnecessary. The monotonicity condition
for numeric risk factors further supports identifying potential cutoff points at each splitting node
that must align with the prevailing trend from the overall dataset. Besides these customizations,
categorical risk factors are assumed to be sorted in alphabetical order and, as such, tested in the
splitting nodes. In addition, the function provides a simple interface to other adjustments such as
maximum tree depth, average value of target per leaf, and minimum percentage of observations per
leaf.
Let’s start by building a challenger model.
#challenger model - the customized decision tree
target <- "Creditability"
rf <- names(loans)[!names(loans)%in%target]
[Link] <- [Link](db = loans,
rf = rf,
target = target,
[Link] = 0.05,
[Link] = 0.01,
[Link] = 0.05,
[Link] = NA,
monotonicity = FALSE)
names([Link])

## [1] "inputs" "[Link]" "where" "average" "data"

[Link] <- [Link][["[Link]"]]
[Link][[Link]$terminal%in%"leaf",
c("rf", "filter", "ind")]

## rf
## 7 `Length of current employment`
## 11 `Value Savings/Stocks`
## 13 `Credit Amount`
## 14 `Age (years)`
## 15 `Age (years)`
## 17 `Payment Status of Previous Credit`
## 18 `Instalment per cent`
## 19 `Instalment per cent`
## 20 `Instalment per cent`
## 21 `Instalment per cent`
## 22 `Credit Amount`
## 23 `Credit Amount`

242
##
## 7
## 11
## 13 !`Ac
## 14 `Account Balance`%in%c('1
## 15 `Account Balance`%in%c('1'
## 17 `Account Balance`%in%c('1', '2') & `Duration of Credit (month)`
## 18 `Account Balance`%in%c('1', '2') &
## 19 `Account Balance`%in%c('1', '2') & `
## 20 !`Account Balance`%in%c('1', '2') & `Lengt
## 21 !`Account Balance`%in%c('1', '2') & `Length
## 22 `Account Balance`%in%c('1', '2') & `Duration of Credit (month)` < 24 & !`Most valuable a
## 23 `Account Balance`%in%c('1', '2') & `Duration of Credit (month)` < 24 & !`Most valuable av
## ind
## 7 1
## 11 2
## 13 3
## 14 4
## 15 5
## 17 6
## 18 7
## 19 8
## 20 9
## 21 10
## 22 11
## 23 12
#selected risk factors
[Link] <- unique([Link][["[Link]"]][, "rf"])
[Link] <- [Link][]
gsub(pattern = "`", replacement = "", x = [Link])

## [1] "Account Balance" "Duration of Credit (month)"

## [3] "Length of current employment" "Most valuable available asset"
## [5] "Value Savings/Stocks" "Credit Amount"
## [7] "Age (years)" "Payment Status of Previous Credit"
## [9] "Instalment per cent"
#predict method
head(predict(object = [Link]))

243
## where average
## 1 6 0.2295082
## 2 5 0.1090909
## 3 4 0.3278689
## 4 5 0.1090909
## 5 6 0.2295082
## 6 5 0.1090909
#auc
[Link] <- [Link](observed = loans[, target],
predictions = predict(object = [Link])[, "average"])
[Link]

## [1] 0.7875548

Once the model is built, we can identify the most relevant risk factors. For this exercise, we employ
permutation-based simulation and measure the decrease of AUC in comparison to the AUC of the
final model. Instead of AUC, we encourage readers to select any other performance metric and
adjust the code accordingly. As already mentioned, this approach is model agnostic, thus completely
independent of the selection of the challenger model.
#risk factor preparation
rf.m <- gsub(pattern = "`", replacement = "", x = [Link])
#simulation
rf.m.l <- length(rf.m)
[Link] <- vector("list", rf.m.l)
#number of the simulations per risk factor
N <- 100
#set seed
[Link](10)
for (i in 1:rf.m.l) {
rf.i <- rf.m[i]
[Link] <- rep(NA, N)
for (j in 1:N) {
#create simulation db
[Link] <- loans
#permute selected risk factor
[Link][, rf.i] <- sample(x = [Link][, rf.i])
#predict on simulated db
pred <- predict(object = [Link],
newdata = [Link])$average
#calculated simulated auc

244
 [Link] <- [Link](observed = [Link][, target],
predictions = pred)
}
#store the simulated results
[Link][[i]] <- [Link](rf = rf.i,
[Link] = mean([Link] - [Link]))
}
[Link] <- bind_rows([Link])
[Link][order([Link]$[Link]), ]

## rf [Link]
## 1 Account Balance -0.180400000
## 2 Duration of Credit (month) -0.046461905
## 3 Length of current employment -0.029311905
## 8 Payment Status of Previous Credit -0.024728571
## 4 Most valuable available asset -0.022150000
## 6 Credit Amount -0.020080952
## 5 Value Savings/Stocks -0.011030952
## 7 Age (years) -0.008080952
## 9 Instalment per cent -0.006207143

Based on the simulation results, we deduce that Account Balance and Duration of Credit
(month) are two of the most influential risk factors. Alongside these, seven other risk factors also
feature in the final challenger model. Together, these nine risk factors form a benchmark for selecting
the ultimate model created through traditional methods.
The second objective of the challenger model is to uncover any potential non-linear relationship
between numeric risk factors and the target variable. To achieve this, we once again employ the
concept of partial dependence. The R implementation for this purpose is provided in the following
code node.
rf.l <- length([Link])
[Link] <- gsub(pattern = "`", replacement = "", x = [Link])
[Link] <- vector("list", rf.l)
for (i in 1:rf.l) {
#original risk factor
rf.i <- [Link][i]
#cleaned name
[Link].i <- [Link][i]
#check the risk factor type
[Link] <- ifelse([Link](loans[, [Link].i]), "num", "chr")

245
 #define cutpoints depending on the risk factor type
if ([Link]%in%"chr") {
mod.u <- sort(unique(loans[, [Link].i]))
} else {
[Link] <- min(loans[, [Link].i])
[Link] <- max(loans[, [Link].i])
mod.u <- seq(from = [Link], to = [Link], [Link] = 10)
mod.u <- round(mod.u, 0)
}
#run the simulation on a risk factor modalities/cut points
[Link] <- loans
[Link] <- vector("list", length(mod.u))
for (j in 1:length(mod.u)) {
mod.u.i <- mod.u[j]
[Link][, [Link].i] <- mod.u.i
[Link] <- predict(object = [Link],
newdata = [Link])$average
[Link][[j]] <- [Link](rf = [Link].i,
value = [Link](mod.u.i),
pd = mean([Link], [Link] = TRUE))
}
#store the results
[Link] <- bind_rows([Link])
[Link][[i]] <- [Link]
}
[Link] <- bind_rows([Link])
[Link] <- c("Duration of Credit (month)", "Credit Amount",
"Age (years)")
[Link][[Link]$rf%in%[Link], ]

## rf value pd
## 5 Duration of Credit (month) 4 0.2479530
## 6 Duration of Credit (month) 12 0.2479530
## 7 Duration of Credit (month) 19 0.2479530
## 8 Duration of Credit (month) 27 0.3708711
## 9 Duration of Credit (month) 34 0.3708711
## 10 Duration of Credit (month) 42 0.3708711
## 11 Duration of Credit (month) 49 0.3708711
## 12 Duration of Credit (month) 57 0.3708711

246
## 13 Duration of Credit (month) 64 0.3708711
## 14 Duration of Credit (month) 72 0.3708711
## 29 Credit Amount 250 0.3038993
## 30 Credit Amount 2269 0.2724145
## 31 Credit Amount 4289 0.3253931
## 32 Credit Amount 6308 0.3253931
## 33 Credit Amount 8327 0.3253931
## 34 Credit Amount 10347 0.3253931
## 35 Credit Amount 12366 0.3253931
## 36 Credit Amount 14385 0.3253931
## 37 Credit Amount 16405 0.3253931
## 38 Credit Amount 18424 0.3253931
## 39 Age (years) 19 0.3120328
## 40 Age (years) 25 0.3120328
## 41 Age (years) 31 0.3120328
## 42 Age (years) 38 0.2866545
## 43 Age (years) 44 0.2866545
## 44 Age (years) 50 0.2866545
## 45 Age (years) 56 0.2866545
## 46 Age (years) 63 0.2866545
## 47 Age (years) 69 0.2866545
## 48 Age (years) 75 0.2866545

To facilitate a more accessible examination of the estimated relationship, let’s visually present the
effect.
layout(matrix(data = c(1,2,3,3),
nrow = 2,
ncol = 2,
byrow = TRUE))
for (i in 1:length([Link])) {
[Link].i <- [Link][i]
main.i <- paste0("Simulated average PD\n", [Link].i)
barplot(height = [Link]$pd[[Link]$rf%in%[Link].i],
[Link] = [Link]$value[[Link]$rf%in%[Link].i],
ylim = c(0.10, 0.40),
xpd = FALSE,
col = "red",
main = main.i,
xlab = "Simulated cut points",

247
 ylab = "PD",
las = 2,
[Link] = 0.80)
}

Simulated average PD Simulated average PD

Duration of Credit (month) Credit Amount
0.40 0.40
0.30 0.30
PD

PD
0.20 0.20
0.10 0.10
4
12
19
27
34
42
49
57
64
72

250
2269
4289
6308
8327
10347
12366
14385
16405
18424
Simulated cut points Simulated cut points

Simulated average PD
Age (years)
0.40
0.30
PD

0.20
0.10
19

25

31

38

44

50

56

63

69

75
Simulated cut points

The simulations suggest a possible U-shape relationship between Credit Amount and the target
variable. To formally test for U-shape and accordingly perform the binning, we can use the function
[Link] and [Link] as demonstrated in section U-shape binning.
For the other numeric risk factors, we noticed only one split each, specifically at 27 for Duration
of Credit (month) and 38 for Age (years). These points can be utilized as input for the binning
process in the traditional approach.

In summary, this case study using the challenger model aimed to achieve two main objec-
tives:

1. to identify significant risk factors that can serve as benchmarks for traditional methods;
2. to detect potential non-linear relationships between numeric risk factors and target variables;

Additionally, during the same analysis, we can identify critical cutpoints for numeric risk factors
with a monotonic trend, which can be used as input for the binning process.

248
9.3 Case study 3: Two-stage modeling approach
This case study aims to identify the segments on which the model performs poorly, i.e., over- or
under-estimates observed default rate. The starting assumption is that the first stage model is
developed using the traditional logistic regression method.
Let’s simulate the first stage model as follows:
#simulation of the traditional model
data(loans)
target <- "Creditability"
rf <- names(loans)[!names(loans)%in%target]
frm <- [Link](paste0(target, " ~ 1"))
res <- stepFWDr([Link] = frm,
[Link] = 0.05,
db = loans)
#print the model coefficients
summary(res$model)$coefficients

## Estimate Std. Error z value

## (Intercept) 0.309350061 0.510714268 0.60572042
## Account_Balance2 -0.566423709 0.190227251 -2.97761602
## Account_Balance3 -1.205152471 0.343530929 -3.50813382
## Account_Balance4 -1.950714449 0.209762019 -9.29965518
## Duration_of_Credit__month 0.035991508 0.006573616 5.47514566
## Payment_Status_of_Previous_Credit1 -0.017751218 0.486744616 -0.03646926
## Payment_Status_of_Previous_Credit2 -0.908628285 0.377677776 -2.40582937
## Payment_Status_of_Previous_Credit3 -0.940072229 0.440073744 -2.13616977
## Payment_Status_of_Previous_Credit4 -1.472715043 0.401956708 -3.66386482
## Guarantors2 0.570299658 0.380488628 1.49886124
## Guarantors3 -0.917025386 0.393243114 -2.33195536
## Foreign_Worker2 -1.348505220 0.592482512 -2.27602535
## Length_of_current_employment2 0.375963618 0.345582032 1.08791425
## Length_of_current_employment3 -0.009180829 0.326358992 -0.02813107
## Length_of_current_employment4 -0.602072607 0.361008070 -1.66775388
## Length_of_current_employment5 -0.206993037 0.338917075 -0.61074833
## Pr(>|z|)
## (Intercept) 0.54470042146294272988882312
## Account_Balance2 0.00290499669361344269036262
## Account_Balance3 0.00045126198935846098926963
## Account_Balance4 0.00000000000000000001409019
## Duration_of_Credit__month 0.00000004371518857696073222

249
## Payment_Status_of_Previous_Credit1 0.97090818570141390608796428
## Payment_Status_of_Previous_Credit2 0.01613579915771431311233286
## Payment_Status_of_Previous_Credit3 0.03266557849596266049907456
## Payment_Status_of_Previous_Credit4 0.00024843793297237292154109
## Guarantors2 0.13390963232311420272324654
## Guarantors3 0.01970303987922373059604730
## Foreign_Worker2 0.02284449213754234653261932
## Length_of_current_employment2 0.27663296375722579156786196
## Length_of_current_employment3 0.97755761094495319252217769
## Length_of_current_employment4 0.09536459560651047717705353
## Length_of_current_employment5 0.54136620696644022210364255
#add model prediction for modeling dataset
loans$pred <- predict(object = res$model,
type = "response")
#auc
[Link].1 <- [Link](observed = loans[, target],
predictions = loans$pred)
[Link].1

## [1] 0.7902905

Having obtained the initial stage model, we assume segment validation is conducted on the same
dataset. To carry out segment validation based on this assumption, we can utilize the [Link]
function from the PDtoolkit package.
#run the segment validation
[Link] <- [Link](model = res$model,
db = res$[Link],
[Link] = 0.03,
alpha = 0.05)
names([Link])

## [1] "[Link]" "[Link]" "[Link]"

#add the validation segments to modeling dataset
loans$segment <- [Link][["[Link]"]]$where
#get the segment testing results
[Link] <- [Link][["[Link]"]]
[Link]

## segment no [Link] [Link] [Link] [Link] [Link] [Link]

## 1 3 208 181 157.22094 27 50.77906 0.1298077 0.2441301

250
## 2 6 57 51 38.74623 6 18.25377 0.1052632 0.3202417
## 3 7 398 273 272.70775 125 125.29225 0.3140704 0.3148046
## 4 8 31 8 15.52013 23 15.47987 0.7419355 0.4993507
## 5 10 251 169 179.89445 82 71.10555 0.3266932 0.2832891
## 6 11 55 18 35.91050 37 19.08950 0.6727273 0.3470818
## [Link] [Link] alpha [Link]
## 1 0.1143223878 0.00000046536289 0.05 overestimate
## 2 0.2149784988 0.00000006160395 0.05 overestimate
## 3 0.0007342886 0.48741094723095 0.05 equal
## 4 -0.2425848334 0.00101188971566 0.05 underestimate
## 5 -0.0434041760 0.07129754599424 0.05 equal
## 6 -0.3256454538 0.00000013236130 0.05 underestimate

The analysis results suggest four identified segments for which the model in use underestimates or
overestimates the observed default rate.
To get these segments’ id, we can run the following command:
seg.s <- [Link]$segment[![Link]$[Link]%in%"equal"]
seg.s

## [1] 3 6 8 11

One approach to improve predictions of the first stage model is to correct them based on the average
values of under- or over-estimation for identified segments. These average values are reported in
the column [Link] of data frame [Link], and, essentially, they result from the second-stage
modeling on response residuals from the first-stage model. Concretely, function [Link]
employs the decision tree method from the rpart package on response residuals from the first stage
model to identify initial segments and additionally applies the test of two proportions to identify
segments on which the first stage model significantly under- or over-estimates observed default rate.
The choice of the second stage modeling method is not limited to the decision tree model, while it is
the only one currently implemented in the PDtoolkit package. If readers want to explore other ML
methods, they should first obtain the response residuals and then use them as the target variable
for the selected ML method. Additional steps of discretizing the prediction results and statistical
testing of the difference between model predictions and observed default rates are optional but
recommended to avoid altering all predictions from the first-stage model. A particular advantage
of using a decision tree, in this case, lies in the interpretability of the segments and operational
ease of implementation. Regardless of these advantages, other more advanced ML methods can be
implemented by designing the process accordingly.
Let’s correct the first-stage model predictions by the averages on the identified statistically significant
segments - seg.s.

251
loans <- merge(x = loans,
y = [Link][, c("segment", "[Link]")],
by = "segment",
all.x = TRUE)
#correct the first stage predictions by the averages (second stage)
loans$[Link] <- ifelse(loans$segment%in%seg.s,
loans$pred - loans$[Link],
loans$pred)
#correct the values lower than 0 and greater than 1
loans$[Link] <- ifelse(loans$[Link] < 0, 0,
ifelse(loans$[Link] > 1, 1, loans$[Link]))
summary(loans$[Link])

## Min. 1st Qu. Median Mean 3rd Qu. Max.

## 0.00000 0.07891 0.23043 0.29334 0.45825 1.00000
#auc after the second stage
[Link].2 <- [Link](observed = loans[, target],
predictions = loans$[Link])
[Link].2

## [1] 0.8274024
#compare with the auc from the first stage (the model in use)
[Link].2 - [Link].1

## [1] 0.0371119

Besides absolute response residuals, we encourage readers to investigate other options as the target
of the second stage modeling phase. One possibility is also to link the model performance with
non-conformity scores presented in Conformal inference.
Suppose the two-stage modeling approach is regarded as a means to enhance the performance of
the traditional model. In that case, we highly recommend conducting a comprehensive analysis
of the impact caused by the distribution change resulting from the second-stage modeling. The
implementations’ complexity should also be considered when deciding on ML methods and methods
for correcting predictions from the first stage. Lastly, considering various potential modifications to
this approach, exploring alternative options commonly employed, such as segmentation or analyzing
the bias caused by omitted risk factors, is advisable before deciding on the model design.

252
Appendix
A.1 Heterogeneity Euclidean Overlapping Metric:
v
um
uX
HEOM (x, y) =t da (xa , ya )2
a=1

with: 


 1, if x or y is unknown else
da (x, y) = overlap(x, y), if a is nominal else


 rn_dif f (x, y)
a

where: (
0, if x = y
overlap(x, y) =
1, oterwise
|x−y|
rn_dif fa (x, y) = rangea

The value rangea is used to normalize attribute and is defined as:

rangea = maxa − mina

where the maxa and mina are the maximum and minimum values, respectively, observed in the
modeling dataset for the attribute a.

A.2 Population stability index:

B
X
P SI = (pˆi − qˆi )(ln(pˆi ) − ln(qˆi ))
i=1

where:
pˆi is the relative frequency of the ith modality for the base year and
qˆi is the elative frequency of the ith modality for the target year.

A.3 Logistic function transformation:

1
LF (x) =
1+ eslope(midpoint−x)

with:
x5h + x95th
midpoint =
2
k
slope =
x95th − midpoint

253
where:
x5h is the value at the 5th percentile;
x95h is the value at the 95th percentile and
1
k is determined by solving the equation 1+e−k
= 0.95 (k = 2.94).

A.4 Weights of evidence:

[Link]
W oE = ln( )
dist.e
where:
[Link] is the percentage of non-events in a particular group and
dist.e is the percentage of events in a particular group.

A.5 Information value:

B
X
IV = ([Link] − dist.e) ∗ W oE
i=1

where:
[Link] is the percentage of non-events in a particular group;
dist.e is the percentage of events in a particular group;
W oE is the Weight of Evidence of a particular group and
B is the total number of groups.

A.6 Isotonic regression is non-decreasing distribution-free regression which fit is determined by

solving the following optimization problem:
X
minimize (yi − yˆi )
i

subject to:

yˆi ⩽ yˆj whenever Xi ≤ Xj

A.7 Test of two proportions:

pˆ1 − pˆ2
Z=q
pˆ1 n1 +pˆ2 n2 pˆ1 n1 +pˆ2 n2 1 1
n1 +n2 (1 − n1 +n2 )( n1 + n2 )

where:
pˆ1 is the proportion from the first sample;
pˆ1 is the proportion from the second sample;
n1 is the first sample size and
n2 is the second sample size.

254
Under the assumption that the Z test statistic follows the standard normal distribution, a p − value
is calculated accordingly.

A.8 Linear B-splines basis functions for a risk factor with values x and cut-off point kmid are
given by:
x − kmin kmax − x
BF1 = R1 + R2
kmid − kmin kmax − kmid
and
x − kmid
BF2 = R2
kmax − kmid
where:
kmin is the minimum value of the analyzed risk factor;
kmax is the maximum value of the analyzed risk factor;
R1 is the indicator which takes on value of 1 if the x is greater or equal to kmin and less than kmid ,
otherwise 0 and
R2 is the indicator which takes on value of 1 if the x is between kmid and kmax otherwise 0.

A.9 Clopper-Pearson upper confidence bound:

βcl (shape1 = x + 1, shape2 = n − x)

where:
β is the quantile function of beta distributions with parameters shape1 and shape2;
x is the number of defaults;
n is the number of observations and
cl is the selected confidence level.

A.10 Jeffreys’ upper confidence bound:

βcl (shape1 = x + 0.5, shape2 = n − x + 0.5)

where:
β is the quantile function of beta distributions with parameters shape1 and shape2;
x is the number of defaults;
n is the number of observations and
cl is the selected confidence level.

A.11 Herfindahl-Hirschman index:

N
X
HHI = Si2
i=1

255
where:
Si is the share of a particular group and
N is the total number of groups.

A.12 Exact binomial test:

!
n
P r(X ≥ d) = P Dd (1 − P D)n−d
d

where:
n is the number of observations;
d is the number of defaults and
P D is the calibrated PD.

A.13 Jeffreys test:

P r(X ≤ d) = β(q = P D, shape1 = d + 0.5, shape2 = n − d + 0.5)

where:
β is a value of beta distribution function for the quantile q with parameters shape1 and shape2;
P D is the calibrated PD;
n is the number of observations and
d is the number of defaults.

A.14 Score test:

ODR − P D
Zscore = q
P D(1−P D)
n

where:
ODR is the observed default rate;
P D is the calibrated PD and
n is the number of observations.
Under the assumption that the Zscore test statistic follows the standard normal distribution, a
p − value is calculated accordingly.

A.15 Hosmer-Lemeshow test:

G
X (Ng P Dg − dg )2
HL =
g=1
Ng P Dg (1 − P Dg )

where:
G is the number of rating grades;
Ng is the number of observations in the rating grade g;

256
P Dg is the calibrated PD for the rating grade g and
dg is the number of observed defaults in the rating grade g.
Under the assumption that the HL test statistic follows the chi-square distribution with G degrees
of freedom, a p − value is calculated accordingly.

A.16 Standard error of Area Under Curve (AUC):

s
AU C(1 − AU C) + (nb − 1)(Q1 − AU C 2 ) + (ng − 1)(Q2 − AU C 2 )
SEAU C =
nb ng

where:
AU C is the value of Area Under Curve;
nb is the number of bad cases (target indicator equal to 1);
AU C
Q1 is equal to 2−AU C ;
ng is the number of good cases (target indicator equal to 0) and
2AU C 2
Q2 is equal to 1+AU C .

Citing this book

Please follow the citation format provided below to cite this book for your references, research, or
academic work.
When citing within your text, use the author’s last name along with the publication year, like this:
(Djurovic, 2023).

In your bibliography or reference list, use the following citation style:

Djurovic, Andrija. (2023). Probability of Default Rating Modeling with R. \
[Link]

Or use the following BibTeX entry:

@book{djurovic,
title = {Probability of Default Rating Modeling with R},
author = {Andrija Djurovic},
publisher = {\url{[Link]
year = {2023},
subtitle = {Comprehensive overview of the modeling processes,
principles, and designs}
}

257
Bibliography
Allaire, JJ, Yihui Xie, Jonathan McPherson, Javier Luraschi, Kevin Ushey, Aron Atkins, Hadley
Wickham, Joe Cheng, Winston Chang, and Richard Iannone. 2021. Rmarkdown: Dynamic
Documents for r. [Link]

Anderson, Raymond A. 2022. Credit Intelligence and Modelling: Many Paths Through the Forest of
Credit Rating and Scoring. Oxford University Press.

Angelopoulos, Anastasios N, Stephen Bates, and others. 2023. “Conformal Prediction: A Gentle
Introduction.” Foundations and Trends® in Machine Learning 16 (4): 494–591.

Baesens, Bart, Veronique Van Vlasselaer, and Wouter Verbeke. 2015. Fraud Analytics Using
Descriptive, Predictive, and Social Network Techniques: A Guide to Data Science for Fraud
Detection. John Wiley & Sons.

Brunk, HD, Richard E Barlow, Daniel J Bartholomew, and James M Bremner. 1972. “Statisti-
cal Inference Under Order Restrictions (the Theory and Application of Isotonic Regression).”
Missouri Univ Columbia Dept of Statistics.

Chan, Chung-hong, Geoffrey CH Chan, Thomas J. Leeper, and Jason Becker. 2021. Rio: A
Swiss-Army Knife for Data File i/o.

Crone, Sven F, and Steven Finlay. 2012. “Instance Sampling in Credit Scoring: An Empirical Study
of Sample Size and Balancing.” International Journal of Forecasting 28 (1): 224–38.

Dash, Raj, Andreas Kremer, and Aleksander Petrov. 2021. “Designing Next Generation Credit
Decisioning Models.” McKinsey & Company.

De Boor, Carl. 1986. “B (Asic)-Spline Basics.” WISCONSIN UNIV-MADISON MATHEMATICS

RESEARCH CENTER.

Djurovic, Andrija. 2021a. Monobin: Monotonic Binning for Credit Rating Models. [Link]
om/andrija-djurovic/monobin.

———. 2021b. monobinShiny: Shiny User Interface for ’Monobin’ Package. [Link]
rija-djurovic/monobinShiny.

———. 2022. PDtoolkit: Collection of Tools for PD Rating Model Development and Validation.
[Link]

Dowle, Matt, and Arun Srinivasan. 2021. [Link]: Extension of ’[Link]’. [Link]
[Link]/package=[Link].

Dumitrescu, Elena, Sullivan Hué, Christophe Hurlin, and Sessi Tokpavi. 2022. “Machine Learning for
Credit Scoring: Improving Logistic Regression with Non-Linear Decision-Tree Effects.” European
Journal of Operational Research 297 (3): 1178–92.

258
(EBA), The European Banking Authority. 2018. “Guidelines on PD Estimation, LGD Estimation
and Treatment of Defaulted Assets.”

(ECB), European Central Bank. 2019. “Instructions for Reporting the Validation Results of Internal
Models.”

———. 2023. “ECB Guide to Internal Models.”

Gohel, David. 2023. Officer: Manipulation of Microsoft Word and PowerPoint Documents. https:
//[Link]/package=officer.

Hanley, James A, and Barbara J McNeil. 1982. “The Meaning and Use of the Area Under a Receiver
Operating Characteristic (ROC) Curve.” Radiology 143 (1): 29–36.

Harrell Jr, Frank E, with contributions from Charles Dupont, and many others. 2021. Hmisc:
Harrell Miscellaneous. [Link]

Hester, Jim, and Hadley Wickham. 2021. Odbc: Connect to ODBC Compatible Databases (Using
the DBI Interface). [Link]

Hurlin, Christophe, Christophe Pérignon, and Sébastien Saurin. 2022. “The Fairness of Credit
Scoring Models.” arXiv Preprint arXiv:2205.10200.

Manokhin, Valery. 2022. “Awesome Conformal Prediction.”

Mirai Solutions GmbH. 2021. XLConnect: Excel Connector for r. [Link]

ckage=XLConnect.

Molnar, Christoph. 2019. Interpretable Machine Learning: A Guide for Making Black Box Models
Explainable.

———. 2023. “Introduction to Conformal Prediction with Python: A Short Guide for Quantifying
Uncertainty of Machine Learning Models.”

Pluto, Katja, and Dirk Tasche. 2011. “Estimating Probabilities of Default for Low Default Portfolios.”
The Basel II Risk Parameters: Estimation, Validation, Stress Testing-with Applications to Loan
Risk Management, 75–101.

R Core Team. 2020. Foreign: Read Data Stored by ’Minitab’, ’s’, ’SAS’, ’SPSS’, ’Stata’, ’Systat’,
’Weka’, ’dBase’, ... [Link]

———. 2021. R: A Language and Environment for Statistical Computing. Vienna, Austria: R
Foundation for Statistical Computing. [Link]

R Special Interest Group on Databases (R-SIG-DB), Hadley Wickham, and Kirill Muller. 2021.
DBI: R Database Interface. [Link]

Ripley, Brian, and Michael Lapsley. 2020. RODBC: ODBC Database Access. [Link]
[Link]/package=RODBC.

259
Schauberger, Philipp, and Alexander Walker. 2021. Openxlsx: Read, Write and Edit Xlsx Files.
[Link]

Shotwell, Matt. 2014. Sas7bdat: SAS Database Reader (Experimental). [Link]

[Link]/package=sas7bdat.

Siddiqi, Naeem. 2017. Intelligent Credit Scoring: Building and Implementing Better Credit Risk
Scorecards. John Wiley & Sons.

Wickham, Hadley, and Jennifer Bryan. 2019. Readxl: Read Excel Files. [Link]
[Link]/package=readxl.

Wickham, Hadley, Romain Francois, Lionel Henry, and Kirill Muller. 2021. Dplyr: A Grammar of
Data Manipulation. [Link]

Wilson, D Randall, and Tony R Martinez. 1997. “Improved Heterogeneous Distance Functions.”
Journal of Artificial Intelligence Research 6: 1–34.

Yurdakul, Bilal. 2018. Statistical Properties of Population Stability Index. Western Michigan
University.

260