Before getting into any sophisticated analysis, the first step is to do an EDA and data cleaning. Since both categorical and continuous variables are included in the data set, appropriate tables and summary statistics are provided.

  Sample R code for creating marginal proportional tables

margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),1)
margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),2)
margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),3)
margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),4)
margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),5)
margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),6)
margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),7)
margin.table(prop.table(table(Duration.in.Current.address, Most.valuable.available.asset, Concurrent.Credits,No.of.Credits.at.this.Bank,Occupation,No.of.dependents,Telephone, Foreign.Worker)),8)

Proportions of applicants belonging to each classification of a categorical variable are shown in the following table (below). The pink shadings indicate that these levels have too few observations and the levels are merged for final analysis.

Since most of the predictors are categorical with several levels, the full cross-classification of all variables will lead to zero observations in many cells. Hence we need to reduce the table size. For details of variable names and classification see Appendix 1.

Depending on the cell proportions given in the one-way table above two or more cells are merged for several categorical predictors. We present below the final classification for the predictors that may potentially have any influence on Creditability

• Account Balance: No account (1), None (No balance) (2), Some Balance (3)
• Payment Status: Some Problems (1), Paid Up (2), No Problems (in this bank) (3)
• Savings/Stock Value: None, Below 100 DM, [100, 1000] DM, Above 1000 DM
• Employment Length: Below 1 year (including unemployed), [1, 4), [4, 7), Above 7
• Sex/Marital Status: Male Divorced/Single, Male Married/Widowed, Female
• No of Credits at this bank: 1, More than 1
• Guarantor: None, Yes
• Concurrent Credits: Other Banks or Dept Stores, None
• ForeignWorker variable may be dropped from the study
• Purpose of Credit: New car, Used car, Home Related, Other

Cross-tabulation of the 9 predictors as defined above with Creditability is shown below. The proportions shown in the cells are column proportions and so are the marginal proportions. For example, 30% of 1000 applicants have no account and another 30% have no balance while 40% have some balance in their account. Among those who have no account 135 are found to be Creditable and 139 are found to be Non-Creditable. In the group with no balance in their account, 40% were found to be on-Creditable whereas in the group having some balance only 1% are found to be Non-Creditable.

  Sample R code for creating K1 x K2 contingency table.

CrossTable(Creditability, Account.Balance, digits=1, prop.r=F, prop.t=F, prop.chisq=F, chisq=T)
CrossTable(Creditability, Payment.Status.of.Previous.Credit, digits=1, prop.r=F, prop.t=F, prop.chisq=F, chisq=T)
CrossTable(Creditability, Purpose, digits=1, prop.r=F, prop.t=F, prop.chisq=F, chisq=T)

Summary for the continuous variables:

  Sample R code for Descriptive Statistics.

attach(German.Credit) # If the data frame is attached then the column names may be directly called
summry(Duration.of.Credit.Month) # Summary statistics are printed for this variable
brksCredit <- seq(0, 80, 10) # Bins for a nice looking histogram
hist(Duration.of.Credit.Month., breaks=brksCredit, xlab = "Credit Month", ylab = "Frequency", main = " ", cex=0.4) # produces nice looking histogram
boxplot(Duration.of.Credit.Month., bty="n",xlab = "Credit Month", cex=0.4) # For boxplot

Distribution of the continuous variables:

All the three variables show marked positive skewness. Boxplots bear this out even more clearly.

In preparation of predictors to use in building a logistic regression model, we consider bivariate association of the response (Creditability) with the categorical predictors.

Since the number of predictors in this problem is not very high, it is possible to look into the dependency of the response (Creditability) on each of them individually. The following table summarizes the chi-square p-values for each contingency table. Note that among the sample of size 1000, 700 were Creditable and 300 Non-Creditable. This classification is based on the Bank’s opinion on the actual applicants.

Only significant predictors are to be included in the logistic regression model. Since there are 1000 observations 50:50 cross-validation scheme is tried:

Model Building with 50:50 Cross-validation

  Sample R code for 50:50 cross-validation data creation

indexes = sample(1:nrow(German.Credit), size=0.5*nrow(German.Credit)) # Random sample of 50% of row numbers created
Train50 <- German.Credit[indexes,] # Training data contains created indices
Test50 <- German.Credit[-indexes,] # Test data contains the rest
# Using any proportion, other than 0.5 above and size Training and Test data can be constructed

