1. Different kinds of cards

Are the results different for other types of credit cards? How much do they differ from each other?

Income and the application for a credit card?

Is the acceptance for a credit card application dependent on income? Does owning a house matter?

cards_summarised <- CreditCard %>%
  group_by(card) %>%
  summarise(
    quantity = n(),
    range = max(income) - min(income),
    'highest income' = max(income),
    'lowest income' = min(income),
    'mean of income' = mean(income),
    'median of income' = median(income),
    'interquartile range' = quantile(income, 0.75) - quantile(income, 0.25),
    'standard deviation' = sd(income),
  )

homeowners_summarised <- CreditCard %>%
  mutate(owner_true = ifelse(owner == "yes", TRUE, FALSE)) %>%
  group_by(card) %>%
  summarise(
    'number of homeowners' = sum(owner == "yes"),
    'percentage of homeowners' = paste(round((sum(owner_true) / n()) * 100, 2), "%", sep = ""),
    'homeowners that have income higher than mean' = sum(owner_true == TRUE & income > mean(income))
  )
Summary table depending if application was accepted
card quantity range highest income lowest income mean of income median of income interquartile range standard deviation
no 296 10.51 11.0 0.49 3.068509 2.59 1.625 1.615336
yes 1023 13.29 13.5 0.21 3.451273 3.00 1.650 1.707116
Summary table based on homeowners
card number of homeowners percentage of homeowners homeowners that have income higher than mean
no 90 30.41% 50
yes 491 48% 265

Does having a stable adress matter?

Were people living at current address for longer period of time (in months) more likely to have their application accepted?

median_months <- median(CreditCard$months)
mean_months <- mean(CreditCard$months)

months_summarised <- CreditCard %>%
  group_by(card) %>%
  summarise(
    'median of months' = median_months,
    'percentage of longer than the median' = paste(round((sum(months > median_months) / n()) * 100, 2), "%", sep = ""),
    'mean of months' = mean_months,
    'percentage of longer than the mean' = paste(round((sum(months > mean_months) / n()) * 100, 2), "%", sep = "")
  )
How months are divided by cards
card median of months percentage of longer than the median mean of months percentage of longer than the mean
no 30 54.39% 55.26763 31.08%
yes 30 47.7% 55.26763 31.77% 
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Is expenditure important?

Are individuals with higher ratio of monthly credit card expenditure to yearly income less likely to have their application accepted?

share_summarised <- CreditCard %>%
  group_by(card) %>%
  summarise(
    quantity = n(),
    range = max(share) - min(share),
    'highest value of share' = max(share),
    'lowest value of share' = min(share),
    'mean of share' = mean(share),
    'median of share' = median(share),
    'interquartile share' = quantile(share, 0.75) - quantile(share, 0.25),
    'standard deviation' = sd(share)
  )
Share in card applications
card quantity range highest value of share lowest value of share mean of share median of share interquartile share standard deviation
no 296 0.0023399 0.0024490 0.0001091 0.0004768 0.0004633 0.0002689 0.0002131
yes 1023 0.9061345 0.9063205 0.0001860 0.0884815 0.0602094 0.0872238 0.0990702

2. Different social groups

How data is divide by age?

age_data <- CreditCard %>%
  mutate(age_group = ifelse(age<30, "young", ifelse(age<50, "middle", "old")))

age_data$age_group <- factor(age_data$age_group, levels = c("young", "middle", "old"))

# Plot the data
ggplot(age_data, aes(x = age_group, y = age, fill = age_group)) +
  geom_boxplot() +
  labs(x = "Age Group", y = "Age", fill = "Age Group") +
  ggtitle("Age Distribution by Age Group") +
  theme_minimal()

ggplot(age_data, aes(x = age_group, y = expenditure, color = age_group)) +
  geom_point(position = position_jitter(width = 0.2)) + 
  stat_summary(fun = mean, geom = "errorbar", width = 0.2) +
  labs(x = "Age Group", y = "Expenditure", fill = "Age Group") +
  ggtitle("Expenditure by Age Group") +
  theme_minimal() +
  scale_y_continuous(breaks = seq(0, max(age_data$expenditure), by = 200))

expenditure_summarised <- age_data %>%
  group_by(age_group) %>%
  summarise(
    quantity = n(),
    range = max(expenditure) - min(expenditure),
    'highest value of expenditure' = max(expenditure),
    'lowest value of expenditure' = min(expenditure),
    'mean of expenditure' = mean(expenditure),
    'median of expenditure' = median(expenditure),
    'interquartile expenditure' = quantile(expenditure, 0.75) - quantile(expenditure, 0.25),
    'standard deviation' = sd(expenditure)
  )


expenditure_summarised %>%
  kable(caption="expenditure in in different age groups") %>%
  kable_styling(full_width = FALSE)
expenditure in in different age groups
age_group quantity range highest value of expenditure lowest value of expenditure mean of expenditure median of expenditure interquartile expenditure standard deviation
young 589 1902.000 1902.000 0 169.9797 104.78330 233.8625 227.3039
middle 644 2291.174 2291.174 0 199.9110 103.93205 288.3943 293.5729
old 86 3099.505 3099.505 0 177.0877 82.29375 214.3202 369.2482 
ggplot(age_data, aes(x = age_group, y = income, color = age_group)) +
  geom_point(position = position_jitter(width = 0.2)) + 
  stat_summary(fun = mean, geom = "errorbar", width = 0.2) +
  labs(x = "Age Group", y = "Income", color = "Age Group", fill = "Age Group") +
  ggtitle("Income by Age Group") +
  theme_minimal() +
  scale_y_continuous(breaks = seq(0, max(age_data$income), by = 1))

