Homework4
Starter code for German credit scoring
Refer to http://archive.ics.uci.edu/ml/datasets/Statlog+(German+Credit+Data))
for variable description. The response variable is Class
and all others are predictors.
Only run the following code once to install the package
caret. The German credit scoring data in
provided in that package.
if (!require(package_name, quietly = TRUE)) {
install.packages("caret")
}Task1: Data Preparation
1. Load the caret package and the GermanCredit dataset.
library(caret) #this package contains the german data with its numeric format
data(GermanCredit)
GermanCredit$Class <- GermanCredit$Class == "Good" # use this code to convert `Class` into True or False (equivalent to 1 or 0)
str(GermanCredit)## 'data.frame': 1000 obs. of 62 variables:
## $ Duration : int 6 48 12 42 24 36 24 36 12 30 ...
## $ Amount : int 1169 5951 2096 7882 4870 9055 2835 6948 3059 5234 ...
## $ InstallmentRatePercentage : int 4 2 2 2 3 2 3 2 2 4 ...
## $ ResidenceDuration : int 4 2 3 4 4 4 4 2 4 2 ...
## $ Age : int 67 22 49 45 53 35 53 35 61 28 ...
## $ NumberExistingCredits : int 2 1 1 1 2 1 1 1 1 2 ...
## $ NumberPeopleMaintenance : int 1 1 2 2 2 2 1 1 1 1 ...
## $ Telephone : num 0 1 1 1 1 0 1 0 1 1 ...
## $ ForeignWorker : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Class : logi TRUE FALSE TRUE TRUE FALSE TRUE ...
## $ CheckingAccountStatus.lt.0 : num 1 0 0 1 1 0 0 0 0 0 ...
## $ CheckingAccountStatus.0.to.200 : num 0 1 0 0 0 0 0 1 0 1 ...
## $ CheckingAccountStatus.gt.200 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ CheckingAccountStatus.none : num 0 0 1 0 0 1 1 0 1 0 ...
## $ CreditHistory.NoCredit.AllPaid : num 0 0 0 0 0 0 0 0 0 0 ...
## $ CreditHistory.ThisBank.AllPaid : num 0 0 0 0 0 0 0 0 0 0 ...
## $ CreditHistory.PaidDuly : num 0 1 0 1 0 1 1 1 1 0 ...
## $ CreditHistory.Delay : num 0 0 0 0 1 0 0 0 0 0 ...
## $ CreditHistory.Critical : num 1 0 1 0 0 0 0 0 0 1 ...
## $ Purpose.NewCar : num 0 0 0 0 1 0 0 0 0 1 ...
## $ Purpose.UsedCar : num 0 0 0 0 0 0 0 1 0 0 ...
## $ Purpose.Furniture.Equipment : num 0 0 0 1 0 0 1 0 0 0 ...
## $ Purpose.Radio.Television : num 1 1 0 0 0 0 0 0 1 0 ...
## $ Purpose.DomesticAppliance : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Purpose.Repairs : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Purpose.Education : num 0 0 1 0 0 1 0 0 0 0 ...
## $ Purpose.Vacation : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Purpose.Retraining : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Purpose.Business : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Purpose.Other : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SavingsAccountBonds.lt.100 : num 0 1 1 1 1 0 0 1 0 1 ...
## $ SavingsAccountBonds.100.to.500 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SavingsAccountBonds.500.to.1000 : num 0 0 0 0 0 0 1 0 0 0 ...
## $ SavingsAccountBonds.gt.1000 : num 0 0 0 0 0 0 0 0 1 0 ...
## $ SavingsAccountBonds.Unknown : num 1 0 0 0 0 1 0 0 0 0 ...
## $ EmploymentDuration.lt.1 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ EmploymentDuration.1.to.4 : num 0 1 0 0 1 1 0 1 0 0 ...
## $ EmploymentDuration.4.to.7 : num 0 0 1 1 0 0 0 0 1 0 ...
## $ EmploymentDuration.gt.7 : num 1 0 0 0 0 0 1 0 0 0 ...
## $ EmploymentDuration.Unemployed : num 0 0 0 0 0 0 0 0 0 1 ...
## $ Personal.Male.Divorced.Seperated : num 0 0 0 0 0 0 0 0 1 0 ...
## $ Personal.Female.NotSingle : num 0 1 0 0 0 0 0 0 0 0 ...
## $ Personal.Male.Single : num 1 0 1 1 1 1 1 1 0 0 ...
## $ Personal.Male.Married.Widowed : num 0 0 0 0 0 0 0 0 0 1 ...
## $ Personal.Female.Single : num 0 0 0 0 0 0 0 0 0 0 ...
## $ OtherDebtorsGuarantors.None : num 1 1 1 0 1 1 1 1 1 1 ...
## $ OtherDebtorsGuarantors.CoApplicant : num 0 0 0 0 0 0 0 0 0 0 ...
## $ OtherDebtorsGuarantors.Guarantor : num 0 0 0 1 0 0 0 0 0 0 ...
## $ Property.RealEstate : num 1 1 1 0 0 0 0 0 1 0 ...
## $ Property.Insurance : num 0 0 0 1 0 0 1 0 0 0 ...
## $ Property.CarOther : num 0 0 0 0 0 0 0 1 0 1 ...
## $ Property.Unknown : num 0 0 0 0 1 1 0 0 0 0 ...
## $ OtherInstallmentPlans.Bank : num 0 0 0 0 0 0 0 0 0 0 ...
## $ OtherInstallmentPlans.Stores : num 0 0 0 0 0 0 0 0 0 0 ...
## $ OtherInstallmentPlans.None : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Housing.Rent : num 0 0 0 0 0 0 0 1 0 0 ...
## $ Housing.Own : num 1 1 1 0 0 0 1 0 1 1 ...
## $ Housing.ForFree : num 0 0 0 1 1 1 0 0 0 0 ...
## $ Job.UnemployedUnskilled : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Job.UnskilledResident : num 0 0 1 0 0 1 0 0 1 0 ...
## $ Job.SkilledEmployee : num 1 1 0 1 1 0 1 0 0 0 ...
## $ Job.Management.SelfEmp.HighlyQualified: num 0 0 0 0 0 0 0 1 0 1 ...Your observation: The dataset contains 1,000 observations with 62 variables. I changed the variable class from true and false to good or bad. Most of the variables are numeric.
#This is an optional code that drop variables that provide no information in the data
GermanCredit = GermanCredit[,-c(14,19,27,30,35,40,44,45,48,52,55,58,62)] #don't run this code twice!! Think about why.2. Explore the dataset to understand its structure.
(1) How many observations and variables are there? (2 pts)
# your code here:
dim(GermanCredit)## [1] 1000 49Your observation: There are 1,000 observations and 62 variables
(2) Please make a frequency table of variable class
(use table() function). How many observations are classed
as “good” and how many are “bad”? (2 pts)
# your code here:
table(GermanCredit$Class)##
## FALSE TRUE
## 300 700Your observation: 300 of the observations are bad while 700 are good. The “true” represents the good and the “false” the bad.
(3) Please make a barplot of of response variable
class. Please add titles and labels to axis. (2 pts)
# your code here:
barplot(table(GermanCredit$Class),
main = "Distribution of Credit Class",
xlab = "Class (Good = True, Bad = False",
ylab = "Number of Obs", col = c("red", "blue"))
3. Split the dataset into training and test set. A
random seed of 2025 is set for reproducibility. Please
comment on what is the split proportion you choose for training and
testing data? (2 pts)
set.seed(2025) # set random seed for reproducibility.
# your code here:
splitdatatrain <- createDataPartition(GermanCredit$Class, p = .8, list = FALSE)
trainingdata <- GermanCredit[splitdatatrain,]
testingdata <- GermanCredit[splitdatatrain,]Your comment: I chose a 80%, 20% split. These means that 80% of the observations will be used for training and 20% for testing.
Task 2: Model Fitting
1. Fit a logistic regression model using the training set. Please use all variables, but make sure the variable types are right. (2 pts)
# your code here:
logregressionmodel <- glm(Class ~ ., data = trainingdata, family = binomial)2. Summarize the model and interpret the coefficients. What is the
estimated coefficients for variable
InstallmentRatePercentage? Is it significant, and why? (2
pts)
# your code here:
summary(logregressionmodel)##
## Call:
## glm(formula = Class ~ ., family = binomial, data = trainingdata)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 7.680e+00 1.547e+00 4.964 6.91e-07 ***
## Duration -2.013e-02 1.082e-02 -1.861 0.062729 .
## Amount -1.700e-04 5.005e-05 -3.397 0.000681 ***
## InstallmentRatePercentage -3.497e-01 1.021e-01 -3.424 0.000618 ***
## ResidenceDuration -2.663e-02 9.641e-02 -0.276 0.782343
## Age 2.099e-02 1.045e-02 2.009 0.044576 *
## NumberExistingCredits -2.896e-01 2.153e-01 -1.345 0.178581
## NumberPeopleMaintenance -2.351e-01 2.799e-01 -0.840 0.400909
## Telephone -4.644e-01 2.286e-01 -2.031 0.042255 *
## ForeignWorker -1.273e+00 6.642e-01 -1.916 0.055354 .
## CheckingAccountStatus.lt.0 -1.751e+00 2.573e-01 -6.804 1.02e-11 ***
## CheckingAccountStatus.0.to.200 -1.241e+00 2.601e-01 -4.771 1.83e-06 ***
## CheckingAccountStatus.gt.200 -6.802e-01 4.197e-01 -1.621 0.105119
## CreditHistory.NoCredit.AllPaid -1.486e+00 4.814e-01 -3.088 0.002017 **
## CreditHistory.ThisBank.AllPaid -2.096e+00 5.003e-01 -4.189 2.80e-05 ***
## CreditHistory.PaidDuly -1.082e+00 3.038e-01 -3.562 0.000368 ***
## CreditHistory.Delay -6.164e-01 3.815e-01 -1.616 0.106160
## Purpose.NewCar -1.156e+00 9.301e-01 -1.243 0.213859
## Purpose.UsedCar 5.104e-01 9.628e-01 0.530 0.595989
## Purpose.Furniture.Equipment -1.940e-01 9.413e-01 -0.206 0.836717
## Purpose.Radio.Television -2.647e-01 9.362e-01 -0.283 0.777389
## Purpose.DomesticAppliance -5.461e-01 1.202e+00 -0.454 0.649644
## Purpose.Repairs -8.078e-01 1.108e+00 -0.729 0.465939
## Purpose.Education -1.243e+00 1.002e+00 -1.240 0.214870
## Purpose.Retraining 1.260e+00 1.531e+00 0.823 0.410557
## Purpose.Business -4.589e-01 9.609e-01 -0.478 0.632942
## SavingsAccountBonds.lt.100 -7.964e-01 2.825e-01 -2.819 0.004813 **
## SavingsAccountBonds.100.to.500 -3.156e-01 3.839e-01 -0.822 0.410933
## SavingsAccountBonds.500.to.1000 -3.754e-01 4.895e-01 -0.767 0.443162
## SavingsAccountBonds.gt.1000 5.756e-01 6.299e-01 0.914 0.360882
## EmploymentDuration.lt.1 3.648e-01 4.672e-01 0.781 0.434813
## EmploymentDuration.1.to.4 4.801e-01 4.502e-01 1.066 0.286245
## EmploymentDuration.4.to.7 1.009e+00 4.844e-01 2.082 0.037336 *
## EmploymentDuration.gt.7 4.781e-01 4.499e-01 1.063 0.287930
## Personal.Male.Divorced.Seperated -4.995e-01 5.181e-01 -0.964 0.334988
## Personal.Female.NotSingle -1.475e-01 3.496e-01 -0.422 0.673095
## Personal.Male.Single 4.369e-01 3.593e-01 1.216 0.223997
## OtherDebtorsGuarantors.None -9.516e-01 4.683e-01 -2.032 0.042138 *
## OtherDebtorsGuarantors.CoApplicant -1.713e+00 6.597e-01 -2.596 0.009433 **
## Property.RealEstate 7.005e-01 4.776e-01 1.467 0.142439
## Property.Insurance 1.940e-01 4.631e-01 0.419 0.675215
## Property.CarOther 5.255e-01 4.544e-01 1.156 0.247509
## OtherInstallmentPlans.Bank -5.133e-01 2.718e-01 -1.889 0.058936 .
## OtherInstallmentPlans.Stores -4.090e-01 4.220e-01 -0.969 0.332467
## Housing.Rent -6.144e-01 5.252e-01 -1.170 0.242094
## Housing.Own -2.288e-01 4.993e-01 -0.458 0.646876
## Job.UnemployedUnskilled 6.770e-01 8.099e-01 0.836 0.403252
## Job.UnskilledResident -2.457e-01 3.981e-01 -0.617 0.537210
## Job.SkilledEmployee -1.373e-01 3.238e-01 -0.424 0.671621
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 977.38 on 799 degrees of freedom
## Residual deviance: 712.30 on 751 degrees of freedom
## AIC: 810.3
##
## Number of Fisher Scoring iterations: 5coef(logregressionmodel)["InstallmentRatePercentage"]## InstallmentRatePercentage
## -0.3496977summary(logregressionmodel)$coefficients["InstallmentRatePercentage",]## Estimate Std. Error z value Pr(>|z|)
## -0.3496977138 0.1021414583 -3.4236608681 0.0006178367Your comment: The estimated coefficient for InstallmentRatePercent is -.3497. This means the installment rate increases as the probability of having good credit rate decreases.
3. Please interpret this number in detail (please calculate the corresponding odds ratio, and interpret it). (2 pts)
# you might need some code for calculation:
oddsratio <- exp(coef(logregressionmodel)["InstallmentRatePercentage"])
oddsratio## InstallmentRatePercentage
## 0.7049011Your comment: The odds ratio was .70. This shows that for each 1-unit increase in the Installment Rate the odds for good credit decrease by (1 - .70)
Task 3: Model Evaluation (Part I)
1. Use the training set to obtain predicted probabilities. (2 pts)
# your code here:
trainingprob <- predict(logregressionmodel, newdata = trainingdata, type = "response")
head(trainingprob)## 1 4 5 6 9 11
## 0.9694315 0.6931259 0.2783694 0.6696647 0.9843755 0.30351002. Using the probability cut-off of 0.5, generate confusion matrix and obtain MR (misclassification rate) for the the training set. (3 pts)
# your code here:
MR <- 1 - confusionMatrix(factor(trainingprob > .5), factor(trainingdata$Class))$overall["Accuracy"]
MR## Accuracy
## 0.2075Your comment: From the .5 cutoff we see that the accuracy is .2075 meaning the MR is .7925 This shows that the training set has about 21% of predictions are incorrect.
3. Find the optimal probability cut-off point using the MR. Please draw a plot of MR vs. cut-off probability, and comment on optimal cut-off probability. (3 pts)
# your code here:
cutoff_point <- seq(0.1,0.9, by = 0.01)
calc_MR <- function(cut) {
pred <- trainingprob > cut
mean(pred !=trainingdata$Class)
}
#Apply to each cutoff
MR_values <- sapply(cutoff_point, calc_MR)
# Plot MR
plot(cutoff_point, MR_values, type = "l",
main = "MR vs Cutoffs Probability",
xlab = "Probability Cutoff", ylab = "MR",
col = "blue", lwd = 2)
# Optimal cutoff and Corresponding MR
min_MR <- min(MR_values)
optimal_cutoff <- cutoff_point[MR_values == min_MR]Your comment: The plot shows the MR and how it changes based on the probability cutoff value.
4. Please generate the ROC curve and calculate the AUC for the training set. Please comment on this AUC. (2 pts)
# your code here:
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varroc_curve <- roc(trainingdata$Class, trainingprob)## Setting levels: control = FALSE, case = TRUE## Setting direction: controls < casesplot(roc_curve, main = "ROC Curve - Training Set",
col = "blue")
Your comment: This plot shows the trade-offs between the sensitivity used and the false positive rate. The AUC is a little above .80.
Task 4: Model Evaluation (Part II)
1. Use the testing set to obtain predicted probabilities. (2 pts)
# your code here:
testing_probabilities <- predict(logregressionmodel, newdata = testingdata, type = "response")
head(testing_probabilities)## 1 4 5 6 9 11
## 0.9694315 0.6931259 0.2783694 0.6696647 0.9843755 0.30351002. Using the probability cut-off of 0.5, generate confusion matrix and obtain MR (misclassification rate) for the the training set. (2 pts)
# your code here:
test_prediction <- ifelse(testing_probabilities > 0.5, TRUE, FALSE)
confustion_matrix_test <- confusionMatrix(factor(test_prediction), factor(testingdata$Class))
confustion_matrix_test## Confusion Matrix and Statistics
##
## Reference
## Prediction FALSE TRUE
## FALSE 132 58
## TRUE 108 502
##
## Accuracy : 0.7925
## 95% CI : (0.7627, 0.8201)
## No Information Rate : 0.7
## P-Value [Acc > NIR] : 2.219e-09
##
## Kappa : 0.4747
##
## Mcnemar's Test P-Value : 0.0001429
##
## Sensitivity : 0.5500
## Specificity : 0.8964
## Pos Pred Value : 0.6947
## Neg Pred Value : 0.8230
## Prevalence : 0.3000
## Detection Rate : 0.1650
## Detection Prevalence : 0.2375
## Balanced Accuracy : 0.7232
##
## 'Positive' Class : FALSE
## MR_test <- 1 - confustion_matrix_test$overall["Accuracy"]
MR_test## Accuracy
## 0.2075Your comment: The confusion matrix shows 132 observations predicted false and were false, 502 predectied true and were true, 108 predicted true and were false, and 58 predicted false that were false.The overall accuracy was .2075 which was the same as the training data.
2. Please generate the ROC curve and calculate the AUC for the test set. Please comment on this AUC. (2 pts)
# your code here:
roc_curve_test <- roc(testingdata$Class, testing_probabilities)## Setting levels: control = FALSE, case = TRUE## Setting direction: controls < casesplot(roc_curve_test, main = "ROC Curve - Testing Set", col = "blue")
auc(roc_curve_test)## Area under the curve: 0.8343