1000 observations are randomly partitioned into two equal sized subsets – Training and Test data. A logistic model is fit to the Training set.

Results are given below, shaded rows indicate variables not significant at 10% level.

  Sample R code for Logistic Model building with Training data and assessing for Test data

LogisticModel50 <- glm(Creditability ~ Account.Balance + Payment.Status.of.Previous.Credit + Purpose + Value.Savings.Stocks + Length.of.current.employment + Sex...Marital.Status + Most.valuable.available.asset + Type.of.apartment + Concurrent.Credits + Duration.of.Credit..month.+ Credit.Amount + Age..years., family=binomial, data = Train50)
LogisticModel50final <- glm(Creditability ~ Account.Balance + Payment.Status.of.Previous.Credit + Purpose + Length.of.current.employment + Sex...Marital.Status, family=binomial, data = Train50)
fit50 <- fitted.values(LogisticModel50S1)
Threshold50 <- rep(0,500)
for (i in 1:500)
if(fit50[i] >= 0.5) Threshold50[i] <- 1
CrossTable(Train50$Creditability, Threshold50, digits=1, prop.r=F, prop.t=F, prop.chisq=F, chisq=F, data=Train50)
perf <- performance(pred, "tpr", "fpr")
plot(perf)

R output:

Null deviance: 598.536 on 499 degrees of freedom
Residual deviance: 464.01 on 477 degrees of freedom
AIC: 510.01

 Removing the nonsignificant variables a second logistic regression is fit to the data.

R output:

Null deviance: 598.53 on 499 degrees of freedom
Residual deviance: 472.12 on 483 degrees of freedom
AIC: 506.12

Need to remove another variable to come up with a model where all predictors are significant at 10% level.

R output:

Null deviance: 598.53 on 499 degrees of freedom
Residual deviance: 474.67 on 484 degrees of freedom
AIC: 506.67

 This model is recommended as the final model based on the Training Data. Final performance of a model is evaluated by considering the classification power. Following are a few tables defined at different thresholds of classification.

The following figure shows the performance of the classifier through ROC curve.

For discriminant analysis all the predictors are not used. Only the continuous variables and the ordinal variables are used as for the nominal variables there will be no concept of group means and linear discriminants will be difficult to interpret. The predictors are assumed to have a multivariate normal distribution.

  Sample R code for Discriminant Analysis

library(MASS)
ldafit <- lda(Creditability ~ Value.Savings.Stocks + Length.of.current.employment + Duration.of.Credit..month.+ Credit.Amount + Age..years., data = Train50)
ldafit
plot(ldafit)
lda.pred <- predict(ldafit, data=Test50)
ldaclass <- lda.pred$class
table(ldaclass, Test50$Creditability)
qdafit <- qda(Creditability ~ Value.Savings.Stocks + Length.of.current.employment + Duration.of.Credit..month.+ Credit.Amount + Age..years., data = Train50)
qdafit
qda.pred <- predict(qdafit, data=Test50)
qdaclass <- qda.pred$class
table(qdaclass, Test50$Creditability)

Prior probability was taken as observed in the Training sample:

71.4% Creditable and 28.6% Non-creditable

Linear Discriminant Analysis

Quadratic Discriminant Analysis

Neither logistic regression nor discriminant analysis is performing well for this data. The reason DA may not do well is that, most of the predictors are categorical and nominal predictors are not used in this analysis.

  Sample R code for Tree method

library(tree)
Train50_tree <- tree(Creditability ~ Account.Balance+Duration.of.Credit..month.+Payment.Status.of.Previous.Credit+Purpose+Credit.Amount+Value.Savings.Stocks+Length.of.current.employment+Instalment.per.cent+Sex...Marital.Status+Guarantors+Duration.in.Current.address+Most.valuable.available.asset+Age..years.+Concurrent.Credits+Type.of.apartment+No.of.Credits.at.this.Bank+Occupation+No.of.dependents+Telephone, data=Train50, method="class")
summary(Train50_tree)
plot(Train50_tree)
text(Train50_tree, pretty=0,cex=0.6)
Test50_pred <- predict(Train50_tree, Test50, type="class")
table(Test50_pred, Test50$Creditability)
Train50_prune8 <- prune.misclass(Train50_tree, best=8)
Test50_prune8_pred <- predict(Train50_prune8, Test50, type="class")
table(Test50_prune8_pred, Test50$Creditability))

