Homework 5
Madalynne Cantu
10/28/2026
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 (!requireNamespace("caret", quietly = TRUE)) {
install.packages("caret")
}
if (!requireNamespace("listenv", quietly = TRUE)) {
install.packages("listenv")
}Task1: Data Preparation (5pts)
1. Load the caret package and the GermanCredit dataset.
library(caret) #this package contains the german data with its numeric format## Warning: package 'caret' was built under R version 4.6.1## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.6.1## Loading required package: latticedata(GermanCredit)
GermanCredit$Class <- as.numeric(GermanCredit$Class == "Good") # now 1 is Good and 0 is Bad
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 : num 1 0 1 1 0 1 1 1 1 0 ...
## $ 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:
#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.
dim(GermanCredit)## [1] 1000 49names(GermanCredit)## [1] "Duration" "Amount"
## [3] "InstallmentRatePercentage" "ResidenceDuration"
## [5] "Age" "NumberExistingCredits"
## [7] "NumberPeopleMaintenance" "Telephone"
## [9] "ForeignWorker" "Class"
## [11] "CheckingAccountStatus.lt.0" "CheckingAccountStatus.0.to.200"
## [13] "CheckingAccountStatus.gt.200" "CreditHistory.NoCredit.AllPaid"
## [15] "CreditHistory.ThisBank.AllPaid" "CreditHistory.PaidDuly"
## [17] "CreditHistory.Delay" "Purpose.NewCar"
## [19] "Purpose.UsedCar" "Purpose.Furniture.Equipment"
## [21] "Purpose.Radio.Television" "Purpose.DomesticAppliance"
## [23] "Purpose.Repairs" "Purpose.Education"
## [25] "Purpose.Retraining" "Purpose.Business"
## [27] "SavingsAccountBonds.lt.100" "SavingsAccountBonds.100.to.500"
## [29] "SavingsAccountBonds.500.to.1000" "SavingsAccountBonds.gt.1000"
## [31] "EmploymentDuration.lt.1" "EmploymentDuration.1.to.4"
## [33] "EmploymentDuration.4.to.7" "EmploymentDuration.gt.7"
## [35] "Personal.Male.Divorced.Seperated" "Personal.Female.NotSingle"
## [37] "Personal.Male.Single" "OtherDebtorsGuarantors.None"
## [39] "OtherDebtorsGuarantors.CoApplicant" "Property.RealEstate"
## [41] "Property.Insurance" "Property.CarOther"
## [43] "OtherInstallmentPlans.Bank" "OtherInstallmentPlans.Stores"
## [45] "Housing.Rent" "Housing.Own"
## [47] "Job.UnemployedUnskilled" "Job.UnskilledResident"
## [49] "Job.SkilledEmployee"str(GermanCredit)## 'data.frame': 1000 obs. of 49 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 : num 1 0 1 1 0 1 1 1 1 0 ...
## $ 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 ...
## $ 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 ...
## $ 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.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 ...
## $ 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 ...
## $ 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 ...
## $ 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 ...
## $ 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 ...
## $ 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 ...
## $ 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 ...
## $ 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 ...
## $ 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 ...summary(GermanCredit)## Duration Amount InstallmentRatePercentage ResidenceDuration
## Min. : 4.0 Min. : 250 Min. :1.000 Min. :1.000
## 1st Qu.:12.0 1st Qu.: 1366 1st Qu.:2.000 1st Qu.:2.000
## Median :18.0 Median : 2320 Median :3.000 Median :3.000
## Mean :20.9 Mean : 3271 Mean :2.973 Mean :2.845
## 3rd Qu.:24.0 3rd Qu.: 3972 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :72.0 Max. :18424 Max. :4.000 Max. :4.000
## Age NumberExistingCredits NumberPeopleMaintenance Telephone
## Min. :19.00 Min. :1.000 Min. :1.000 Min. :0.000
## 1st Qu.:27.00 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:0.000
## Median :33.00 Median :1.000 Median :1.000 Median :1.000
## Mean :35.55 Mean :1.407 Mean :1.155 Mean :0.596
## 3rd Qu.:42.00 3rd Qu.:2.000 3rd Qu.:1.000 3rd Qu.:1.000
## Max. :75.00 Max. :4.000 Max. :2.000 Max. :1.000
## ForeignWorker Class CheckingAccountStatus.lt.0
## Min. :0.000 Min. :0.0 Min. :0.000
## 1st Qu.:1.000 1st Qu.:0.0 1st Qu.:0.000
## Median :1.000 Median :1.0 Median :0.000
## Mean :0.963 Mean :0.7 Mean :0.274
## 3rd Qu.:1.000 3rd Qu.:1.0 3rd Qu.:1.000
## Max. :1.000 Max. :1.0 Max. :1.000
## CheckingAccountStatus.0.to.200 CheckingAccountStatus.gt.200
## Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.000
## Median :0.000 Median :0.000
## Mean :0.269 Mean :0.063
## 3rd Qu.:1.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.000
## CreditHistory.NoCredit.AllPaid CreditHistory.ThisBank.AllPaid
## Min. :0.00 Min. :0.000
## 1st Qu.:0.00 1st Qu.:0.000
## Median :0.00 Median :0.000
## Mean :0.04 Mean :0.049
## 3rd Qu.:0.00 3rd Qu.:0.000
## Max. :1.00 Max. :1.000
## CreditHistory.PaidDuly CreditHistory.Delay Purpose.NewCar Purpose.UsedCar
## Min. :0.00 Min. :0.000 Min. :0.000 Min. :0.000
## 1st Qu.:0.00 1st Qu.:0.000 1st Qu.:0.000 1st Qu.:0.000
## Median :1.00 Median :0.000 Median :0.000 Median :0.000
## Mean :0.53 Mean :0.088 Mean :0.234 Mean :0.103
## 3rd Qu.:1.00 3rd Qu.:0.000 3rd Qu.:0.000 3rd Qu.:0.000
## Max. :1.00 Max. :1.000 Max. :1.000 Max. :1.000
## Purpose.Furniture.Equipment Purpose.Radio.Television Purpose.DomesticAppliance
## Min. :0.000 Min. :0.00 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.00 1st Qu.:0.000
## Median :0.000 Median :0.00 Median :0.000
## Mean :0.181 Mean :0.28 Mean :0.012
## 3rd Qu.:0.000 3rd Qu.:1.00 3rd Qu.:0.000
## Max. :1.000 Max. :1.00 Max. :1.000
## Purpose.Repairs Purpose.Education Purpose.Retraining Purpose.Business
## Min. :0.000 Min. :0.00 Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.00 1st Qu.:0.000 1st Qu.:0.000
## Median :0.000 Median :0.00 Median :0.000 Median :0.000
## Mean :0.022 Mean :0.05 Mean :0.009 Mean :0.097
## 3rd Qu.:0.000 3rd Qu.:0.00 3rd Qu.:0.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.00 Max. :1.000 Max. :1.000
## SavingsAccountBonds.lt.100 SavingsAccountBonds.100.to.500
## Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.000
## Median :1.000 Median :0.000
## Mean :0.603 Mean :0.103
## 3rd Qu.:1.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.000
## SavingsAccountBonds.500.to.1000 SavingsAccountBonds.gt.1000
## Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.000
## Median :0.000 Median :0.000
## Mean :0.063 Mean :0.048
## 3rd Qu.:0.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.000
## EmploymentDuration.lt.1 EmploymentDuration.1.to.4 EmploymentDuration.4.to.7
## Min. :0.000 Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.000 1st Qu.:0.000
## Median :0.000 Median :0.000 Median :0.000
## Mean :0.172 Mean :0.339 Mean :0.174
## 3rd Qu.:0.000 3rd Qu.:1.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.000 Max. :1.000
## EmploymentDuration.gt.7 Personal.Male.Divorced.Seperated
## Min. :0.000 Min. :0.00
## 1st Qu.:0.000 1st Qu.:0.00
## Median :0.000 Median :0.00
## Mean :0.253 Mean :0.05
## 3rd Qu.:1.000 3rd Qu.:0.00
## Max. :1.000 Max. :1.00
## Personal.Female.NotSingle Personal.Male.Single OtherDebtorsGuarantors.None
## Min. :0.00 Min. :0.000 Min. :0.000
## 1st Qu.:0.00 1st Qu.:0.000 1st Qu.:1.000
## Median :0.00 Median :1.000 Median :1.000
## Mean :0.31 Mean :0.548 Mean :0.907
## 3rd Qu.:1.00 3rd Qu.:1.000 3rd Qu.:1.000
## Max. :1.00 Max. :1.000 Max. :1.000
## OtherDebtorsGuarantors.CoApplicant Property.RealEstate Property.Insurance
## Min. :0.000 Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.000 1st Qu.:0.000
## Median :0.000 Median :0.000 Median :0.000
## Mean :0.041 Mean :0.282 Mean :0.232
## 3rd Qu.:0.000 3rd Qu.:1.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.000 Max. :1.000
## Property.CarOther OtherInstallmentPlans.Bank OtherInstallmentPlans.Stores
## Min. :0.000 Min. :0.000 Min. :0.000
## 1st Qu.:0.000 1st Qu.:0.000 1st Qu.:0.000
## Median :0.000 Median :0.000 Median :0.000
## Mean :0.332 Mean :0.139 Mean :0.047
## 3rd Qu.:1.000 3rd Qu.:0.000 3rd Qu.:0.000
## Max. :1.000 Max. :1.000 Max. :1.000
## Housing.Rent Housing.Own Job.UnemployedUnskilled Job.UnskilledResident
## Min. :0.000 Min. :0.000 Min. :0.000 Min. :0.0
## 1st Qu.:0.000 1st Qu.:0.000 1st Qu.:0.000 1st Qu.:0.0
## Median :0.000 Median :1.000 Median :0.000 Median :0.0
## Mean :0.179 Mean :0.713 Mean :0.022 Mean :0.2
## 3rd Qu.:0.000 3rd Qu.:1.000 3rd Qu.:0.000 3rd Qu.:0.0
## Max. :1.000 Max. :1.000 Max. :1.000 Max. :1.0
## Job.SkilledEmployee
## Min. :0.00
## 1st Qu.:0.00
## Median :1.00
## Mean :0.63
## 3rd Qu.:1.00
## Max. :1.00table(GermanCredit$Class)##
## 0 1
## 300 700sum(is.na(GermanCredit))## [1] 0Your observation:
The GermanCredit dataset contains 1,000 observations and 49 variables
after removing variables that provide no information. The response
variable, Class, is coded as 0 for bad credit and 1 for good credit. The
dataset contains 300 bad-credit customers and 700 good-credit customers,
showing that good-credit customers make up the majority of the data. ###
3. Split the dataset into training and test set.
Please use the random seed as 2024 for reproducibility.
set.seed(2024)
# Split the data: 70% training and 30% testing
train_index <- createDataPartition(
GermanCredit$Class,
p = 0.70,
list = FALSE
)
training <- GermanCredit[train_index, ]
testing <- GermanCredit[-train_index, ]
# Check the sizes of both datasets
dim(training)## [1] 700 49dim(testing)## [1] 300 49# Check class distribution in each dataset
table(training$Class)##
## 0 1
## 195 505table(testing$Class)##
## 0 1
## 105 195Your observation:
The dataset was divided into a training set containing 700 observations and a test set containing 300 observations using a random seed of 2024. The training set will be used to fit the logistic regression model, while the test set will be used to evaluate how well the model performs on new data.
Task 2: Model Fitting (10pts)
1. Fit a logistic regression model using the training set. Please use all variables, but make sure the variable types are right.
# Fit logistic regression using the training data
credit_model <- glm(
Class ~ .,
data = training,
family = binomial(link = "logit")
)
summary(credit_model)##
## Call:
## glm(formula = Class ~ ., family = binomial(link = "logit"), data = training)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 9.369e+00 1.829e+00 5.122 3.02e-07 ***
## Duration -2.500e-02 1.159e-02 -2.158 0.030928 *
## Amount -1.866e-04 5.568e-05 -3.352 0.000802 ***
## InstallmentRatePercentage -4.458e-01 1.136e-01 -3.923 8.75e-05 ***
## ResidenceDuration 6.363e-03 1.103e-01 0.058 0.953999
## Age 1.953e-02 1.216e-02 1.606 0.108182
## NumberExistingCredits -1.261e-01 2.450e-01 -0.515 0.606850
## NumberPeopleMaintenance -1.950e-01 3.260e-01 -0.598 0.549618
## Telephone -3.987e-01 2.603e-01 -1.532 0.125566
## ForeignWorker -1.476e+00 7.829e-01 -1.885 0.059450 .
## CheckingAccountStatus.lt.0 -1.813e+00 2.948e-01 -6.151 7.69e-10 ***
## CheckingAccountStatus.0.to.200 -1.419e+00 2.957e-01 -4.800 1.59e-06 ***
## CheckingAccountStatus.gt.200 -2.207e-01 5.404e-01 -0.408 0.682962
## CreditHistory.NoCredit.AllPaid -1.020e+00 5.507e-01 -1.851 0.064107 .
## CreditHistory.ThisBank.AllPaid -1.717e+00 5.911e-01 -2.905 0.003677 **
## CreditHistory.PaidDuly -7.613e-01 3.259e-01 -2.336 0.019502 *
## CreditHistory.Delay -1.106e+00 4.157e-01 -2.660 0.007815 **
## Purpose.NewCar -1.907e+00 1.065e+00 -1.790 0.073450 .
## Purpose.UsedCar -2.447e-01 1.082e+00 -0.226 0.821017
## Purpose.Furniture.Equipment -9.006e-01 1.066e+00 -0.845 0.398330
## Purpose.Radio.Television -1.076e+00 1.070e+00 -1.006 0.314601
## Purpose.DomesticAppliance -1.640e+00 1.390e+00 -1.180 0.238012
## Purpose.Repairs -1.620e+00 1.211e+00 -1.338 0.180844
## Purpose.Education -2.242e+00 1.161e+00 -1.932 0.053400 .
## Purpose.Retraining -6.540e-01 1.664e+00 -0.393 0.694309
## Purpose.Business -7.351e-01 1.094e+00 -0.672 0.501698
## SavingsAccountBonds.lt.100 -1.341e+00 3.467e-01 -3.868 0.000110 ***
## SavingsAccountBonds.100.to.500 -1.179e+00 4.488e-01 -2.627 0.008615 **
## SavingsAccountBonds.500.to.1000 -1.064e+00 5.682e-01 -1.873 0.061102 .
## SavingsAccountBonds.gt.1000 -2.395e-01 6.545e-01 -0.366 0.714428
## EmploymentDuration.lt.1 3.040e-01 5.495e-01 0.553 0.580133
## EmploymentDuration.1.to.4 4.008e-01 5.289e-01 0.758 0.448574
## EmploymentDuration.4.to.7 8.251e-01 5.670e-01 1.455 0.145643
## EmploymentDuration.gt.7 3.905e-01 5.359e-01 0.729 0.466142
## Personal.Male.Divorced.Seperated -1.529e-01 5.695e-01 -0.268 0.788356
## Personal.Female.NotSingle -9.258e-02 3.755e-01 -0.247 0.805267
## Personal.Male.Single 3.861e-01 3.809e-01 1.014 0.310692
## OtherDebtorsGuarantors.None -1.039e+00 5.761e-01 -1.803 0.071362 .
## OtherDebtorsGuarantors.CoApplicant -1.635e+00 7.330e-01 -2.230 0.025730 *
## Property.RealEstate 7.315e-01 5.452e-01 1.342 0.179726
## Property.Insurance 2.724e-01 5.293e-01 0.515 0.606870
## Property.CarOther 5.846e-01 5.159e-01 1.133 0.257157
## OtherInstallmentPlans.Bank -1.058e+00 2.980e-01 -3.551 0.000383 ***
## OtherInstallmentPlans.Stores -6.249e-01 5.052e-01 -1.237 0.216067
## Housing.Rent -1.006e+00 6.242e-01 -1.612 0.106903
## Housing.Own -2.691e-01 6.022e-01 -0.447 0.654919
## Job.UnemployedUnskilled 1.787e+00 1.032e+00 1.732 0.083320 .
## Job.UnskilledResident 1.094e-01 4.442e-01 0.246 0.805560
## Job.SkilledEmployee 5.852e-02 3.652e-01 0.160 0.872710
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 828.24 on 699 degrees of freedom
## Residual deviance: 576.87 on 651 degrees of freedom
## AIC: 674.87
##
## Number of Fisher Scoring iterations: 5Your observation:
The logistic regression model was fitted using the training data and all available predictors to estimate the probability of a customer having good credit.
2. Summarize the model and interpret the coefficients (pick at least one coefficient you think important and discuss it in detail).
summary(credit_model)##
## Call:
## glm(formula = Class ~ ., family = binomial(link = "logit"), data = training)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 9.369e+00 1.829e+00 5.122 3.02e-07 ***
## Duration -2.500e-02 1.159e-02 -2.158 0.030928 *
## Amount -1.866e-04 5.568e-05 -3.352 0.000802 ***
## InstallmentRatePercentage -4.458e-01 1.136e-01 -3.923 8.75e-05 ***
## ResidenceDuration 6.363e-03 1.103e-01 0.058 0.953999
## Age 1.953e-02 1.216e-02 1.606 0.108182
## NumberExistingCredits -1.261e-01 2.450e-01 -0.515 0.606850
## NumberPeopleMaintenance -1.950e-01 3.260e-01 -0.598 0.549618
## Telephone -3.987e-01 2.603e-01 -1.532 0.125566
## ForeignWorker -1.476e+00 7.829e-01 -1.885 0.059450 .
## CheckingAccountStatus.lt.0 -1.813e+00 2.948e-01 -6.151 7.69e-10 ***
## CheckingAccountStatus.0.to.200 -1.419e+00 2.957e-01 -4.800 1.59e-06 ***
## CheckingAccountStatus.gt.200 -2.207e-01 5.404e-01 -0.408 0.682962
## CreditHistory.NoCredit.AllPaid -1.020e+00 5.507e-01 -1.851 0.064107 .
## CreditHistory.ThisBank.AllPaid -1.717e+00 5.911e-01 -2.905 0.003677 **
## CreditHistory.PaidDuly -7.613e-01 3.259e-01 -2.336 0.019502 *
## CreditHistory.Delay -1.106e+00 4.157e-01 -2.660 0.007815 **
## Purpose.NewCar -1.907e+00 1.065e+00 -1.790 0.073450 .
## Purpose.UsedCar -2.447e-01 1.082e+00 -0.226 0.821017
## Purpose.Furniture.Equipment -9.006e-01 1.066e+00 -0.845 0.398330
## Purpose.Radio.Television -1.076e+00 1.070e+00 -1.006 0.314601
## Purpose.DomesticAppliance -1.640e+00 1.390e+00 -1.180 0.238012
## Purpose.Repairs -1.620e+00 1.211e+00 -1.338 0.180844
## Purpose.Education -2.242e+00 1.161e+00 -1.932 0.053400 .
## Purpose.Retraining -6.540e-01 1.664e+00 -0.393 0.694309
## Purpose.Business -7.351e-01 1.094e+00 -0.672 0.501698
## SavingsAccountBonds.lt.100 -1.341e+00 3.467e-01 -3.868 0.000110 ***
## SavingsAccountBonds.100.to.500 -1.179e+00 4.488e-01 -2.627 0.008615 **
## SavingsAccountBonds.500.to.1000 -1.064e+00 5.682e-01 -1.873 0.061102 .
## SavingsAccountBonds.gt.1000 -2.395e-01 6.545e-01 -0.366 0.714428
## EmploymentDuration.lt.1 3.040e-01 5.495e-01 0.553 0.580133
## EmploymentDuration.1.to.4 4.008e-01 5.289e-01 0.758 0.448574
## EmploymentDuration.4.to.7 8.251e-01 5.670e-01 1.455 0.145643
## EmploymentDuration.gt.7 3.905e-01 5.359e-01 0.729 0.466142
## Personal.Male.Divorced.Seperated -1.529e-01 5.695e-01 -0.268 0.788356
## Personal.Female.NotSingle -9.258e-02 3.755e-01 -0.247 0.805267
## Personal.Male.Single 3.861e-01 3.809e-01 1.014 0.310692
## OtherDebtorsGuarantors.None -1.039e+00 5.761e-01 -1.803 0.071362 .
## OtherDebtorsGuarantors.CoApplicant -1.635e+00 7.330e-01 -2.230 0.025730 *
## Property.RealEstate 7.315e-01 5.452e-01 1.342 0.179726
## Property.Insurance 2.724e-01 5.293e-01 0.515 0.606870
## Property.CarOther 5.846e-01 5.159e-01 1.133 0.257157
## OtherInstallmentPlans.Bank -1.058e+00 2.980e-01 -3.551 0.000383 ***
## OtherInstallmentPlans.Stores -6.249e-01 5.052e-01 -1.237 0.216067
## Housing.Rent -1.006e+00 6.242e-01 -1.612 0.106903
## Housing.Own -2.691e-01 6.022e-01 -0.447 0.654919
## Job.UnemployedUnskilled 1.787e+00 1.032e+00 1.732 0.083320 .
## Job.UnskilledResident 1.094e-01 4.442e-01 0.246 0.805560
## Job.SkilledEmployee 5.852e-02 3.652e-01 0.160 0.872710
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 828.24 on 699 degrees of freedom
## Residual deviance: 576.87 on 651 degrees of freedom
## AIC: 674.87
##
## Number of Fisher Scoring iterations: 5Your observation:
The model fit improved compared to the null model. Several predictors
were statistically significant, and larger credit amounts were
associated with lower odds of good credit.
# Task 3: Find Optimal Probability Cut-off, with weight_FN = 1 and
weight_FP = 1. (10pts)
1. Use the training set to obtain predicted probabilities.
# Predict probabilities of good credit for training data
train_prob <- predict(
credit_model,
newdata = training,
type = "response"
)
# View the first six predicted probabilities
head(train_prob)## 1 2 3 5 6 7
## 0.9819748 0.4026497 0.9715937 0.2152321 0.8112996 0.9448495Your observation:
The model predicts different probabilities of good credit for each customer, ranging from about 0.22 to 0.98 among the first six observations.
2. Find the optimal probability cut-off point using the MR (misclassification rate) or equivalently the equal-weight cost.
# Try cutoffs from 0.01 to 0.99
cutoffs <- seq(0.01, 0.99, by = 0.01)
# Calculate the misclassification rate at each cutoff
train_mr <- sapply(cutoffs, function(cutoff) {
predicted_class <- ifelse(train_prob >= cutoff, 1, 0)
mean(predicted_class != training$Class)
})
# Find the cutoff with the lowest misclassification rate
best_cutoff <- cutoffs[which.min(train_mr)]
best_mr <- min(train_mr)
best_cutoff## [1] 0.49best_mr## [1] 0.19Your observation:
The optimal cutoff was 0.49, with a minimum training misclassification rate of 0.19 (19%).
Task 4: Model Evaluation (10pts)
1. Using the optimal probability cut-off point obtained in 3.2, generate confusion matrix and obtain MR for the training set.
# Predict probabilities for the test data
test_prob <- predict(
credit_model,
newdata = testing,
type = "response"
)
test_pred <- ifelse(test_prob >= best_cutoff, 1, 0)
table(
Actual = testing$Class,
Predicted = test_pred
)## Predicted
## Actual 0 1
## 0 48 57
## 1 20 175Your observation:
The model correctly classified 223 out of 300 customers, with 77 misclassified.
2. Using the optimal probability cut-off point obtained in 3.2, generate the ROC curve and calculate the AUC for the training set.
test_mr <- mean(test_pred != testing$Class)
test_mr## [1] 0.2566667Your observation:
The model incorrectly classified 25.67% of the test customers and correctly classified 74.33%.
3. Using the same cut-off point, generate confusion matrix and obtain MR for the test set.
library(pROC)## Warning: package 'pROC' was built under R version 4.6.1## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varroc_train <- roc(training$Class, train_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc(roc_train)## Area under the curve: 0.855plot(roc_train, main = "ROC Curve - Training Set")
Your observation:
The training set AUC was 0.855, indicating that the model has good ability to distinguish between good-credit and bad-credit customers.
4. Using the same cut-off point, generate the ROC curve and calculate the AUC for the test set.
roc_test <- roc(testing$Class, test_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc(roc_test)## Area under the curve: 0.7545plot(roc_test, main = "ROC Curve - Test Set")
Your observation:
The test set AUC was 0.7545, indicating that the model has a reasonable ability to distinguish between good-credit and bad-credit customers.
Task 5: Using different weights (10pts)
Now, let’s assume “It is worse to class a customer as good when they are bad (weight = 5), than it is to class a customer as bad when they are good (weight = 1).” Please figure out which weight should be 5 and which weight should be 1. Then define your cost function accordingly!
1. Obtain optimal probability cut-off point again, with the new weights.
# Set the new misclassification costs
weight_FN <- 1
weight_FP <- 5
# Try cutoffs from 0.01 to 0.99
cutoffs <- seq(0.01, 0.99, by = 0.01)
# Calculate weighted cost for each cutoff on training data
train_cost <- sapply(cutoffs, function(cutoff) {
predicted_class <- ifelse(train_prob >= cutoff, 1, 0)
FN <- sum(training$Class == 1 & predicted_class == 0)
FP <- sum(training$Class == 0 & predicted_class == 1)
(weight_FN * FN + weight_FP * FP) / nrow(training)
})
# Find the cutoff with the lowest weighted cost
best_cutoff_weighted <- cutoffs[which.min(train_cost)]
best_cost <- min(train_cost)
best_cutoff_weighted## [1] 0.81best_cost## [1] 0.3971429Your observation:
The optimal cutoff using the new misclassification costs was 0.81, with a minimum weighted cost of 0.3971.
2. Obtain the confusion matrix and MR for the training set.
# Predict training classes using the new cutoff
train_pred_weighted <- ifelse(train_prob >= best_cutoff_weighted, 1, 0)
# Confusion matrix
table(Actual = training$Class, Predicted = train_pred_weighted)## Predicted
## Actual 0 1
## 0 174 21
## 1 173 332# Misclassification rate
train_mr_weighted <- mean(train_pred_weighted != training$Class)
train_mr_weighted## [1] 0.2771429Your observation:
Using the new cutoff of 0.81, the training misclassification rate increased to 27.71%. The model made fewer costly errors by classifying bad-credit customers as good, but it also incorrectly classified more good-credit customers as bad.
3. Obtain the confusion matrix and MR for the test set.
# Predict test classes using the new cutoff
test_pred_weighted <- ifelse(test_prob >= best_cutoff_weighted, 1, 0)
# Confusion matrix
table(Actual = testing$Class, Predicted = test_pred_weighted)## Predicted
## Actual 0 1
## 0 77 28
## 1 74 121# Misclassification rate
test_mr_weighted <- mean(test_pred_weighted != testing$Class)
test_mr_weighted## [1] 0.34Your observation:
Using the new cutoff of 0.81, the test misclassification rate was 34%. The model reduced costly errors by incorrectly classifying fewer bad-credit customers as good, but it also incorrectly classified more good-credit customers as bad.
Task 6: Conclusion (5pts)
Summarize your findings, including the optimal probability cut-off, MR and AUC for both training and testing data. Discuss what you observed and what you will do to improve the model further.
The logistic regression model was able to predict customer credit classifications using the GermanCredit dataset. The original model had a training misclassification rate of 19% and a test misclassification rate of 25.67%, with a test AUC of 0.7545. When the misclassification costs were changed to make incorrectly classifying a bad-credit customer as good five times more costly, the optimal cutoff increased from 0.49 to 0.81. This reduced the number of bad-credit customers incorrectly classified as good, but increased the overall misclassification rate to 27.71% for training data and 34% for test data. Overall, the results show that the best cutoff depends on the costs of different prediction errors. In credit decisions, avoiding costly mistakes may be more important than minimizing the total number of misclassifications.