2.1 Dataset preparation

Using the vanilla transaction dataset, we calculated several derived variables for each account.

First, we calculated an additional table with the current account balance and average account balance of each account.

Later on, we calculated another auxiliary table that contains the proportion of each kind of transaction (k_symbol) for each account. The idea of these variable is to capture the spend pattern of each client.

Finally, we combine the 682 Loan Contracts observations with client, district, credit card and the auxiliary tables we calculated early.

temp <- left_join(loan, disposition, by = c('account_id', 'type')) %>% 
  left_join(client, by = 'client_id') %>%
  left_join(district, by = 'district_id') %>% 
  left_join(creditcard, by = 'disp_id') %>% 
  left_join(account_balance, by = 'account_id') %>% 
  left_join(account_transaction_pattern, by = 'account_id') %>% 
  mutate(card_age_month = (issued %--% 
                             make_date(1998, 12, 31)) / months(1),
         last_transaction_age_days = ((last_transaction_date.y %--% 
                                         make_date(1998, 12, 31)) / days(1)),
         has_card = ifelse(type.y == 'no card', 0, 1)) %>% 
  dplyr::select(c("amount.x", "duration", "payments", "status", "defaulter", 
                  "contract_status", "gender", "age", "district_name", 
                  "region", "no_of_inhabitants", 
                  "no_of_municip_inhabitants_less_499", 
                  "no_of_municip_500_to_1999", "no_of_municip_2000_to_9999", 
                  "no_of_municip_greater_10000", "no_of_cities", 
                  "ratio_of_urban_inhabitants", 
                  "average_salary", "unemploymant_rate_1995", 
                  "unemploymant_rate_1996", 
                  "no_of_enterpreneurs_per_1000_inhabitants", 
                  "no_of_commited_crimes_1995", 
                  "no_of_commited_crimes_1996", "type.y", 
                  "card_age_month","account_balance", 
                  "avg_balance","transaction_count", "amount.y", 
                  "last_transaction_age_days", "prop_old_age_pension", 
                  "prop_insurance_payment", 
                  "prop_sanction_interest","prop_household", 
                  "prop_statement", "prop_interest_credited", 
                  "prop_loan_payment", "prop_other", "has_card"))

colnames(temp) <- c("x_loan_amount", "x_loan_duration", "x_loan_payments", 
                    "x_loan_status", "y_loan_defaulter", "x_loan_contract_status",
                    "x_client_gender", "x_client_age", 
                    "x_district_name", "x_region", 
                    "x_no_of_inhabitants", "x_no_of_municip_inhabitants_less_499", 
                    "x_no_of_municip_500_to_1999", "x_no_of_municip_2000_to_9999", 
                    "x_no_of_municip_greater_10000", "x_no_of_cities", 
                    "x_ratio_of_urban_inhabitants", 
                    "x_average_salary", "x_unemploymant_rate_1995", 
                    "x_unemploymant_rate_1996", 
                    "x_no_of_enterpreneurs_per_1000_inhabitants", 
                    "x_no_of_commited_crimes_1995", 
                    "x_no_of_commited_crimes_1996", "x_card_type", 
                    "x_card_age_month","x_account_balance", 
                    "x_avg_account_balance","x_transaction_count", 
                    "x_transaction_amount", "x_last_transaction_age_days", 
                    "x_prop_old_age_pension", "x_prop_insurance_payment", 
                    "x_prop_sanction_interest","x_prop_household","x_prop_statement",
                    "x_prop_interest_credited", "x_prop_loan_payment", "x_prop_other",
                    "x_has_card")

temp <- dplyr::select(temp, y_loan_defaulter, everything())

temp$x_card_type = ifelse(is.na(temp$x_card_type), 'no card', 
                          as.character(temp$x_card_type))

temp$x_has_card = ifelse(temp$x_card_type == 'no card', 0, 1)

temp$x_card_age_month = ifelse(is.na(temp$x_card_age_month), 0, 
                               temp$x_card_age_month)

temp$y_loan_defaulter = as.numeric(temp$y_loan_defaulter)

We ended up having a data set with 39 variables.

2.2 Variable selection

From this dataset, we excluded 6 variables that are redundant, shows no variability on the 682 Loan contract observations or have no applicability for the exercise:

• x_prop_old_age_pension (no variation on selected sample);
• x_district_name (sample have not enough variability to fit a model);
• x_region (sample have not enough variability to fit a model);
• x_loan_status (redundant);
• x_loan_contract_status (redundant);
• x_prop_sanction_interest (seems not to be valid for this analysis, as the reason for interest payment in the account is exactly the delinquency in the observation contact itself).