income_summarised <- age_data %>%
  group_by(age_group) %>%
  summarise(
    quantity = n(),
    range = max(income) - min(income),
    'highest value of income' = max(income),
    'lowest value of income' = min(income),
    'mean of income' = mean(income),
    'median of income' = median(income),
    'interquartile income' = quantile(income, 0.75) - quantile(income, 0.25),
    'standard deviation' = sd(income)
  )


income_summarised %>%
  kable(caption="income in in different age groups") %>%
  kable_styling(full_width = FALSE)
income in in different age groups
age_group quantity range highest value of income lowest value of income mean of income median of income interquartile income standard deviation
young 589 8.7999 9.9999 1.20 2.733991 2.5000 1.0950 1.123372
middle 644 13.2900 13.5000 0.21 3.826598 3.4512 2.0435 1.827036
old 86 11.0499 12.4999 1.45 4.235828 3.7250 2.7125 2.317135

Does variable “dependents” depends on age group or maybe it does not change?

ggplot(age_data, aes(x = age_group, y = dependents, color = age_group)) +
  geom_point(position = position_jitter(width = 0.2)) + 
  stat_summary(fun = mean, geom = "errorbar", width = 0.2) +
  labs(x = "Age Group", y = "Dependents", color = "Age Group", fill = "Age Group") +
  ggtitle("Dependents by Age Group") +
  theme_minimal() +
  scale_y_continuous(breaks = seq(0, max(age_data$income), by = 1))

dependents_summarised <- age_data %>%
  group_by(age_group) %>%
  summarise(
    quantity = n(),
    range = max(dependents) - min(dependents),
    'highest value of dependents' = max(dependents),
    'lowest value of dependents' = min(dependents),
    'mean of dependents' = mean(dependents),
    'median of dependents' = median(dependents),
    'interquartile dependents' = quantile(dependents, 0.75) - quantile(dependents, 0.25),
    'standard deviation' = sd(dependents)
  )


dependents_summarised %>%
  kable(caption="dependents in in different age groups") %>%
  kable_styling(full_width = FALSE)
dependents in in different age groups
age_group quantity range highest value of dependents lowest value of dependents mean of dependents median of dependents interquartile dependents standard deviation
young 589 6 6 0 0.5483871 0 1 0.9402842
middle 644 6 6 0 1.4145963 1 2 1.3719603
old 86 4 4 0 0.8953488 1 1 1.0293238

If age group changes, does the factor “majorcard” change as well?

ggplot(age_data, aes(x = age_group, y = majorcards, color = age_group)) +
  geom_point(position = position_jitter(width = 0.2)) + 
  stat_summary(fun = mean, geom = "errorbar", width = 0.2) +
  labs(x = "Age Group", y = "Major Cards", color = "Age Group", title =  "Major Cards by Age Group", fill = "Age Group") +
  theme_minimal() +
  scale_y_continuous(breaks = seq(0, max(age_data$income), by = 1))

majorcards_summarised <- age_data %>%
  group_by(age_group) %>%
  summarise(
    quantity = n(),
    range = max(majorcards) - min(majorcards),
    'highest value of majorcards' = max(majorcards),
    'lowest value of majorcards' = min(majorcards),
    'mean of majorcards' = mean(majorcards),
    'median of majorcards' = median(majorcards),
    'interquartile majorcards' = quantile(majorcards, 0.75) - quantile(majorcards, 0.25),
    'standard deviation' = sd(majorcards)
  )


majorcards_summarised %>%
  kable(caption="majorcards in in different age groups") %>%
  kable_styling(full_width = FALSE)
majorcards in in different age groups
age_group quantity range highest value of majorcards lowest value of majorcards mean of majorcards median of majorcards interquartile majorcards standard deviation
young 589 1 1 0 0.8047538 1 0 0.3967270
middle 644 1 1 0 0.8369565 1 0 0.3696925
old 86 1 1 0 0.7558140 1 0 0.4321233

Summary

  1. Income and Credit Card Acceptance:
    • The data indicates that income plays a significant role in credit card application acceptance. Individuals with higher incomes are more likely to have their applications approved. Additionally, a higher ratio of monthly credit card expenditure to yearly income (share) increases the likelihood of acceptance. However, the duration of residency appears to have no influence on application acceptance.
  2. Age Patterns:
    • The middle age group comprises the largest proportion of individuals, followed by the young age group, and the smallest proportion belongs to the old age group. Various factors exhibit patterns associated with age:
      • Middle-aged individuals spend the most on average, despite not having the highest income. Statistically, the oldest individuals tend to earn the most.
      • Middle-aged individuals have the highest average number of dependents (nearly 1.5) and the highest average number of major credit cards (almost 0.84), indicating that approximately 84% of individuals in this group possess a major credit card, compared to only 75% in the oldest age group.