Company Bankruptcy

2023 — A model that predicts whether a company is about to go bankrupt

01 Problem

When a company goes bankrupt, its lenders, investors, and suppliers are the ones left holding the loss. A model that names the companies in trouble early gives them time to cut exposure, ask for collateral, or simply look closer before signing.

The goal is a classifier that flags likely bankruptcies from the financial ratios a company already reports, such as its returns, margins, debt, and cash flow.

02 Cleaning

The dataset holds 6,819 companies with no duplicated rows and no missing values. Two yes-or-no flags carry no signal. The net income flag is set for all 6,819 companies, and the liability flag for only 8. Both are removed, leaving 93 financial ratios.

companies <- read.csv('datasets/companies.csv')

companies <- companies %>%
  mutate_at(vars(Bankrupt., Liability.Assets.Flag, Net.Income.Flag), as.factor)

companies <- companies %>% select(-Net.Income.Flag, -Liability.Assets.Flag)

03 Imbalance

Only 3% of the companies went bankrupt. A model could score 97% accuracy by predicting that no company ever fails, which is why accuracy is not the metric that matters here.

Healthy 6,599 companiesBankrupt 220 companies

companies$Bankrupt. %>% table() %>% barplot()

04 Split

The companies are split 80/20, stratified by bankruptcy, into 5,456 for training and 1,363 for testing. The test set keeps the real rate, with 44 bankrupt companies.

Only after the split are the bankrupt companies in the training data upsampled, to 10,560 balanced rows. Upsampling first would copy the same companies into both sets, and the model would be graded on rows it has already memorized.

Healthy, before 5,280 companiesBankrupt, before 176 companiesHealthy, after 5,280 companiesBankrupt, after 5,280 companies

set.seed(1)

indices <- createDataPartition(y = companies$Bankrupt.,
                               p = 0.8,
                               list = FALSE)

train_data <- companies[indices, ]
test_data <- companies[-indices, ]

up_train <- upSample(x = train_data %>% select(-Bankrupt.),
                     y = train_data$Bankrupt.,
                     yname = "Bankrupt")

05 PCA

Many ratios measure the same thing in slightly different ways, and 28 of the 4,278 feature pairs correlate above 0.9. Principal component analysis folds them into uncorrelated components, and the first 49 of 93 hold 95% of the information.

The components are fitted on the training data only, and the test companies are projected onto them afterwards. Fitting on everything would let the test set shape the features the model is graded on.

correlations <- cor(companies %>% select(-Bankrupt.))
pair_correlations <- correlations[upper.tri(correlations)]

pca_train <- PCA(X = up_train,
                 scale.unit = T,
                 graph = F,
                 quali.sup = which(colnames(up_train) == "Bankrupt"),
                 ncp = ncol(up_train) - 1)

n_components <- which(pca_train$eig[, "cumulative percentage of variance"] >= 95)[1]

X_train <- as.data.frame(pca_train$ind$coord[, 1:n_components])
y_train <- up_train$Bankrupt

X_test <- as.data.frame(predict(pca_train, test_data %>% select(-Bankrupt.))$coord[, 1:n_components])
y_test <- test_data$Bankrupt.

pc_train <- X_train %>% mutate(Bankrupt = y_train)

06 Logistic regression

The first model is a logistic regression, and it never converges. Its deviance ends at 165,512, far worse than the 14,639 of a model that only knows the bankruptcy rate, so its scores cannot be trusted and it is set aside.

Bankruptcy rate only 14,639Logistic Regression 165,512

model_lgr <- glm(formula = Bankrupt ~ .,
                 family = "binomial",
                 data = pc_train)

07 KNN

K-nearest neighbours fits no coefficients, so it has nothing to diverge. Each test company is compared with its 103 closest training companies, the square root of the 10,560 upsampled training rows, and the share of those neighbours that went bankrupt is its risk.

set.seed(1)

pred_knn <- knn(train = X_train,
                test = X_test,
                cl = y_train,
                k = round(sqrt(nrow(X_train))),
                prob = TRUE)

08 Evaluation

The model catches 40 of the 44 bankruptcies in the test set, a sensitivity of 91%. Its accuracy of 80% sits below the 97% of predicting that nobody fails, because it raises 262 false alarms on healthy companies.

Only 13% of the companies it flags actually go bankrupt, and that is the right trade for a lender, because a second look at a healthy company costs far less than a bankruptcy nobody saw coming.

Actual Predicted HealthyBankrupt HealthyBankrupt

1,057

262

cm_knn <- confusionMatrix(pred_knn, y_test, positive = "1")

09 ROC

The AUC of 0.917 is the probability that the model ranks a random bankrupt company above a random healthy one. That ranking is what a credit team works from, because it lets them review the riskiest companies first and go down the list as far as the budget allows.

pred_knn_raw <- ifelse(pred_knn == "1", attr(pred_knn, "prob"), 1 - attr(pred_knn, "prob"))

roc_knn <- pROC::roc(response = y_test,
                     predictor = pred_knn_raw,
                     levels = c("0", "1"),
                     direction = "<")

pROC::auc(roc_knn)

Company Bankruptcy

Catches 91% of bankruptcies — AUC 0.92