temp <- dplyr::select(temp, -c(x_prop_old_age_pension, 
                               x_district_name, 
                               x_region, 
                               x_loan_status, 
                               x_loan_contract_status, 
                               x_prop_sanction_interest))

2.3 Investigating Multicollinearity

With the remaining variables we ran a multicollinearity test to identify additional variables to drop from the model specification.

vars.quant <- select_if(temp, is.numeric)
VIF <- imcdiag(vars.quant, temp$y_loan_defaulter)

VIF_Table_Before <- tibble(variable = names(VIF$idiags[,1]),
                    VIF = VIF$idiags[,1]) %>% 
             arrange(desc(VIF))

kable(VIF_Table_Before)

ggplot(VIF_Table_Before, aes(x = fct_reorder(variable, VIF), y = log(VIF), label = round(VIF, 2))) + 
  geom_point(stat='identity', fill="black", size=15)  +
  geom_segment(aes(y = 0, 
                   yend = log(VIF), 
                   xend = variable), 
               color = "black") +
  geom_text(color="white", size=4) +
  geom_hline(aes(yintercept = log(5)), color = 'red', size = 2) +
  scale_y_continuous(labels = NULL, breaks = NULL) +
  coord_flip() +
  theme_economist() +
  theme(legend.position = 'none', 
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank()) +
  labs(x = 'Variable',
       y = NULL,
       title = 'Variance Inflation Factor',
       subtitle="Checking for multicolinearity in X's variables.
       Variables with VIF more than 5 will 
       be droped from the model")

We decided to exclude any variable with a VIF greater than 5.

Below variables were excluded based on the multicollinear presence on them.

• x_prop_insurance_payment;
• x_prop_household;
• x_prop_statement ;
• x_prop_loan_payment;
• x_prop_other;
• x_no_of_inhabitants;
• x_no_of_commited_crimes_1996;
• x_transaction_amount;
• x_transaction_count;
• x_unemploymant_rate_1996;
• x_unemploymant_rate_1995;
• x_average_salary;
• x_no_of_cities.

temp <- dplyr::select(temp, -c(x_prop_insurance_payment,
                               x_prop_household,
                               x_prop_statement,
                               x_prop_loan_payment,
                               x_prop_other,
                               x_no_of_inhabitants,
                               x_no_of_commited_crimes_1996,
                               x_transaction_amount,
                               x_transaction_count,
                               x_unemploymant_rate_1996,
                               x_unemploymant_rate_1995,
                               x_average_salary,
                               x_no_of_cities))

loan_reg_dataset <- temp

Here is the final correlation matrix we got:

Plot of VIF values:

ggplot(VIF_Table_After, aes(x = fct_reorder(variable, VIF), y = log(VIF), label = round(VIF, 2))) + 
  geom_point(stat='identity', fill="black", size=15)  +
  geom_segment(aes(y = 0, 
                   yend = log(VIF), 
                   xend = variable), 
               color = "black") +
  geom_text(color="white", size=4) +
  geom_hline(aes(yintercept = log(5)), color = 'red', size = 2) +
  scale_y_continuous(labels = NULL, breaks = NULL) +
  coord_flip() +
  theme_economist() +
  theme(legend.position = 'none', 
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank()) +
  labs(x = 'Variable',
       y = NULL,
       title = 'Variance Inflation Factor',
       subtitle="Checking for multicolinearity in X's variables.
       Variables with VIF more than 5 will 
       be droped from the model")

Correlation Matrix Plot: no Variable with correlation more than 0.6.

cor_mtx <- cor(vars.quant)

ggcorrplot(cor_mtx, hc.order = TRUE, 
           type = "lower", 
           lab = TRUE, 
           lab_size = 3, 
           method="circle", 
           colors = c("tomato2", "white", "springgreen3"), 
           title="Correlation Matrix of Loan Dataset", 
           ggtheme=theme_bw)

2.4 Sample split into Test and Training Data

The available data in Loan Dataset is split into Train and Testing data on the following proportion:

• Train Dataset (70% 478 obs);
• Test Dataset (30% 204 obs).

set.seed(12345)
index <- caret::createDataPartition(loan_reg_dataset$y_loan_defaulter, 
                                    p= 0.7,list = FALSE)

data.train <- loan_reg_dataset[index, ]
data.test  <- loan_reg_dataset[-index,]


event_proportion <- bind_rows(prop.table(table(loan_reg_dataset$y_loan_defaulter)),
                              prop.table(table(data.train$y_loan_defaulter)),
                              prop.table(table(data.test$y_loan_defaulter)))

event_proportion$scope = ''
event_proportion$scope[1] = 'full dataset'
event_proportion$scope[2] = 'train dataset'
event_proportion$scope[3] = 'test dataset'

event_proportion <- select(event_proportion, scope, everything())

kable(event_proportion)

Both datasets keep the same proportion for the explained variable around 11%.

2.5 Fit the logistic model

With the final cleaned dataset, we got from above steps we fit our Logistic Regression Y_loan_defaulter on all x variables.

model_1 <- glm(data = data.train, formula = y_loan_defaulter ~ .,
                 family= binomial(link='logit'))

# jut truncating variable names to 30 char to fit nicely in the screen.
names(model_1$coefficients) <- stringr::str_sub(names(model_1$coefficients), 1, 30)

summary(model_1)

## 
## Call:
## glm(formula = y_loan_defaulter ~ ., family = binomial(link = "logit"), 
##     data = data.train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5308  -0.4369  -0.2692  -0.1609   2.9273  
## 
## Coefficients: (1 not defined because of singularities)
##                                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                    -4.405e+00  2.351e+00  -1.874   0.0610 .  
## x_loan_amount                   7.239e-06  2.978e-06   2.431   0.0151 *  
## x_loan_duration                -2.860e-02  1.867e-02  -1.532   0.1255    
## x_loan_payments                 2.306e-03  1.839e-03   1.254   0.2099    
## x_client_gendermale             2.084e-02  3.594e-01   0.058   0.9537    
## x_client_age                    1.801e-02  1.414e-02   1.274   0.2028    
## x_no_of_municip_inhabitants_le -1.823e-03  6.599e-03  -0.276   0.7824    
## x_no_of_municip_500_to_1999     8.119e-04  1.957e-02   0.041   0.9669    
## x_no_of_municip_2000_to_9999   -1.178e-02  6.436e-02  -0.183   0.8547    
## x_no_of_municip_greater_10000  -3.642e-01  2.321e-01  -1.569   0.1167    
## x_ratio_of_urban_inhabitants    9.512e-03  1.150e-02   0.827   0.4080    
## x_no_of_enterpreneurs_per_1000 -1.078e-02  1.162e-02  -0.927   0.3538    
## x_no_of_commited_crimes_1995   -1.362e-02  9.617e-03  -1.416   0.1566    
## x_card_typegold                 5.329e-01  1.315e+00   0.405   0.6852    
## x_card_typejunior               3.728e-01  1.311e+00   0.284   0.7762    
## x_card_typeno card              1.580e+00  8.938e-01   1.768   0.0770 .  
## x_card_age_month                2.938e-02  3.072e-02   0.956   0.3390    
## x_account_balance               2.386e-06  1.383e-06   1.725   0.0844 .  
## x_avg_account_balance          -4.174e-06  2.969e-06  -1.406   0.1598    
## x_last_transaction_age_days     2.641e-02  4.276e-02   0.618   0.5368    
## x_prop_interest_credited        1.156e+01  2.241e+00   5.158  2.5e-07 ***
## x_has_card                             NA         NA      NA       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 324.61  on 477  degrees of freedom
## Residual deviance: 246.59  on 457  degrees of freedom
## AIC: 288.59
## 
## Number of Fisher Scoring iterations: 6

Alternatively we fit a second model only with variables statistically significant p-value less than 10%.

model_2 <- glm(data = data.train, formula = y_loan_defaulter ~ x_loan_amount +
                 x_loan_duration + x_has_card + x_prop_interest_credited,
                 family= binomial(link='logit'))

# jut truncating variable names to 30 char to fit nicely in the screen.
names(model_2$coefficients) <- stringr::str_sub(names(model_2$coefficients), 1, 30)

summary(model_2)

## 
## Call:
## glm(formula = y_loan_defaulter ~ x_loan_amount + x_loan_duration + 
##     x_has_card + x_prop_interest_credited, family = binomial(link = "logit"), 
##     data = data.train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5790  -0.4375  -0.3290  -0.2165   2.6686  
## 
## Coefficients:
##                            Estimate Std. Error z value Pr(>|z|)    
## (Intercept)              -3.632e+00  4.984e-01  -7.286 3.19e-13 ***
## x_loan_amount             9.023e-06  1.888e-06   4.780 1.75e-06 ***
## x_loan_duration          -3.864e-02  1.458e-02  -2.651  0.00803 ** 
## x_has_card               -1.064e+00  5.009e-01  -2.124  0.03364 *  
## x_prop_interest_credited  9.715e+00  1.750e+00   5.551 2.85e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 324.61  on 477  degrees of freedom
## Residual deviance: 264.00  on 473  degrees of freedom
## AIC: 274
## 
## Number of Fisher Scoring iterations: 6

In the next step we will compare how each model performed.