Both categorical and continuous predictors are used for binary classification. Using rpart{library=rpart}, the following tree is obtained without any pruning.

R output:

Applying the procedure on Test data, classification probability shows improvement.

The CP table is as follows:

Following is the result for pruning the above tree for cross-validated classification error rate 90%.

n= 500

node), split, n, loss, yval, (yprob)
  * denotes terminal node

1) root 500 143 1 (0.2860000 0.7140000)
2) Account.Balance=1,2 261 110 1 (0.4214559 0.5785441)
4) Duration.of.Credit..month.>=13 165 79 0 (0.5212121 0.4787879)
8) Value.Savings.Stocks< 1.5 111 43 0 (0.6126126 0.3873874)
16) Purpose=4 45 9 0 (0.8000000 0.2000000)
32) Duration.in.Current.address>=1.5 38 4 0 (0.8947368 0.1052632) *
33) Duration.in.Current.address< 1.5 7 2 1 (0.2857143 0.7142857) *
17) Purpose=1,2,3 66 32 1 (0.4848485 0.5151515)
34) Duration.of.Credit..month.>=33 26 7 0 (0.7307692 0.2692308) *
35) Duration.of.Credit..month.< 33 40 13 1 (0.3250000 0.6750000) *
9) Value.Savings.Stocks>=1.5 54 18 1 (0.3333333 0.6666667)
18) Length.of.current.employment< 2.5 32 15 1 (0.4687500 0.5312500)
36) Type.of.apartment=1 10 2 0 (0.8000000 0.2000000) *
37) Type.of.apartment=2,3 22 7 1 (0.3181818 0.6818182) *
19) Length.of.current.employment>=2.5 22 3 1 (0.1363636 0.8636364) *
5) Duration.of.Credit..month.< 13 96 24 1 (0.2500000 0.7500000)
10) Payment.Status.of.Previous.Credit=1 7 2 0 (0.7142857 0.2857143) *
11) Payment.Status.of.Previous.Credit=2,3 89 19 1 (0.2134831 0.7865169) *
3) Account.Balance=3 239 33 1 (0.1380753 0.8619247) *

 There is minor improvement in accuracy % also

Conclusion: For this data set tree-based method seems to be working better than logistic regression or discriminant analysis.

  Sample R code for Random Forest

library(randomForest)
rf50 <- randomForest(Creditability ~., data = Train50, ntree=200, importance=T, proximity=T)
plot(rf50, main="")
rf50
Test50_rf_pred <- predict(rf50, Test50, type="class")
table(Test50_rf_pred, Test50$Creditability)
importance(rf50)
varImpPlot(rf50,  main="", cex=0.8)

Completely unsupervised random forest method on Training data with ntree = 200 leads to the following error plot:

Importance of predictors are given in the following dotplot.

which gives rise to the following classification table:

With judicious choice of more important predictors, further improvement in accuracy is possible. But as improvement is slight, no attempt is made for supervised random forest.

Ultimately these statistical decisions must be translated into profit consideration for the bank. Let us assume that a correct decision of the bank would result in 35% profit at the end of 5 years. A correct decision here means that the bank predicts an application to be good or credit-worthy and it actually turns out to be credit worthy. When the opposite is true, i.e. bank predicts the application to be good but it turns out to be bad credit, then the loss is 100%. If the bank predicts an application to be non-creditworthy, then loan facility is not extended to that applicant and bank does not incur any loss (opportunity loss is not considered here). The cost matrix, therefore, is as follows:

Out of 1000 applicants, 70% are creditworthy. A loan manager without any model would incur [0.7*0.35 + 0.3 (-1)] = - 0.055 or 0.055 unit loss. If the average loan amount is 3200 DM (approximately), then the total loss will be 1760000 DM and per applicant loss is 176 DM.

Logistic regression model performance:

Tree-based classification and random forest show a per unit profit; other methods are not doing well.

Data and additional description may be found here.