# Load dataset A
data_a <- read.csv("dataset_a.csv")
# Round YearsEmployed
data_a["YearsEmployed"] <- round(data_a["YearsEmployed"])
# Reorder Approved to end
data_a <- data_a %>% dplyr::select(-Approved, everything(), Approved)Exploratory Data Analysis - Dataset Comparison and Analysis for Loan Data
Introduction
This project is centered around exploratory data analysis. I’m interested in seeing if I can evaluate the quality and behavior of multiple data sets, especially when compared to each other.
For my dataset, I picked three different credit approval data sets I found on Kaggle. I picked Credit Approval due to it’s direct financial impact for an individual, thus making the awareness of flaws or differences in datasets even more important. I want to examine them both using factors or predictors shared among them, as well as predictors exclusive to said model set.
Data
As mentioned, I picked three different datasets from Kaggle. Note that at the time of this writing, there are approximately 51 credit datasets. However, upon examination, many of them are simply subsets or modifications of Dataset A or Dataset B below. Note that while Dataset A and Dataset B are credit card approval datasets, Dataset C is a more general direct credit approval dataset. Features are renamed or modified to match each other across datasets when shared.
Dataset A
Description
Dataset A was downloaded from Kaggle using this link. The original source of this dataset is from the UCI machine learning repository on credit card approvals. We note that there are differences between the Kaggle and the source version. They are listed below:
The Kaggle version fills in some missing values, but not all. The rest of the missing values have been filled in by me.
The UCI version obfuscates the attribute names. The Kaggle author deobfuscates the attribute names.
Beyond this, not much more of the data set is known, as it has been anonymized to protect customer data. Also note that features such as Income and Debt have been arbitrarily scaled, and it is unknown how to unscale these features.
Features
| Feature | Description | Type | Shared with |
|---|---|---|---|
| Gender | Applicant’s gender. 1 = Male, 0 = Non-male | int | B, C |
| Age | Applicant’s age in years | int | B |
| Debt | (Scaled) Applicant’s outstanding debt | num | B |
| Married | 1 = Married, 0 = Not Married | int | B, C |
| BankCustomer | 1 = Customer, 0 = Not a Customer | int | |
| Industry | Applicant’s Job Industry | chr | |
| Ethnicity | Applicant’s Ethnicity | chr | |
| YearsEmployed | Number of years at Job | num | B |
| PriorDefault | 0 = Never defaulted, 1 = One or more prior defaults | int | |
| Employed | 0 = Unemployed, 1 = Employed | int | |
| CreditScore | (Scaled) Applicant’s credit score | int | |
| DriversLicense | 0 = No license, 1 = Has license | int | |
| Citizen | Citizenship status | chr | |
| ZipCode | (Anonymized) Zip code of the applicant | int | |
| Income | (Scaled) Applicant’s Income | int | B, C |
| Approved | Whether the application is approved or not | int | B, C |
Code
Dataset B
Description
Dataset B was downloaded from Kaggle using this link. This is a version of a dataset available here that was apparently pre-processed and cleaned using Pentaho to make it nicer to import into libraries like R. We note a few important key points of this dataset below:
The original source of the data is not given. Like before, it’s most likely anonymous to protect customer data.
This is the largest data source by far, with 25k records as compared to datasets A and C. It also has the most features
The goal of the dataset is listed as “training machine learning models to determine whether or not an applicant is a ‘good’ or ‘bad’ one”
Features
| Feature | Description | Type | Shared with |
|---|---|---|---|
| Gender | (Originally Applicant_Gender) 1 = Male, 0 = Non-male | int | A, C |
| Owned_Car | 0 = Does not own car, 1 = Owns Car | int | |
| Owned_Realty | 0 = Does not own property, 1 = Owns property | int | |
| Dependents | (Originally Total_Children) Number of children | int | C |
| Income | (Originally Total_Income) Applicant’s Income | int | A, C |
| Income_Type | Where money is originating from | chr | |
| Education_Type | Details of applicant’s education | chr | |
| Housing_Type | Applicant’s living situation | chr | |
| Owned_Mobile_Phone | Whether applicant owns a mobile phone | int | |
| Owned_Work_Phone | Whether applicant owns a work phone | int | |
| Owned_Phone | Whether applicant owns a landline | int | |
| Owned_Email | Whether applicant has an email address | int | |
| Job_Title | Applicant’s job title | chr | |
| Total_Family_Members | Number of applicant’s family members | int | |
| Age | (Originally Applicant_Age) Applicant’s age | int | A |
| YearsEmployed | (Originally Years_of_Working) Years at job | int | A |
| Total_Bad_Debt | Sum of bad debt | num | |
| Total_Good_Debt | Sum of good debt | num | |
| Debt | Sum of Total_Bad_Debt+Total_Good_Debt | num | A |
| IncomeScaled | Income scaled to match dataset A’s scaling | num | |
| Married | 0 = Not married, 1 = Married | int | A, C |
| IsGraduate | 0 = Did not graduate, 1 = Graduated | int | C |
| Approved | (Originally Status) 0 = Denied, 1 = Approved | int | A, C |
Code
# Load dataset B
data_b <- read.csv("dataset_b.csv")
# Trim whitespace
data_b <- data_b %>% mutate(across(where(is.character), trimws))
# Match easy column names
names(data_b)[names(data_b) == "Applicant_Age"] <- "Age"
names(data_b)[names(data_b) == "Status"] <- "Approved"
names(data_b)[names(data_b) == "Years_of_Working"] <- "YearsEmployed"
names(data_b)[names(data_b) == "Total_Children"] <- "Dependents"
names(data_b)[names(data_b) == "Total_Income"] <- "Income"
# Match gender
data_b$Gender <- ifelse(data_b$Applicant_Gender == "M", 1, 0)
# Combine debt to make a scaled that matches A
data_b$Debt = (data_b$Total_Good_Debt + data_b$Total_Bad_Debt) / 3.93
# Scale income to match A
data_b$IncomeScaled <- data_b$Income / 15.75
# Create a new column called IsMarried
data_b$Married <- ifelse(data_b$Family_Status == "Married", 1, 0)
# Create an IsGraduate column
data_b <- data_b %>%
mutate(IsGraduate = ifelse(Education_Type %in% c("Academic degree", "Higher education"), 1, 0))
# Drop old columns
#data_b$Applicant_Gender <- NULL
data_b$Applicant_ID <- NULL
data_b$Family_Status <- NULL
data_b$Applicant_Gender <- NULL
# Reorder Approved to end
data_b <- data_b %>% dplyr::select(-Approved, everything(), Approved)Dataset C
Description
Our final dataset is dataset C which was downloaded from this link. We note a few key points about the dataset here:
Like the last two datasets, the original source of the data is not given. Like before, it’s most likely anonymous to protect customer data.
Unlike the last two datasets, this dataset is more for general line of credits versus just credit cards. Unfortunately, I could not find a third solid credit card dataset.
The purpose of this dataset is for a “bank to decide whether to give a loan to the applicant based on some factors” like the features listed below.
Features
| Feature | Description | Type | Shared with |
|---|---|---|---|
| Gender | (Originally Applicant_Gender) 1 = Male, 0 = Non-male | int | A, B |
| Married | 0 = Not married, 1 = Married | int | A, B |
| Dependents | (Originally chr) Number of children | int | B |
| Education | Applicant’s education level | chr | |
| Self_Employed | 0 = Not self-employed, 1 = Self-employed | int | |
| ApplicantIncome | Primary applicant’s income | int | |
| CoApplicantIncome | Secondary applicants’ income | int | |
| LoanAmount | Amount of money (in thousands) asking for | int | |
| Loan_Amount_Term | Term until payback of loan | int | |
| Credit_History | 0 = No credit history, 1 = Credit history | int | |
| Property_Area | Where the property resides | chr | |
| Income | Sum of ApplicantIncome+CoApplicantIncome | int | A, B` |
| IsGraduate | 0 = No higher education, 1 = Higher education | int | B |
| Approved | (Originally Loan_Status) 0 = Denied, 1 = Approved | int | A, B |
Code
# Load dataset C
data_c <- read.csv("dataset_c.csv")
# Reconcile NAs
data_c$Loan_Amount_Term <- ifelse(is.na(data_c$Loan_Amount_Term), 360, data_c$Loan_Amount_Term)
data_c$Credit_History <- ifelse(is.na(data_c$Credit_History), 0, data_c$Credit_History)
# Rename
data_c$Income <- data_c$ApplicantIncome + data_c$CoapplicantIncome
# Recast Approved field
data_c$Approved <- ifelse(data_c$Loan_Status == "Y", 1, 0)
# Add marriage field
data_c$Married <- ifelse(data_c$Married == "Yes", 1, 0)
# Fix SelfEmployed field
data_c$Self_Employed <- ifelse(data_c$Self_Employed == "Yes", 1, 0)
# Fix gender
data_c$Gender <- ifelse(data_c$Gender == "Male", 1, 0)
# Create a new column called IsGraduate
data_c$IsGraduate <- ifelse(data_c$Education == "Graduate", 1, 0)
# Convert dependents to num
data_c$Dependents <- ifelse(data_c$Dependents == "3+", 3, data_c$Dependents)
data_c$Dependents <- as.integer(data_c$Dependents)
data_c$Dependents <- ifelse(is.na(data_c$Dependents), 0, data_c$Dependents)
# Drop columns
data_c$Loan_ID <- NULL
data_c$Loan_Status <- NULL
# Reorder Approved to end
data_c <- data_c %>% dplyr::select(-Approved, everything(), Approved)Questions
Since the goal of this project is comparing between datasets, and the effect it may have on models we ask the following questions:
1) How similar / different are the datasets from each other? This covers factors such as quality, distribution, class balance, etc.
2) When training on the features shared between datasets, will each dataset favor the features differently? Do some models exhibit bias?
3) Will the same model trained with features unique to each dataset have a heavy impact on what can be inferred?
Visualization
Dataset Overview
# Building a summary table
num_records1 <- nrow(data_a)
num_columns1 <- ncol(data_a)
num_records2 <- nrow(data_b)
num_columns2 <- ncol(data_b)
num_records3 <- nrow(data_c)
num_columns3 <- ncol(data_c)
# Create a summary table
summary_table <- data.frame(
Dataset = c("A", "B", "C"),
Records = c(num_records1, num_records2, num_records3),
Columns = c(num_columns1, num_columns2, num_columns3)
)
# Print records for dataset
plot_a <- ggplot(summary_table, aes(x = factor(Dataset), y = Records, fill = Dataset)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("A" = "olivedrab3", "B" = "sandybrown", "C" = "slategray1")) +
ggtitle("Records in each dataset") +
xlab("Dataset") +
ylab("Record Count") +
theme_minimal()
# Plot columns for dataset
plot_b <- ggplot(summary_table, aes(x = factor(Dataset), y = Columns, fill = Dataset)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("A" = "olivedrab3", "B" = "sandybrown", "C" = "slategray1")) +
ggtitle("Columns in each dataset") +
xlab("Dataset") +
ylab("Column Count") +
theme_minimal()
grid.arrange(plot_a, plot_b, ncol = 2)
Income Analysis (Shared by A, B, C)
Since this is primarily associated with comparison and data exploration against the three datasets, we’ll create some visualizations to compare between each dataset.
# Create a histogram for data_a
plot_a <- ggplot(data_a, aes(x = Income)) +
geom_histogram(binwidth = 2000, fill = "olivedrab3", color = "black") +
labs(title = "Dataset A Income Dist", x = "Income", y = "Count") +
theme_minimal()
# Create a histogram for data_b
plot_b <- ggplot(data_b, aes(x = Income)) +
geom_histogram(binwidth = 50000, fill = "sandybrown", color = "black") +
labs(title = "Dataset B Income Dist", x = "Income", y = "Count") +
theme_minimal()
# Create a histogram for data_c
plot_c <- ggplot(data_c, aes(x = Income)) +
geom_histogram(binwidth = 1000, fill = "slategray1", color = "black") +
labs(title = "Dataset C Income Dist", x = "Income", y = "Count") +
theme_minimal()
# Combine the plots into a single layout
grid.arrange(plot_a, plot_b, plot_c, ncol = 2)
# Summarize the "Income" column for each dataframe
summary_a <- data_a %>%
summarise(
Min = min(Income, na.rm = TRUE),
Median = median(Income, na.rm = TRUE),
Mean = mean(Income, na.rm = TRUE),
Max = max(Income, na.rm = TRUE)
) %>%
mutate(Dataset = "data_a")
summary_b <- data_b %>%
summarise(
Min = min(Income, na.rm = TRUE),
Median = median(Income, na.rm = TRUE),
Mean = mean(Income, na.rm = TRUE),
Max = max(Income, na.rm = TRUE)
) %>%
mutate(Dataset = "data_b")
summary_c <- data_c %>%
summarise(
Min = min(Income, na.rm = TRUE),
Median = median(Income, na.rm = TRUE),
Mean = mean(Income, na.rm = TRUE),
Max = max(Income, na.rm = TRUE)
) %>%
mutate(Dataset = "data_c")
# Combine the summaries
summary_table <- bind_rows(summary_a, summary_b, summary_c) %>%
dplyr::select(Dataset, Min, Median, Mean, Max)
# Print the summary table with kableExtra styling
summary_table %>%
kbl(caption = "Summary Statistics for Income") %>%
kable_styling()| Dataset | Min | Median | Mean | Max |
|---|---|---|---|---|
| data_a | 0 | 5 | 1017.386 | 100000 |
| data_b | 27000 | 180000 | 194836.499 | 1575000 |
| data_c | 1442 | 4600 | 4857.121 | 35673 |
# For dataset A
# Create a frequency table for the "Income" column. I already found the most frequent values in Excel
income_freq <- table(data_a$Income)
titles <- c("0", "1", "500")
values_of_interest <- c(0, 1, 500)
occurrence_table <- data.frame(
Titles = titles,
Value = values_of_interest,
Count = sapply(values_of_interest, function(x) income_freq[as.character(x)]),
Percentage = round(sapply(values_of_interest, function(x) income_freq[as.character(x)]) / 690 * 100)
)
#print(occurrence_table)
plot_a <- ggplot(occurrence_table, aes(x = factor(Value), y = Count, fill = Titles)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("0" = "olivedrab3", "1" = "sandybrown", "500" = "slategray1")) +
ggtitle("Records in Dataset A") +
xlab("Value") +
ylab("Record Count") +
theme_minimal()
plot_b <- ggplot(occurrence_table, aes(x = factor(Value), y = Percentage, fill = Titles)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("0" = "olivedrab3", "1" = "sandybrown", "500" = "slategray1")) +
ggtitle("Percentage in Dataset A") +
xlab("Value") +
ylab("Percentage") +
ylim(0,100) +
theme_minimal()
grid.arrange(plot_a, plot_b, ncol = 2)
# Function to set values outside a certain range to NA
set_values_outside_range_to_na <- function(df, column_name, new_column_name, min_value, max_value, scaleby) {
df[[new_column_name]] <- ifelse(df[[column_name]] < min_value | df[[column_name]] > max_value, NA, df[[column_name]] * scaleby)
return(df)
}
# Apply data cleaning to A
data_a <- set_values_outside_range_to_na(data_a, "Income", "IncomeCleaned", 2, 40000, 1)
data_b <- set_values_outside_range_to_na(data_b, "Income", "IncomeCleaned", 0, 1000000, 1)
data_c <- set_values_outside_range_to_na(data_c, "Income", "IncomeCleaned", 0, 18000, 1)
# Create a histogram for data_a
plot_a <- ggplot(data_a, aes(x = IncomeCleaned)) +
geom_histogram(binwidth = 2000, fill = "olivedrab3", color = "black") +
labs(title = "Income Distribution in data_a", x = "Income", y = "Count") +
theme_minimal()
# Create a histogram for data_b
plot_b <- ggplot(data_b, aes(x = IncomeCleaned)) +
geom_histogram(binwidth = 50000, fill = "sandybrown", color = "black") +
labs(title = "Income Distribution in data_b", x = "Income", y = "Count") +
theme_minimal()
# Create a histogram for data_c
plot_c <- ggplot(data_c, aes(x = IncomeCleaned)) +
geom_histogram(binwidth = 1000, fill = "slategray1", color = "black") +
labs(title = "Income Distribution in data_c", x = "Income", y = "Count") +
theme_minimal()
# Combine the plots into a single layout
grid.arrange(plot_a, plot_b, plot_c, ncol = 2)
data_a$IncomeCleaned <- NULL
data_b$IncomeCleaned <- NULL
data_c$IncomeCleaned <- NULLApproval Analysis (Shared by A, B, C)
# Function to create the summary table for the Approved column
create_summary_table <- function(df, dataset_name) {
summary <- df %>%
summarise(
IsRejected = sum(Approved == 0),
IsApproved = sum(Approved == 1),
Average = round(mean(Approved), 3)
) %>%
mutate(Dataset = dataset_name) %>%
dplyr::select(Dataset, everything())
return(summary)
}
data_table <- data.frame(
Dataset = factor(rep(c("A", "B", "C"), each = 2)),
Category = factor(rep(c("IsRejected", "IsApproved"), times = 3)),
DataPoints = c(
100*sum(data_a$Approved == 0) / nrow(data_a),100*sum(data_a$Approved == 1) / nrow(data_a),
100*sum(data_b$Approved == 0) / nrow(data_b),100*sum(data_b$Approved == 1) / nrow(data_b),
100*sum(data_c$Approved == 0) / nrow(data_c),100*sum(data_c$Approved == 1) / nrow(data_c)
)
)
# Apply the function to each dataframe
# Combine the summaries into one table
#summary_combined <- bind_rows(create_summary_table(data_a, "Dataset A"), create_summary_table(data_b, "Dataset B"), create_summary_table(data_c, "Dataset C"))
# Print the combined summary table
#print(summary_combined)
ggplot(data_table, aes(x = Dataset, y = DataPoints, fill = Category)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("IsRejected" = "red2", "IsApproved" = "seagreen4")) +
ggtitle("Percentage of Applications Approved/Rejected") +
xlab("Dataset") +
ylab("Percentage") +
theme_minimal() +
theme(legend.title = element_blank())
data_table <- data.frame(
Dataset = factor(rep(c("A", "B", "C"), each = 4)),
Category = factor(rep(c("IsRejectedMale", "IsApprovedMale", "IsRejectedNonMale", "IsApprovedNonMale"), times = 3)),
DataPoints = c(
100*sum(data_a$Approved == 0 & data_a$Gender == 1) / nrow(data_a),
100*sum(data_a$Approved == 1 & data_a$Gender == 1) / nrow(data_a),
100*sum(data_a$Approved == 0 & data_a$Gender == 0) / nrow(data_a),
100*sum(data_a$Approved == 1 & data_a$Gender == 0) / nrow(data_a),
100*sum(data_b$Approved == 0 & data_b$Gender == 1) / nrow(data_b),
100*sum(data_b$Approved == 1 & data_b$Gender == 1) / nrow(data_b),
100*sum(data_b$Approved == 0 & data_b$Gender == 0) / nrow(data_b),
100*sum(data_b$Approved == 1 & data_b$Gender == 0) / nrow(data_b),
100*sum(data_c$Approved == 0 & data_c$Gender == 1) / nrow(data_c),
100*sum(data_c$Approved == 1 & data_c$Gender == 1) / nrow(data_c),
100*sum(data_c$Approved == 0 & data_c$Gender == 0) / nrow(data_c),
100*sum(data_c$Approved == 1 & data_c$Gender == 0) / nrow(data_c)
)
)
ggplot(data_table, aes(x = Dataset, y = DataPoints, fill = Category)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("IsRejectedMale" = "maroon1", "IsApprovedMale" = "springgreen2", "IsRejectedNonMale" = "red2", "IsApprovedNonMale" = "seagreen4")) +
ggtitle("Percentage of Applications Approved/Rejected (By Gender)") +
xlab("Dataset") +
ylab("Percentage") +
theme_minimal() +
theme(legend.title = element_blank())
data_table <- data.frame(
Dataset = factor(rep(c("B"), each = 2)),
Category = factor(rep(c("IsRejectedMale", "IsRejectedNonMale"), times = 1)),
DataPoints = c(
100*sum(data_b$Approved == 0 & data_b$Gender == 1) / sum(data_b$Approved == 0),
100*sum(data_b$Approved == 0 & data_b$Gender == 0) / sum(data_b$Approved == 0)
)
)
ggplot(data_table, aes(x = Dataset, y = DataPoints, fill = Category)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("IsRejectedMale" = "maroon1", "IsRejectedNonMale" = "red2")) +
ggtitle("Dataset B (Rejected Applications by Gender)") +
xlab("Dataset") +
ylab("Percentage") +
theme_minimal() +
theme(legend.title = element_blank())
Married Analysis (Shared by A, B, C)
# Function to create the summary table for the Approved column
create_summary_table <- function(df, dataset_name) {
summary <- df %>%
summarise(
IsRejected = sum(Married == 0),
IsApproved = sum(Married == 1),
Average = round(mean(Married), 3)
) %>%
mutate(Dataset = dataset_name) %>%
dplyr::select(Dataset, everything())
return(summary)
}
data_table <- data.frame(
Dataset = factor(rep(c("A", "B", "C"), each = 2)),
Category = factor(rep(c("IsNotMarried", "IsMarried"), times = 3)),
DataPoints = c(
100*sum(data_a$Married == 0) / nrow(data_a),100*sum(data_a$Married == 1) / nrow(data_a),
100*sum(data_b$Married == 0) / nrow(data_b),100*sum(data_b$Married == 1) / nrow(data_b),
100*sum(data_c$Married == 0) / nrow(data_c),100*sum(data_c$Married == 1) / nrow(data_c)
)
)
ggplot(data_table, aes(x = Dataset, y = DataPoints, fill = Category)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("IsNotMarried" = "thistle1", "IsMarried" = "steelblue3")) +
ggtitle("Applicant Marriage Status") +
xlab("Dataset") +
ylab("Percentage") +
theme_minimal() +
theme(legend.title = element_blank())
Dependents Analysis (Shared by B, C)
# Dependents Analysis
data_table <- data.frame(
Dataset = factor(rep(c("B", "C"), each = 4)),
Category = factor(rep(c("NoDependents", "Dependents_1", "Dependents_2", "Dependents_3Plus"), times = 2)),
DataPoints = c(
100*sum(data_b$Dependents == 0) / nrow(data_b),
100*sum(data_b$Dependents == 1) / nrow(data_b),
100*sum(data_b$Dependents == 2) / nrow(data_b),
100*sum(data_b$Dependents == 3) / nrow(data_b),
100*sum(data_c$Dependents == 0) / nrow(data_c),
100*sum(data_c$Dependents == 1) / nrow(data_c),
100*sum(data_c$Dependents == 2) / nrow(data_c),
100*sum(data_c$Dependents == 3) / nrow(data_c)
)
)
ggplot(data_table, aes(x = Dataset, y = DataPoints, fill = Category)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("NoDependents" = "thistle1", "Dependents_1" = "steelblue3", "Dependents_2" = "springgreen1", "Dependents_3Plus" = "seashell1")) +
ggtitle("Applicant Dependents") +
xlab("Dataset") +
ylab("Percentage") +
theme_minimal() +
theme(legend.title = element_blank())
Age/Debt Distribution (Shared by A, B)
# Create a histogram for data_a
plot_a <- ggplot(data_a, aes(x = Age)) +
geom_histogram(binwidth = 4, fill = "steelblue3", color = "black") +
labs(title = "Age Distribution in Dataset A", x = "Age", y = "Count") +
theme_minimal()
# Create a histogram for data_b
plot_b <- ggplot(data_b, aes(x = Age)) +
geom_histogram(binwidth = 4, fill = "seagreen4", color = "black") +
labs(title = "Age Distribution in Dataset B", x = "Age", y = "Count") +
theme_minimal()
plot_a2 <- ggplot(data_a, aes(x = Debt)) +
geom_histogram(binwidth = 1, fill = "steelblue3", color = "black") +
labs(title = "Debt Distribution in Dataset A", x = "Debt", y = "Count") +
theme_minimal()
# Create a histogram for data_b
plot_b2 <- ggplot(data_b, aes(x = Debt)) +
geom_histogram(binwidth = 1, fill = "seagreen4", color = "black") +
labs(title = "Debt Distribution in Dataset B", x = "Debt", y = "Count") +
theme_minimal()
# Combine the plots into a single layout
grid.arrange(plot_a, plot_b, plot_a2, plot_b2, ncol = 2)
# Summarize the "Income" column for each dataframe
summary_a <- data_a %>%
summarise(
Min = min(Age, na.rm = TRUE),
Median = median(Age, na.rm = TRUE),
Mean = mean(Age, na.rm = TRUE),
Max = max(Age, na.rm = TRUE)
) %>%
mutate(Dataset = "data_a")
summary_b <- data_b %>%
summarise(
Min = min(Age, na.rm = TRUE),
Median = median(Age, na.rm = TRUE),
Mean = mean(Age, na.rm = TRUE),
Max = max(Age, na.rm = TRUE)
) %>%
mutate(Dataset = "data_b")
# Combine the summaries
summary_table <- bind_rows(summary_a, summary_b) %>%
dplyr::select(Dataset, Min, Median, Mean, Max)
# Print the summary table with kableExtra styling
summary_table %>%
kbl(caption = "Summary Statistics for Age") %>%
kable_styling()| Dataset | Min | Median | Mean | Max |
|---|---|---|---|---|
| data_a | 13.75 | 28.46 | 31.51412 | 80.25 |
| data_b | 21.00 | 40.00 | 40.99550 | 68.00 |
Graduate Analysis (Shared by B, C)
# IsGraduate Analysis
data_table <- data.frame(
Dataset = factor(rep(c("B", "C"), each = 2)),
Category = factor(rep(c("NotGraduate", "Graduate"), times = 2)),
DataPoints = c(
100*sum(data_b$IsGraduate == 0) / nrow(data_b),
100*sum(data_b$IsGraduate == 1) / nrow(data_b),
100*sum(data_c$IsGraduate == 0) / nrow(data_c),
100*sum(data_c$IsGraduate == 1) / nrow(data_c)
)
)
ggplot(data_table, aes(x = Dataset, y = DataPoints, fill = Category)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("NotGraduate" = "thistle1", "Graduate" = "steelblue3")) +
ggtitle("Graduate Ratio in Datasets") +
xlab("Dataset") +
ylab("Percentage") +
theme_minimal() +
theme(legend.title = element_blank())
Models
Dataset A - Logistical Regression
We first try to fit a simple logistical regression model to all of them. After a simple model was tried, we use stepwise selection in both direction to help find an optimal model. These are exploratory models to give us a good idea of possible predictors and responses.
# Fit a linear model to all features
model <- glm(Approved ~ ., family = binomial, data = data_a)
# Perform stepwise selection
stepwise_model <- stepAIC(model, direction = "both")Start: AIC=465.56
Approved ~ Gender + Age + Debt + Married + BankCustomer + Industry +
Ethnicity + YearsEmployed + PriorDefault + Employed + CreditScore +
DriversLicense + Citizen + ZipCode + Income
Df Deviance AIC
- Industry 13 422.06 460.06
- Ethnicity 4 404.15 460.15
- Gender 1 401.56 463.56
- Age 1 401.61 463.61
- DriversLicense 1 402.02 464.02
- YearsEmployed 1 402.46 464.46
- Debt 1 402.51 464.51
- Married 1 402.90 464.90
- BankCustomer 1 403.49 465.49
<none> 401.56 465.56
- Employed 1 403.88 465.88
- CreditScore 1 406.21 468.21
- ZipCode 1 408.82 470.82
- Citizen 2 411.81 471.81
- Income 1 417.61 479.61
- PriorDefault 1 579.31 641.31
Step: AIC=460.06
Approved ~ Gender + Age + Debt + Married + BankCustomer + Ethnicity +
YearsEmployed + PriorDefault + Employed + CreditScore + DriversLicense +
Citizen + ZipCode + Income
Df Deviance AIC
- Age 1 422.06 458.06
- Gender 1 422.15 458.15
- Debt 1 422.45 458.45
- DriversLicense 1 422.68 458.68
- YearsEmployed 1 423.82 459.82
<none> 422.06 460.06
- ZipCode 1 425.69 461.69
- CreditScore 1 426.19 462.19
- Employed 1 427.02 463.02
+ Industry 13 401.56 465.56
- Married 1 430.31 466.31
- Ethnicity 4 436.44 466.44
- BankCustomer 1 431.71 467.71
- Citizen 2 434.04 468.04
- Income 1 440.90 476.90
- PriorDefault 1 613.60 649.60
Step: AIC=458.06
Approved ~ Gender + Debt + Married + BankCustomer + Ethnicity +
YearsEmployed + PriorDefault + Employed + CreditScore + DriversLicense +
Citizen + ZipCode + Income
Df Deviance AIC
- Gender 1 422.15 456.15
- Debt 1 422.45 456.45
- DriversLicense 1 422.69 456.69
- YearsEmployed 1 423.93 457.93
<none> 422.06 458.06
- ZipCode 1 425.69 459.69
+ Age 1 422.06 460.06
- CreditScore 1 426.21 460.21
- Employed 1 427.10 461.10
+ Industry 13 401.61 463.61
- Married 1 430.48 464.48
- Ethnicity 4 437.35 465.35
- BankCustomer 1 431.85 465.85
- Citizen 2 434.17 466.17
- Income 1 440.99 474.99
- PriorDefault 1 616.33 650.33
Step: AIC=456.15
Approved ~ Debt + Married + BankCustomer + Ethnicity + YearsEmployed +
PriorDefault + Employed + CreditScore + DriversLicense +
Citizen + ZipCode + Income
Df Deviance AIC
- Debt 1 422.53 454.53
- DriversLicense 1 422.78 454.78
<none> 422.15 456.15
- YearsEmployed 1 424.16 456.16
- ZipCode 1 425.73 457.73
+ Gender 1 422.06 458.06
+ Age 1 422.15 458.15
- CreditScore 1 426.28 458.28
- Employed 1 427.16 459.16
+ Industry 13 401.61 461.61
- Married 1 430.49 462.49
- Ethnicity 4 437.50 463.50
- BankCustomer 1 431.85 463.85
- Citizen 2 434.27 464.27
- Income 1 441.08 473.08
- PriorDefault 1 616.37 648.37
Step: AIC=454.53
Approved ~ Married + BankCustomer + Ethnicity + YearsEmployed +
PriorDefault + Employed + CreditScore + DriversLicense +
Citizen + ZipCode + Income
Df Deviance AIC
- DriversLicense 1 423.16 453.16
- YearsEmployed 1 424.38 454.38
<none> 422.53 454.53
- ZipCode 1 425.79 455.79
+ Debt 1 422.15 456.15
+ Gender 1 422.45 456.45
- CreditScore 1 426.46 456.46
+ Age 1 422.53 456.53
- Employed 1 427.63 457.63
+ Industry 13 402.55 460.55
- Married 1 431.08 461.08
- Ethnicity 4 437.95 461.95
- BankCustomer 1 432.41 462.41
- Citizen 2 435.27 463.27
- Income 1 441.37 471.37
- PriorDefault 1 618.46 648.46
Step: AIC=453.16
Approved ~ Married + BankCustomer + Ethnicity + YearsEmployed +
PriorDefault + Employed + CreditScore + Citizen + ZipCode +
Income
Df Deviance AIC
- YearsEmployed 1 424.77 452.77
<none> 423.16 453.16
+ DriversLicense 1 422.53 454.53
+ Debt 1 422.78 454.78
- CreditScore 1 426.86 454.86
- ZipCode 1 427.05 455.05
+ Gender 1 423.07 455.07
+ Age 1 423.15 455.15
- Employed 1 428.58 456.58
+ Industry 13 403.02 459.02
- Married 1 431.47 459.47
- Ethnicity 4 438.54 460.54
- BankCustomer 1 432.82 460.82
- Citizen 2 436.54 462.54
- Income 1 442.43 470.43
- PriorDefault 1 618.89 646.89
Step: AIC=452.77
Approved ~ Married + BankCustomer + Ethnicity + PriorDefault +
Employed + CreditScore + Citizen + ZipCode + Income
Df Deviance AIC
<none> 424.77 452.77
+ YearsEmployed 1 423.16 453.16
+ DriversLicense 1 424.38 454.38
+ Debt 1 424.55 454.55
+ Gender 1 424.56 454.56
+ Age 1 424.67 454.67
- ZipCode 1 428.74 454.74
- CreditScore 1 429.41 455.41
- Employed 1 429.96 455.96
+ Industry 13 403.76 457.76
- Married 1 434.23 460.23
- BankCustomer 1 435.61 461.61
- Ethnicity 4 441.96 461.96
- Citizen 2 438.00 462.00
- Income 1 443.96 469.96
- PriorDefault 1 645.03 671.03# Print the summary of the model
summary(stepwise_model)
Call:
glm(formula = Approved ~ Married + BankCustomer + Ethnicity +
PriorDefault + Employed + CreditScore + Citizen + ZipCode +
Income, family = binomial, data = data_a)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -4.271e+00 5.808e-01 -7.354 1.92e-13 ***
Married -1.902e+01 6.663e+02 -0.029 0.977224
BankCustomer 1.976e+01 6.663e+02 0.030 0.976340
EthnicityBlack 1.187e+00 4.909e-01 2.417 0.015639 *
EthnicityLatino -1.176e+00 7.325e-01 -1.606 0.108302
EthnicityOther 1.063e+00 8.188e-01 1.298 0.194187
EthnicityWhite 6.218e-01 4.310e-01 1.443 0.149125
PriorDefault 3.668e+00 3.089e-01 11.873 < 2e-16 ***
Employed 7.907e-01 3.463e-01 2.283 0.022433 *
CreditScore 1.028e-01 5.406e-02 1.902 0.057116 .
CitizenByOtherMeans 1.454e-01 4.418e-01 0.329 0.742014
CitizenTemporary 3.225e+00 8.379e-01 3.848 0.000119 ***
ZipCode -1.521e-03 7.741e-04 -1.964 0.049480 *
Income 5.499e-04 1.686e-04 3.261 0.001109 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 948.16 on 689 degrees of freedom
Residual deviance: 424.77 on 676 degrees of freedom
AIC: 452.77
Number of Fisher Scoring iterations: 14Dataset B - Logistical Regression
We first used regular logistical regression, and then step-wise logistical regression. After both failed to converge, we used L2 and L1 regularization for dataset B to select the best factors, and then refit them to a standard model.
# Fit a linear model to all features
model <- glm(Approved ~ ., family = binomial, data = data_b)
# Print the summary of the model
summary(model)
Call:
glm(formula = Approved ~ ., family = binomial, data = data_b)
Coefficients: (4 not defined because of singularities)
Estimate Std. Error z value
(Intercept) -1.248e+02 4.869e+04 -0.003
Owned_Car -2.329e-01 3.141e+02 -0.001
Owned_Realty 2.135e-01 3.041e+02 0.001
Dependents 1.504e+00 5.145e+02 0.003
Income -1.767e-06 1.224e-03 -0.001
Income_TypePensioner -8.187e+00 1.040e+05 0.000
Income_TypeState servant 7.404e-01 5.251e+02 0.001
Income_TypeStudent -3.576e+02 6.590e+04 -0.005
Income_TypeWorking 4.518e-01 3.058e+02 0.001
Education_TypeHigher education 1.148e+02 4.800e+04 0.002
Education_TypeIncomplete higher 1.187e+02 4.808e+04 0.002
Education_TypeLower secondary 1.178e+02 4.943e+04 0.002
Education_TypeSecondary / secondary special 1.144e+02 4.800e+04 0.002
Housing_TypeHouse / apartment -2.801e+00 8.035e+03 0.000
Housing_TypeMunicipal apartment -3.203e+00 8.075e+03 0.000
Housing_TypeOffice apartment -3.270e+01 8.444e+03 -0.004
Housing_TypeRented apartment 2.268e+00 1.146e+04 0.000
Housing_TypeWith parents -2.568e+00 8.041e+03 0.000
Owned_Mobile_Phone NA NA NA
Owned_Work_Phone -2.632e-01 3.274e+02 -0.001
Owned_Phone -6.673e-01 3.212e+02 -0.002
Owned_Email 3.598e-02 4.417e+02 0.000
Job_TitleCleaning staff 1.138e+00 1.843e+03 0.001
Job_TitleCooking staff 1.059e+00 8.280e+02 0.001
Job_TitleCore staff 4.235e-01 6.936e+02 0.001
Job_TitleDrivers 1.487e+00 7.953e+02 0.002
Job_TitleHigh skill tech staff 1.206e+02 6.048e+04 0.002
Job_TitleHR staff -2.576e+01 1.831e+04 -0.001
Job_TitleIT staff -3.008e+01 2.833e+03 -0.011
Job_TitleLaborers 1.284e+00 7.366e+02 0.002
Job_TitleLow-skill Laborers 1.432e+00 4.765e+03 0.000
Job_TitleManagers 8.087e-01 7.695e+02 0.001
Job_TitleMedicine staff -4.307e-01 7.195e+02 -0.001
Job_TitlePrivate service staff 3.063e+00 3.780e+03 0.001
Job_TitleRealty agents -2.588e+01 1.429e+04 -0.002
Job_TitleSales staff 1.042e+00 7.331e+02 0.001
Job_TitleSecretaries -1.121e+00 1.485e+03 -0.001
Job_TitleSecurity staff 2.348e+00 9.261e+02 0.003
Job_TitleWaiters/barmen staff 3.224e+00 3.420e+03 0.001
Total_Family_Members -1.166e+00 4.444e+02 -0.003
Age 8.388e-03 1.693e+01 0.000
YearsEmployed 4.095e-02 2.862e+01 0.001
Total_Bad_Debt -3.075e+01 2.390e+02 -0.129
Total_Good_Debt 3.032e+01 2.365e+02 0.128
Gender -4.950e-01 3.492e+02 -0.001
Debt NA NA NA
IncomeScaled NA NA NA
Married 5.530e-01 3.642e+02 0.002
IsGraduate NA NA NA
Pr(>|z|)
(Intercept) 0.998
Owned_Car 0.999
Owned_Realty 0.999
Dependents 0.998
Income 0.999
Income_TypePensioner 1.000
Income_TypeState servant 0.999
Income_TypeStudent 0.996
Income_TypeWorking 0.999
Education_TypeHigher education 0.998
Education_TypeIncomplete higher 0.998
Education_TypeLower secondary 0.998
Education_TypeSecondary / secondary special 0.998
Housing_TypeHouse / apartment 1.000
Housing_TypeMunicipal apartment 1.000
Housing_TypeOffice apartment 0.997
Housing_TypeRented apartment 1.000
Housing_TypeWith parents 1.000
Owned_Mobile_Phone NA
Owned_Work_Phone 0.999
Owned_Phone 0.998
Owned_Email 1.000
Job_TitleCleaning staff 1.000
Job_TitleCooking staff 0.999
Job_TitleCore staff 1.000
Job_TitleDrivers 0.999
Job_TitleHigh skill tech staff 0.998
Job_TitleHR staff 0.999
Job_TitleIT staff 0.992
Job_TitleLaborers 0.999
Job_TitleLow-skill Laborers 1.000
Job_TitleManagers 0.999
Job_TitleMedicine staff 1.000
Job_TitlePrivate service staff 0.999
Job_TitleRealty agents 0.999
Job_TitleSales staff 0.999
Job_TitleSecretaries 0.999
Job_TitleSecurity staff 0.998
Job_TitleWaiters/barmen staff 0.999
Total_Family_Members 0.998
Age 1.000
YearsEmployed 0.999
Total_Bad_Debt 0.898
Total_Good_Debt 0.898
Gender 0.999
Debt NA
IncomeScaled NA
Married 0.999
IsGraduate NA
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 1.5327e+03 on 25127 degrees of freedom
Residual deviance: 5.7611e-05 on 25083 degrees of freedom
AIC: 90
Number of Fisher Scoring iterations: 25x_b <- as.matrix(data_b[, -ncol(data_b)]) # Predictors
y_b <- data_b$Approved # Response
# Lasso fit the model
lasso_model_a <- cv.glmnet(x_b, y_b, family = "binomial", alpha = 1)
lasso_coefs <- coef(lasso_model_a)
print(lasso_coefs)23 x 1 sparse Matrix of class "dgCMatrix"
s1
(Intercept) -2.546985e+00
Owned_Car -9.324486e-02
Owned_Realty 1.056008e-01
Dependents 2.066383e-01
Income .
Income_Type .
Education_Type .
Housing_Type .
Owned_Mobile_Phone .
Owned_Work_Phone .
Owned_Phone .
Owned_Email -1.181754e-01
Job_Title .
Total_Family_Members -2.160249e-02
Age 5.229434e-03
YearsEmployed 2.648987e-03
Total_Bad_Debt -7.722422e+00
Total_Good_Debt 7.627183e+00
Gender -1.800203e-01
Debt .
IncomeScaled -9.554322e-06
Married -1.181283e-01
IsGraduate . # Extract the non-zero coefficients (excluding the intercept)
lasso_coefs_matrix <- as.matrix(lasso_coefs)
selected_vars <- rownames(lasso_coefs_matrix)[lasso_coefs_matrix[, 1] != 0]
selected_vars <- selected_vars[selected_vars != "(Intercept)"]
print(selected_vars) [1] "Owned_Car" "Owned_Realty" "Dependents"
[4] "Owned_Email" "Total_Family_Members" "Age"
[7] "YearsEmployed" "Total_Bad_Debt" "Total_Good_Debt"
[10] "Gender" "IncomeScaled" "Married" # Fit back in OLS model to get p-values
data <- as.data.frame(x_b)
data$y <- y_b
# Convert data back to nice data
can_convert_to_numeric <- function(x) {
!any(is.na(as.numeric(x)))
}
data <- data %>%
mutate(across(where(~ can_convert_to_numeric(.)), as.numeric))
# Create a formula for the OLS model using the selected variables
formula <- as.formula(paste("y ~", paste(selected_vars, collapse = " + ")))
print(formula)y ~ Owned_Car + Owned_Realty + Dependents + Owned_Email + Total_Family_Members +
Age + YearsEmployed + Total_Bad_Debt + Total_Good_Debt +
Gender + IncomeScaled + Married# Fit back to the model
new_model <- lm(formula = formula, data = data, family = binomial)
# Summary of the model to get p-values
summary(new_model)
Call:
lm(formula = formula, data = data, family = binomial)
Residuals:
Min 1Q Median 3Q Max
-0.97564 -0.00503 0.00046 0.00423 0.60307
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 9.956e-01 2.920e-03 340.993 <2e-16 ***
Owned_Car -3.478e-04 8.513e-04 -0.409 0.683
Owned_Realty -3.941e-04 8.210e-04 -0.480 0.631
Dependents 2.537e-03 1.668e-03 1.521 0.128
Owned_Email -1.716e-03 1.296e-03 -1.324 0.186
Total_Family_Members -1.454e-03 1.548e-03 -0.939 0.348
Age -1.070e-05 4.530e-05 -0.236 0.813
YearsEmployed 6.273e-05 6.454e-05 0.972 0.331
Total_Bad_Debt -2.031e-02 2.464e-04 -82.418 <2e-16 ***
Total_Good_Debt 4.022e-04 2.647e-05 15.193 <2e-16 ***
Gender -1.177e-03 8.670e-04 -1.358 0.175
IncomeScaled 3.756e-08 6.059e-08 0.620 0.535
Married 6.367e-04 1.400e-03 0.455 0.649
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.06124 on 25115 degrees of freedom
Multiple R-squared: 0.2179, Adjusted R-squared: 0.2175
F-statistic: 583.2 on 12 and 25115 DF, p-value: < 2.2e-16Dataset C - Logistical Regression
Fitting a logistical regression model to dataset C works decently after following stepwise selection, much like dataset A’s logistical regression model.
# Fit a linear model to all features
model <- glm(Approved ~ ., family = binomial, data = data_c)
# Perform stepwise selection
stepwise_model <- stepAIC(model, direction = "both")Start: AIC=391.55
Approved ~ Gender + Married + Dependents + Education + Self_Employed +
ApplicantIncome + CoapplicantIncome + LoanAmount + Loan_Amount_Term +
Credit_History + Property_Area + Income + IsGraduate
Step: AIC=391.55
Approved ~ Gender + Married + Dependents + Education + Self_Employed +
ApplicantIncome + CoapplicantIncome + LoanAmount + Loan_Amount_Term +
Credit_History + Property_Area + Income
Step: AIC=391.55
Approved ~ Gender + Married + Dependents + Education + Self_Employed +
ApplicantIncome + CoapplicantIncome + LoanAmount + Loan_Amount_Term +
Credit_History + Property_Area
Df Deviance AIC
- Gender 1 365.55 389.55
- Self_Employed 1 365.67 389.67
- CoapplicantIncome 1 365.78 389.78
- Dependents 1 365.93 389.93
- ApplicantIncome 1 366.22 390.22
- Education 1 366.64 390.64
- LoanAmount 1 367.47 391.47
<none> 365.55 391.55
- Loan_Amount_Term 1 367.86 391.86
- Married 1 368.54 392.54
- Property_Area 2 375.27 397.27
- Credit_History 1 439.76 463.76
Step: AIC=389.55
Approved ~ Married + Dependents + Education + Self_Employed +
ApplicantIncome + CoapplicantIncome + LoanAmount + Loan_Amount_Term +
Credit_History + Property_Area
Df Deviance AIC
- Self_Employed 1 365.68 387.68
- CoapplicantIncome 1 365.78 387.78
- Dependents 1 365.93 387.93
- ApplicantIncome 1 366.22 388.22
- Education 1 366.65 388.65
- LoanAmount 1 367.47 389.47
<none> 365.55 389.55
- Loan_Amount_Term 1 367.88 389.88
- Married 1 368.87 390.87
+ Gender 1 365.55 391.55
- Property_Area 2 375.44 395.44
- Credit_History 1 440.84 462.84
Step: AIC=387.68
Approved ~ Married + Dependents + Education + ApplicantIncome +
CoapplicantIncome + LoanAmount + Loan_Amount_Term + Credit_History +
Property_Area
Df Deviance AIC
- CoapplicantIncome 1 365.90 385.90
- Dependents 1 366.07 386.07
- ApplicantIncome 1 366.50 386.50
- Education 1 366.78 386.78
- LoanAmount 1 367.60 387.60
<none> 365.68 387.68
- Loan_Amount_Term 1 367.96 387.96
- Married 1 368.99 388.99
+ Self_Employed 1 365.55 389.55
+ Gender 1 365.67 389.67
- Property_Area 2 375.52 393.52
- Credit_History 1 440.97 460.97
Step: AIC=385.9
Approved ~ Married + Dependents + Education + ApplicantIncome +
LoanAmount + Loan_Amount_Term + Credit_History + Property_Area
Df Deviance AIC
- Dependents 1 366.27 384.27
- ApplicantIncome 1 366.56 384.56
- Education 1 366.96 384.96
- LoanAmount 1 367.64 385.64
<none> 365.90 385.90
- Loan_Amount_Term 1 368.12 386.12
- Married 1 369.14 387.14
+ CoapplicantIncome 1 365.68 387.68
+ Income 1 365.68 387.68
+ Self_Employed 1 365.78 387.78
+ Gender 1 365.90 387.90
- Property_Area 2 375.85 391.85
- Credit_History 1 441.00 459.00
Step: AIC=384.27
Approved ~ Married + Education + ApplicantIncome + LoanAmount +
Loan_Amount_Term + Credit_History + Property_Area
Df Deviance AIC
- ApplicantIncome 1 367.11 383.11
- Education 1 367.46 383.46
- LoanAmount 1 368.00 384.00
<none> 366.27 384.27
- Loan_Amount_Term 1 368.41 384.41
- Married 1 369.17 385.17
+ Dependents 1 365.90 385.90
+ CoapplicantIncome 1 366.07 386.07
+ Income 1 366.07 386.07
+ Self_Employed 1 366.13 386.13
+ Gender 1 366.26 386.26
- Property_Area 2 375.98 389.98
- Credit_History 1 441.24 457.24
Step: AIC=383.11
Approved ~ Married + Education + LoanAmount + Loan_Amount_Term +
Credit_History + Property_Area
Df Deviance AIC
- Education 1 368.23 382.23
- LoanAmount 1 368.29 382.29
- Loan_Amount_Term 1 368.90 382.90
<none> 367.11 383.11
+ ApplicantIncome 1 366.27 384.27
- Married 1 370.29 384.29
+ Dependents 1 366.56 384.56
+ Income 1 366.68 384.68
+ Self_Employed 1 366.80 384.80
+ CoapplicantIncome 1 367.08 385.08
+ Gender 1 367.10 385.10
- Property_Area 2 377.08 389.08
- Credit_History 1 441.33 455.33
Step: AIC=382.23
Approved ~ Married + LoanAmount + Loan_Amount_Term + Credit_History +
Property_Area
Df Deviance AIC
- LoanAmount 1 369.53 381.53
- Loan_Amount_Term 1 369.82 381.82
<none> 368.23 382.23
+ Education 1 367.11 383.11
+ IsGraduate 1 367.11 383.11
- Married 1 371.23 383.23
+ ApplicantIncome 1 367.46 383.46
+ Dependents 1 367.54 383.54
+ Income 1 367.89 383.89
+ Self_Employed 1 367.92 383.92
+ Gender 1 368.19 384.19
+ CoapplicantIncome 1 368.22 384.22
- Property_Area 2 378.47 388.47
- Credit_History 1 442.54 454.54
Step: AIC=381.53
Approved ~ Married + Loan_Amount_Term + Credit_History + Property_Area
Df Deviance AIC
- Loan_Amount_Term 1 370.85 380.85
<none> 369.53 381.53
+ LoanAmount 1 368.23 382.23
+ Education 1 368.29 382.29
+ IsGraduate 1 368.29 382.29
+ Dependents 1 368.92 382.92
+ Self_Employed 1 369.29 383.29
+ ApplicantIncome 1 369.29 383.29
- Married 1 373.32 383.32
+ Income 1 369.46 383.46
+ Gender 1 369.49 383.49
+ CoapplicantIncome 1 369.53 383.53
- Property_Area 2 379.75 387.75
- Credit_History 1 443.07 453.07
Step: AIC=380.85
Approved ~ Married + Credit_History + Property_Area
Df Deviance AIC
<none> 370.85 380.85
+ Loan_Amount_Term 1 369.53 381.53
+ LoanAmount 1 369.82 381.82
+ Education 1 369.83 381.83
+ IsGraduate 1 369.83 381.83
+ Dependents 1 370.37 382.37
+ Self_Employed 1 370.68 382.68
+ ApplicantIncome 1 370.73 382.73
+ Income 1 370.81 382.81
+ Gender 1 370.84 382.84
+ CoapplicantIncome 1 370.85 382.85
- Married 1 375.42 383.42
- Property_Area 2 380.54 386.54
- Credit_History 1 443.87 451.87# Print the summary of the stepwise model
summary(stepwise_model)
Call:
glm(formula = Approved ~ Married + Credit_History + Property_Area,
family = binomial, data = data_c)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.5100 0.3516 -4.294 1.75e-05 ***
Married 0.5600 0.2628 2.131 0.03308 *
Credit_History 2.2964 0.2847 8.067 7.19e-16 ***
Property_AreaSemiurban 0.9664 0.3229 2.993 0.00276 **
Property_AreaUrban 0.3168 0.3143 1.008 0.31358
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 457.96 on 380 degrees of freedom
Residual deviance: 370.85 on 376 degrees of freedom
AIC: 380.85
Number of Fisher Scoring iterations: 4Dataset A - RF Prediction Model
For the sake of completeness, we’ll now try to fit a prediction model against the three different datasets. All three models with be random forest models, mostly due to the huge class imbalance present in dataset B.
We start with the first dataset A. For tuning the parameters, we’ll use K-fold cross-validation as well as split the data between training and test sets. The test set will be used for the final accuracy calculation.
# Transform
cur_data <- data_a
cur_data$Approved <- factor(cur_data$Approved, levels = c(0, 1))
# Partition
trainIndex <- createDataPartition(cur_data$Approved, p = 0.8, list = FALSE)
data_train <- cur_data[trainIndex, ]
data_test <- cur_data[-trainIndex, ]
# Autotune using cross-validation. We do 5-fold cross-validation.
train_control <- trainControl(method = "cv", number = 5)
tune_grid <- expand.grid(.mtry = 1:3, ntree = 16)
# Train the random forest model
#rf_model <- randomForest(Approved ~ ., data = data_train, ntree = 250)
rf_model <- train(
Approved ~ .,
data = data_train,
method = "rf",
trControl = train_control,
tune_grid = tune_grid,
tuneLength = 5, # This instructs caret to try different settings for mtry
)
print(rf_model)Random Forest
553 samples
15 predictor
2 classes: '0', '1'
No pre-processing
Resampling: Cross-Validated (5 fold)
Summary of sample sizes: 443, 441, 442, 443, 443
Resampling results across tuning parameters:
mtry Accuracy Kappa
2 0.8606514 0.7143294
9 0.8697745 0.7370999
16 0.8589631 0.7152954
23 0.8534925 0.7052184
31 0.8553592 0.7091481
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was mtry = 9.plot(rf_model)
# Predict on the testing set
predictions <- predict(rf_model, newdata = data_test)
predictions <- factor(predictions, levels = c(0, 1))
actual_values <- factor(data_test$Approved, levels = c(0, 1))
# Create a confusion matrix
confusion_matrix <- confusionMatrix(predictions, actual_values)
print(confusion_matrix)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 70 8
1 6 53
Accuracy : 0.8978
95% CI : (0.8345, 0.943)
No Information Rate : 0.5547
P-Value [Acc > NIR] : <2e-16
Kappa : 0.7925
Mcnemar's Test P-Value : 0.7893
Sensitivity : 0.9211
Specificity : 0.8689
Pos Pred Value : 0.8974
Neg Pred Value : 0.8983
Prevalence : 0.5547
Detection Rate : 0.5109
Detection Prevalence : 0.5693
Balanced Accuracy : 0.8950
'Positive' Class : 0
# Extract accuracy
accuracy <- confusion_matrix$overall['Accuracy']
print(paste("Accuracy: ", accuracy))[1] "Accuracy: 0.897810218978102"Dataset B - RF Prediction Model
Now we’ll fit a model to dataset B. This time, instead of cross-validation, we’ll use a simple validation set derived from the training set. We’ll select the model that has the best validation set accuracy and run the final test set on it. We do not use cross-validation and auto-tuning due to the added computational time from the dataset size.
# Transform
cur_data <- data_b
cur_data$Approved <- factor(cur_data$Approved, levels = c(0, 1))
# Partition
trainIndex <- createDataPartition(cur_data$Approved, p = 0.8, list = FALSE)
data_train_full <- cur_data[trainIndex, ]
data_test <- cur_data[-trainIndex, ]
# Partition further
trainIndex2 <- createDataPartition(data_train_full$Approved, p = 0.8, list = FALSE)
data_train <- data_train_full[trainIndex2, ]
data_val <- data_train_full[-trainIndex2, ]
evaluate_model <- function(model, data_val) {
set.seed(200)
predictions <- predict(model, newdata = data_val)
predictions <- factor(predictions, levels = c(0, 1))
confusion_matrix <- confusionMatrix(predictions, data_val$Approved)
return(confusion_matrix$overall['Accuracy'])
}
# Train the random forest model
set.seed(200)
rf_model_10 <- randomForest(Approved ~ ., data = data_train, ntree = 10)
rf_model_25 <- randomForest(Approved ~ ., data = data_train, ntree = 25)
rf_model_50 <- randomForest(Approved ~ ., data = data_train, ntree = 50)
rf_model_100 <- randomForest(Approved ~ ., data = data_train, ntree = 100)
rf_model_200 <- randomForest(Approved ~ ., data = data_train, ntree = 200)
set.seed(200)
accuracy_10 <- evaluate_model(rf_model_10, data_val)
accuracy_25 <- evaluate_model(rf_model_50, data_val)
accuracy_50 <- evaluate_model(rf_model_50, data_val)
accuracy_100 <- evaluate_model(rf_model_100, data_val)
accuracy_200 <- evaluate_model(rf_model_200, data_val)
accuracies <- data.frame(
ntree = c(10, 25, 50, 100, 200),
accuracy = c(accuracy_10, accuracy_25, accuracy_50, accuracy_100, accuracy_200)
)
print(accuracies) ntree accuracy
1 10 0.9980100
2 25 0.9977612
3 50 0.9977612
4 100 0.9975124
5 200 0.9977612# Predict on the testing set
predictions <- predict(rf_model_50, newdata = data_test)
predictions <- factor(predictions, levels = c(0, 1))
actual_values <- factor(data_test$Approved, levels = c(0, 1))
# Create a confusion matrix
confusion_matrix <- confusionMatrix(predictions, actual_values)
print(confusion_matrix)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 14 0
1 10 5001
Accuracy : 0.998
95% CI : (0.9963, 0.999)
No Information Rate : 0.9952
P-Value [Acc > NIR] : 0.001063
Kappa : 0.7359
Mcnemar's Test P-Value : 0.004427
Sensitivity : 0.583333
Specificity : 1.000000
Pos Pred Value : 1.000000
Neg Pred Value : 0.998004
Prevalence : 0.004776
Detection Rate : 0.002786
Detection Prevalence : 0.002786
Balanced Accuracy : 0.791667
'Positive' Class : 0
# Extract accuracy
accuracy <- confusion_matrix$overall['Accuracy']
print(paste("Accuracy: ", accuracy))[1] "Accuracy: 0.998009950248756"Dataset C - RF Prediction Model
Lastly, we fit a model to dataset C. Like before, we’ll use a validation set to select the best parameters and run the final accuracy calculation on the test set. Admittedly, cross-validation would be a better choice here, but it broke for some reason with some of the feature values. I don’t even know how that works. Thanks R language.
# Transform
cur_data <- data_c
cur_data$Approved <- factor(cur_data$Approved, levels = c(0, 1))
# Partition
trainIndex <- createDataPartition(cur_data$Approved, p = 0.8, list = FALSE)
data_train_full <- cur_data[trainIndex, ]
data_test <- cur_data[-trainIndex, ]
# Partition further
trainIndex2 <- createDataPartition(data_train_full$Approved, p = 0.8, list = FALSE)
data_train <- data_train_full[trainIndex2, ]
data_val <- data_train_full[-trainIndex2, ]
evaluate_model <- function(model, data_val) {
predictions <- predict(model, newdata = data_val)
predictions <- factor(predictions, levels = c(0, 1))
confusion_matrix <- confusionMatrix(predictions, data_val$Approved)
return(confusion_matrix$overall['Accuracy'])
}
# Train the random forest model
set.seed(200)
rf_model_10 <- randomForest(Approved ~ ., data = data_train, ntree = 10)
rf_model_25 <- randomForest(Approved ~ ., data = data_train, ntree = 25)
rf_model_50 <- randomForest(Approved ~ ., data = data_train, ntree = 50)
rf_model_100 <- randomForest(Approved ~ ., data = data_train, ntree = 100)
rf_model_200 <- randomForest(Approved ~ ., data = data_train, ntree = 200)
rf_model_500 <- randomForest(Approved ~ ., data = data_train, ntree = 500)
set.seed(200)
accuracy_10 <- evaluate_model(rf_model_10, data_val)
accuracy_25 <- evaluate_model(rf_model_50, data_val)
accuracy_50 <- evaluate_model(rf_model_50, data_val)
accuracy_100 <- evaluate_model(rf_model_100, data_val)
accuracy_200 <- evaluate_model(rf_model_200, data_val)
accuracy_500 <- evaluate_model(rf_model_500, data_val)
accuracies <- data.frame(
ntree = c(10, 25, 50, 100, 200, 500),
accuracy = c(accuracy_10, accuracy_25, accuracy_50, accuracy_100, accuracy_200, accuracy_500)
)
print(accuracies) ntree accuracy
1 10 0.7000000
2 25 0.7833333
3 50 0.8166667
4 100 0.8000000
5 200 0.8166667
6 500 0.8000000# Predict on the testing set
predictions <- predict(rf_model_200, newdata = data_test)
predictions <- factor(predictions, levels = c(0, 1))
actual_values <- factor(data_test$Approved, levels = c(0, 1))
# Create a confusion matrix
confusion_matrix <- confusionMatrix(predictions, actual_values)
print(confusion_matrix)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 7 6
1 15 48
Accuracy : 0.7237
95% CI : (0.6091, 0.8201)
No Information Rate : 0.7105
P-Value [Acc > NIR] : 0.45672
Kappa : 0.2356
Mcnemar's Test P-Value : 0.08086
Sensitivity : 0.31818
Specificity : 0.88889
Pos Pred Value : 0.53846
Neg Pred Value : 0.76190
Prevalence : 0.28947
Detection Rate : 0.09211
Detection Prevalence : 0.17105
Balanced Accuracy : 0.60354
'Positive' Class : 0
# Extract accuracy
accuracy <- confusion_matrix$overall['Accuracy']
print(paste("Accuracy: ", accuracy))[1] "Accuracy: 0.723684210526316"Results, Analysis, Discussion
Dataset overview
Right away, we notice an immediate difference in the number of records between dataset A, dataset B, and dataset C, especially the list of Approved records. Although dataset B has over 50x the number of records, it has 1/3 the amount of rejected applications versus dataset A. There is therefore, a large class imbalance.
| Dataset | Number of Applications | Applications Rejected | % Rejected |
|---|---|---|---|
| A | 690 | 383 | 55.5% |
| B | 25128 | 121 | 0.5% |
| C | 381 | 110 | 28.9% |
Different Model Features
Lastly, we analyze the factors each model favors on it’s own dataset when selecting from any of it’s features (not just shared features). We notice dataset B now heavily favors Total Bad Debt and Total Good Debt, dropping it’s gender bias, while dataset A starts to exhibit bias against both people of color and temporary citizens.
| Dataset | Significant Features |
|---|---|
| A | Ethnicity is Black, Prior Default, Temporary Citizenship, Zip Code, Income |
| B | Total Bad Debt, Total Good Debt |
| C | Married, Credit History, Properties are Semi-Urban |
Dataset Model Prediction Performance
We note that due to the massive class imbalance, accuracy is not a good sole indictator of model performance. We therefore also include the F1 score and precision/recall metrics to better capture performance.
Although dataset B looks promising, the recall is terrible. Dataset C fits the worst, which was expected as evidenced by previous attempts for feature selection.
| Dataset | Train Accuracy | Test Accuracy | Precision | Recall | F1 Score |
|---|---|---|---|---|---|
| A | 87% | 83% | 0.81 | 0.92 | 0.86 |
| B | 99.8% | 99.8% | 1.00 | 0.50 | 0.67 |
| C | 82% | 73% | 0.53 | 0.31 | 0.40 |
Conclusion
Finally, we will attempt to answer our original questions.
1) How similar / different are the datasets from each other? This covers factors such as quality, distribution, class balance, etc.
All datasets share some common features such as Gender, Married, Income. Two datasets share additional features such as Graduate, Debt, Age, and Dependents. Within these shared features, the data and data distributions is wildly varied. Furthermore, dataset B has a large class imbalance and dataset C is difficult to find significant factors that determine approval.
3) Will the same model trained with features unique to each dataset have a heavy impact on what can be inferred?
Yes, we note that Dataset A has a feature called “PriorDefault” which is an excellent indicator of approval compared to all other features in all other datasets. In dataset C, we have Credit History and Property Type which are also helpful features. Dataset B leans heavily on Debt as indicator of approval. All three models have different modes of model selection.
Impact
There is a concerning statement on the original page of dataset b, which encouraged me to download and perform the analysis of these particular datasets. I’ll repeat it here: “The goal of the dataset is listed as”training machine learning models to determine whether or not an applicant is a ‘good’ or ‘bad’ one”. In many of my models trained on Dataset B, the model exhibited a heavy bias or reliance on the gender of the individual. Thus, a person’s gender was immediately tied to whether or not they were a “good” or “bad” applicant.
I believe if someone fitted an actual approval model without recognizing these drawbacks to the dataset, it would have a negative impact on people of a certain gender. One would need to correct for this gender bias before deploying the model.
Although dataset A does not immediately exhibit bias, it can be shown in some models to heavily consider people of color in it’s determination of a good or bad applicant. This would also need to be taken into account before deploying the model.