Descriptive Statistics

Univariate Statistics

Ignacy Hirsz, Mariusz Godlewski, Hasan Barış Gök

2024-04-25

Your task this week is to: prepare your own descriptive analysis for the “CreditCard” dataset (AER package). It is a cross-sectional dataframe on the credit history for a sample of applicants for a type of credit card.

CreditCard$card<-as.factor(CreditCard$card)
CreditCard$owner<-as.factor(CreditCard$owner)
CreditCard$selfemp<-as.factor(CreditCard$selfemp)

CreditCard$reports<-factor(CreditCard$reports,ordered=TRUE)
CreditCard$dependents<-factor(CreditCard$dependents,ordered=TRUE)
CreditCard$months<-factor(CreditCard$months,ordered=TRUE)
CreditCard$majorcards<-factor(CreditCard$majorcards,ordered=TRUE)
CreditCard$active<-factor(CreditCard$active,ordered=TRUE)
#attach(CreditCard)
CreditCard$income<-as.numeric(CreditCard$income)
CreditCard$share<-as.numeric(CreditCard$share)
CreditCard$expenditure<-as.numeric(CreditCard$expenditure)
CreditCard$age<-as.numeric(CreditCard$age)
head(CreditCard)
##   card reports      age income       share expenditure owner selfemp dependents
## 1  yes       0 37.66667 4.5200 0.033269910  124.983300   yes      no          3
## 2  yes       0 33.25000 2.4200 0.005216942    9.854167    no      no          3
## 3  yes       0 33.66667 4.5000 0.004155556   15.000000   yes      no          4
## 4  yes       0 30.50000 2.5400 0.065213780  137.869200    no      no          0
## 5  yes       0 32.16667 9.7867 0.067050590  546.503300   yes      no          2
## 6  yes       0 23.25000 2.5000 0.044438400   91.996670    no      no          0
##   months majorcards active
## 1     54          1     12
## 2     34          1     13
## 3     58          1      5
## 4     25          1      7
## 5     64          1      5
## 6     54          1      1

Frequency Table, summary table,

No lets see how the expenditures differ depending on the age of the owner

From this we can see that expenditures are spread evenly across all ages, but there seams to be outliers in terms of ages, because It is impossible for a person below 18 years to own a bank account. Lets delete them

CreditCard <- CreditCard %>% filter(age>=18)
min(CreditCard$age)
## [1] 18.16667

Now lets have a look again Now it looks better, abviously there are some clients which stand out, but they are totally realistic, not like the ones we deleted

To determine the groups lets look how the expenditure is distributed

hist(CreditCard$expenditure)

boxplot(CreditCard$expenditure)

As we can see it is fairly compressed, in area near 0-400, and then appears less frequently In order to acheive a high TAI, expenditures has to be packed into, at first small groups, steadily increasing into ones with much bigger gaps

Expenditure
x label Freq Percent Valid Percent Cumulative Percent
Valid (0,50] 180 13.7 18.1 18.1
(50,100] 156 11.9 15.7 33.8
(100,150] 153 11.7 15.4 49.1
(150,300] 230 17.5 23.1 72.3
(300,450] 135 10.3 13.6 85.8
(450,600] 63 4.8 6.3 92.2
(600,800] 37 2.8 3.7 95.9
(800,1e+03] 21 1.6 2.1 98.0
(1e+03,1.5e+03] 8 0.6 0.8 98.8
(1.5e+03,3e+03] 12 0.9 1.2 100.0
Total 995 75.8 100.0
Missing <blank> 0 0.0
<NA> 317 24.2
Total 1312 100.0 
## Warning in classIntervals(CreditCard$expenditure, n = 10, style = "fixed", :
## variable range greater than fixedBreaks
##        # classes  Goodness of fit Tabular accuracy 
##       10.0000000        0.9649277        0.8583349

We now know that age is not really a good depiction of how much someone spends. Let’s discover how income affects the expenditure

ggplot(CreditCard, aes(x=selfemp, y=expenditure)) +
    geom_boxplot(alpha=0.7) +
    stat_summary(fun="mean", geom="point", shape=20, size=5, color="red", fill="red") +
 geom_jitter() +
    facet_grid(~owner) +
    scale_fill_brewer(palette="Set1")

From this we can see that people who are not self employed, no matter whether they own a card or not, tend to earn on average a bit more than those self employed, but in some(a lot) cases they actually get a bigger paycheck

## [1] "Mean :  184.97038978407"
## [1] "Median :  101.23165"
## [1] "Standard deviation :  272.714742295798"
## [1] "Variance :  74373.3306654635"
## [1] "Coeff of variability :  1.47436972271161"
## [1] "IQR :  244.387467"
## [1] "Interquartile deviation :  122.1937335"
## [1] "IQR coeff of variability :  1.20707045178064"
## [1] "Min :  0"
## [1] "Max :  3099.505"
##          0%         10%         25%         50%         75%         95% 
##    0.000000    0.000000    4.583333  101.231650  248.970800  640.999035 
##        100% 
## 3099.505000

Lets create bins for age by quantiles

CreditCard_binned <- CreditCard %>% mutate(age_group = cut(age, breaks=5))
head(CreditCard_binned)
##   card reports      age income       share expenditure owner selfemp dependents
## 1  yes       0 37.66667 4.5200 0.033269910  124.983300   yes      no          3
## 2  yes       0 33.25000 2.4200 0.005216942    9.854167    no      no          3
## 3  yes       0 33.66667 4.5000 0.004155556   15.000000   yes      no          4
## 4  yes       0 30.50000 2.5400 0.065213780  137.869200    no      no          0
## 5  yes       0 32.16667 9.7867 0.067050590  546.503300   yes      no          2
## 6  yes       0 23.25000 2.5000 0.044438400   91.996670    no      no          0
##   months majorcards active   age_group
## 1     54          1     12 (31.2,44.3]
## 2     34          1     13 (31.2,44.3]
## 3     58          1      5 (31.2,44.3]
## 4     25          1      7 (18.1,31.2]
## 5     64          1      5 (31.2,44.3]
## 6     54          1      1 (18.1,31.2]
quantile(CreditCard$age, probs = c(0.0, 0.25, 0.5, 0.75, 1), na.rm=TRUE)
##       0%      25%      50%      75%     100% 
## 18.16667 25.41667 31.29167 39.41667 83.50000
ages boxplot histogram line1 line2 points1
18-31
31-44
44-57
57-70
70-84
Now lets summarize (Although I did it similarly to the example, comparing x (expenditures) value against some bins(age_group) it shows same values in every column)
Table 1. Expenditures of clients by age groups.
18-31 31-44 44-57 57-70 70-84
PLN &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;
&nbsp;&nbsp; Min 0 0 0 0 0
&nbsp;&nbsp; Max 3099.505 3099.505 3099.505 3099.505 3099.505
&nbsp;&nbsp; Q1 4.583333 4.583333 4.583333 4.583333 4.583333
&nbsp;&nbsp; Median 101.23 101.23 101.23 101.23 101.23
&nbsp;&nbsp; Q3 248.9708 248.9708 248.9708 248.9708 248.9708
&nbsp;&nbsp; Mean 184.97 184.97 184.97 184.97 184.97
&nbsp;&nbsp; Sd 272.71 272.71 272.71 272.71 272.71
&nbsp;&nbsp; IQR 244.39 244.39 244.39 244.39 244.39
&nbsp;&nbsp; Sx 122.19 122.19 122.19 122.19 122.19
&nbsp;&nbsp; Var % 1.47 1.47 1.47 1.47 1.47
&nbsp;&nbsp; IQR Var % 2.41 2.41 2.41 2.41 2.41
&nbsp;&nbsp; Skewness 3.71 3.71 3.71 3.71 3.71
&nbsp;&nbsp; Kurtosis 22.11 22.11 22.11 22.11 22.11 
CreditCard_binned %>%
  select(expenditure,age_group) %>%
  tbl_summary(label= expenditure ~ "Expenditure",digits=c(expenditure)~2,by=age_group,type = all_continuous() ~ "continuous2", statistic = all_continuous() ~ c("{N_nonmiss}", "{median} ({p25}, {p75})", "{min}, {max}"),missing = "no")
Characteristic (18.1,31.2], N = 650 (31.2,44.3], N = 477 (44.3,57.4], N = 156 (57.4,70.4], N = 25 (70.4,83.6], N = 4
Expenditure




    N 650.00 477.00 156.00 25.00 4.00
    Median (IQR) 100.28 (4.58, 240.16) 106.20 (4.58, 300.46) 88.11 (11.83, 225.95) 93.63 (0.00, 149.70) 26.08 (10.00, 129.35)
    Range 0.00, 1,902.00 0.00, 2,291.17 0.00, 3,099.51 0.00, 479.44 0.00, 400.91
 
dfSummary(CreditCard_binned,
          plain.ascii  = FALSE, 
          style        = "grid", 
          graph.magnif = 0.75, 
          valid.col    = FALSE,
          tmp.img.dir  = "/tmp")

Data Frame Summary

CreditCard_binned

Dimensions: 1312 x 13
Duplicates: 0

No Variable Stats / Values Freqs (% of Valid) Graph Missing
1 card
[factor]		 1. no
2. yes		 295 (22.5%)
1017 (77.5%)		 0
(0.0%)
2 reports
[ordered, factor]		 1. 0
2. 1
3. 2
4. 3
5. 4
6. 5
7. 6
8. 7
9. 9
10. 10
[ 3 others ]		 1054 (80.3%)
136 (10.4%)
50 ( 3.8%)
24 ( 1.8%)
17 ( 1.3%)
11 ( 0.8%)
5 ( 0.4%)
6 ( 0.5%)
2 ( 0.2%)
1 ( 0.1%)
6 ( 0.5%)		 0
(0.0%)
3 age
[numeric]		 Mean (sd) : 33.4 (9.9)
min < med < max:
18.2 < 31.3 < 83.5
IQR (CV) : 14 (0.3)		 414 distinct values 0
(0.0%)
4 income
[numeric]		 Mean (sd) : 3.4 (1.7)
min < med < max:
0.2 < 2.9 < 13.5
IQR (CV) : 1.8 (0.5)		 431 distinct values 0
(0.0%)
5 share
[numeric]		 Mean (sd) : 0.1 (0.1)
min < med < max:
0 < 0 < 0.9
IQR (CV) : 0.1 (1.4)		 1156 distinct values 0
(0.0%)
6 expenditure
[numeric]		 Mean (sd) : 185 (272.7)
min < med < max:
0 < 101.2 < 3099.5
IQR (CV) : 244.4 (1.5)		 975 distinct values 0
(0.0%)
7 owner
[factor]		 1. no
2. yes		 733 (55.9%)
579 (44.1%)		 0
(0.0%)
8 selfemp
[factor]		 1. no
2. yes		 1221 (93.1%)
91 ( 6.9%)		 0
(0.0%)
9 dependents
[ordered, factor]		 1. 0
2. 1
3. 2
4. 3
5. 4
6. 5
7. 6		 655 (49.9%)
266 (20.3%)
218 (16.6%)
113 ( 8.6%)
44 ( 3.4%)
9 ( 0.7%)
7 ( 0.5%)		 0
(0.0%)
10 months
[ordered, factor]		 1. 0
2. 1
3. 2
4. 3
5. 4
6. 5
7. 6
8. 7
9. 8
10. 9
[ 183 others ]		 3 ( 0.2%)
9 ( 0.7%)
16 ( 1.2%)
34 ( 2.6%)
27 ( 2.1%)
18 ( 1.4%)
58 ( 4.4%)
23 ( 1.8%)
18 ( 1.4%)
13 ( 1.0%)
1093 (83.3%)		 0
(0.0%)
11 majorcards
[ordered, factor]		 1. 0
2. 1		 239 (18.2%)
1073 (81.8%)		 0
(0.0%)
12 active
[ordered, factor]		 1. 0
2. 1
3. 2
4. 3
5. 4
6. 5
7. 6
8. 7
9. 8
10. 9
[ 25 others ]		 219 (16.7%)
73 ( 5.6%)
91 ( 6.9%)
91 ( 6.9%)
83 ( 6.3%)
83 ( 6.3%)
72 ( 5.5%)
82 ( 6.2%)
62 ( 4.7%)
70 ( 5.3%)
386 (29.4%)		 0
(0.0%)
13 age_group
[factor]		 1. (18.1,31.2]
2. (31.2,44.3]
3. (44.3,57.4]
4. (57.4,70.4]
5. (70.4,83.6]		 650 (49.5%)
477 (36.4%)
156 (11.9%)
25 ( 1.9%)
4 ( 0.3%)		 0
(0.0%)		 
(exp_by_age_group <- stby(data      = CreditCard_binned, INDICES   = CreditCard_binned$age_group, FUN       = descr, stats     = "common", transpose = TRUE))
## Non-numerical variable(s) ignored: card, reports, owner, selfemp, dependents, months, majorcards, active, age_group
## Descriptive Statistics  
## CreditCard_binned  
## Group: age_group = (18.1,31.2]  
## N: 650  
## 
##                       Mean   Std.Dev     Min   Median       Max   N.Valid   Pct.Valid
## ----------------- -------- --------- ------- -------- --------- --------- -----------
##               age    25.60      3.10   18.17    25.42     31.17    650.00      100.00
##       expenditure   169.90    227.88    0.00   100.28   1902.00    650.00      100.00
##            income     2.77      1.12    1.20     2.50     10.00    650.00      100.00
##             share     0.08      0.10    0.00     0.04      0.88    650.00      100.00
## 
## Group: age_group = (31.2,44.3]  
## N: 477  
## 
##                       Mean   Std.Dev     Min   Median       Max   N.Valid   Pct.Valid
## ----------------- -------- --------- ------- -------- --------- --------- -----------
##               age    36.92      3.59   31.25    36.67     44.25    477.00      100.00
##       expenditure   205.51    297.09    0.00   106.20   2291.17    477.00      100.00
##            income     3.86      1.78    0.49     3.50     11.00    477.00      100.00
##             share     0.07      0.09    0.00     0.04      0.91    477.00      100.00
## 
## Group: age_group = (44.3,57.4]  
## N: 156  
## 
##                       Mean   Std.Dev     Min   Median       Max   N.Valid   Pct.Valid
## ----------------- -------- --------- ------- -------- --------- --------- -----------
##               age    49.32      3.71   44.33    48.29     57.33    156.00      100.00
##       expenditure   199.59    365.72    0.00    88.11   3099.50    156.00      100.00
##            income     4.28      2.40    0.21     3.70     13.50    156.00      100.00
##             share     0.05      0.07    0.00     0.03      0.33    156.00      100.00
## 
## Group: age_group = (57.4,70.4]  
## N: 25  
## 
##                       Mean   Std.Dev     Min   Median      Max   N.Valid   Pct.Valid
## ----------------- -------- --------- ------- -------- -------- --------- -----------
##               age    62.02      3.16   57.58    61.58    69.75     25.00      100.00
##       expenditure   105.13    126.57    0.00    93.62   479.44     25.00      100.00
##            income     3.78      1.63    1.50     3.50     7.12     25.00      100.00
##             share     0.04      0.06    0.00     0.03     0.27     25.00      100.00
## 
## Group: age_group = (70.4,83.6]  
## N: 4  
## 
##                       Mean   Std.Dev     Min   Median      Max   N.Valid   Pct.Valid
## ----------------- -------- --------- ------- -------- -------- --------- -----------
##               age    77.42      5.36   71.83    77.17    83.50      4.00      100.00
##       expenditure   113.27    192.44    0.00    26.08   400.91      4.00      100.00
##            income     3.72      2.73    1.50     2.84     7.70      4.00      100.00
##             share     0.02      0.03    0.00     0.01     0.06      4.00      100.00
CreditCard_binned %>%
  descr(stats = "common") %>%
  tb()
## # A tibble: 4 × 8
##   variable        mean       sd       min      med      max n.valid pct.valid
##   <chr>          <dbl>    <dbl>     <dbl>    <dbl>    <dbl>   <dbl>     <dbl>
## 1 age          33.4      9.88   18.2       31.3      83.5      1312       100
## 2 expenditure 185.     273.      0        101.     3100.       1312       100
## 3 income        3.37     1.70    0.21       2.9      13.5      1312       100
## 4 share         0.0686   0.0948  0.000109   0.0388    0.906    1312       100
grouped_descr <- stby(data    = CreditCard_binned,INDICES = CreditCard_binned$age_group, FUN     = descr, stats   = "common")

grouped_descr %>% tb()
## # A tibble: 20 × 9
##    age_group  variable    mean      sd     min     med     max n.valid pct.valid
##    <fct>      <chr>      <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>     <dbl>
##  1 (18.1,31.… age      2.56e+1 3.10e+0 1.82e+1 2.54e+1 3.12e+1     650       100
##  2 (18.1,31.… expendi… 1.70e+2 2.28e+2 0       1.00e+2 1.90e+3     650       100
##  3 (18.1,31.… income   2.77e+0 1.12e+0 1.2 e+0 2.5 e+0 1.00e+1     650       100
##  4 (18.1,31.… share    7.59e-2 1.02e-1 1.20e-4 4.49e-2 8.78e-1     650       100
##  5 (31.2,44.… age      3.69e+1 3.59e+0 3.12e+1 3.67e+1 4.43e+1     477       100
##  6 (31.2,44.… expendi… 2.06e+2 2.97e+2 0       1.06e+2 2.29e+3     477       100
##  7 (31.2,44.… income   3.86e+0 1.78e+0 4.9 e-1 3.5 e+0 1.10e+1     477       100
##  8 (31.2,44.… share    6.58e-2 9.30e-2 1.33e-4 3.72e-2 9.06e-1     477       100
##  9 (44.3,57.… age      4.93e+1 3.71e+0 4.43e+1 4.83e+1 5.73e+1     156       100
## 10 (44.3,57.… expendi… 2.00e+2 3.66e+2 0       8.81e+1 3.10e+3     156       100
## 11 (44.3,57.… income   4.28e+0 2.40e+0 2.1 e-1 3.7 e+0 1.35e+1     156       100
## 12 (44.3,57.… share    5.31e-2 6.82e-2 1.09e-4 3.04e-2 3.34e-1     156       100
## 13 (57.4,70.… age      6.20e+1 3.16e+0 5.76e+1 6.16e+1 6.97e+1      25       100
## 14 (57.4,70.… expendi… 1.05e+2 1.27e+2 0       9.36e+1 4.79e+2      25       100
## 15 (57.4,70.… income   3.78e+0 1.63e+0 1.5 e+0 3.5 e+0 7.12e+0      25       100
## 16 (57.4,70.… share    3.82e-2 5.74e-2 1.86e-4 2.53e-2 2.69e-1      25       100
## 17 (70.4,83.… age      7.74e+1 5.36e+0 7.18e+1 7.72e+1 8.35e+1       4       100
## 18 (70.4,83.… expendi… 1.13e+2 1.92e+2 0       2.61e+1 4.01e+2       4       100
## 19 (70.4,83.… income   3.72e+0 2.73e+0 1.5 e+0 2.84e+0 7.70e+0       4       100
## 20 (70.4,83.… share    2.15e-2 2.81e-2 8   e-4 1.14e-2 6.25e-2       4       100
stby(data    = CreditCard_binned, 
     INDICES = CreditCard_binned$age_group, 
     FUN     = descr, 
     stats   = "fivenum") %>%
  tb(order = 3) %>%
  kable(format = "html", digits = 2) %>%
  collapse_rows(columns = 1, valign = "top")
variable age_group min q1 med q3 max
age (18.1,31.2] 18.17 23.25 25.42 28.17 31.17
(31.2,44.3] 31.25 33.83 36.67 40.00 44.25
(44.3,57.4] 44.33 46.08 48.29 52.33 57.33
(57.4,70.4] 57.58 60.08 61.58 63.50 69.75
(70.4,83.6] 71.83 73.00 77.17 81.83 83.50
expenditure (18.1,31.2] 0.00 4.58 100.28 240.38 1902.00
(31.2,44.3] 0.00 4.58 106.20 300.46 2291.17
(44.3,57.4] 0.00 11.42 88.11 231.11 3099.50
(57.4,70.4] 0.00 0.00 93.62 149.70 479.44
(70.4,83.6] 0.00 6.67 26.08 219.87 400.91
income (18.1,31.2] 1.20 2.00 2.50 3.15 10.00
(31.2,44.3] 0.49 2.52 3.50 4.70 11.00
(44.3,57.4] 0.21 2.62 3.70 5.00 13.50
(57.4,70.4] 1.50 2.55 3.50 5.00 7.12
(70.4,83.6] 1.50 2.15 2.84 5.29 7.70
share (18.1,31.2] 0.00 0.00 0.04 0.11 0.88
(31.2,44.3] 0.00 0.00 0.04 0.09 0.91
(44.3,57.4] 0.00 0.00 0.03 0.07 0.33
(57.4,70.4] 0.00 0.00 0.03 0.05 0.27
(70.4,83.6] 0.00 0.00 0.01 0.04 0.06

Are the yearly incomes (in USD 10,000), credit card expenditures, age, ratio of monthly credit card expenditure to yearly income - significantly different for applicants for customers with different credit risk (“card” variable - factor)?

Prepare a professional data visualizations, descriptive statistics’ tables and interpret them.

boxplot(CreditCard$income, main = "Boxplot of Income" ,ylab = "Income")

There is a lot of outliers on the higher spectrum of income

CreditCard_f <- subset(CreditCard, age >= 18 & age <= 65)
iqr_income <- IQR(CreditCard_f$income)

ggdensity(CreditCard_f, x = "income", 
          fill = "card", palette = "jco") +
  geom_vline(xintercept = median(CreditCard_f$income) - 0.5 * iqr_income, linetype = "dashed", color = "red") +
  geom_vline(xintercept = median(CreditCard_f$income) + 0.5 * iqr_income, linetype = "dashed", color = "red") +
  geom_text(x = median(CreditCard_f$income), y = 0.02, label = "IQR", color = "red", size = 4, vjust = -1, inherit.aes = FALSE)

### Plot is unimodal and right skewd
### median income
median(CreditCard_f$income)
## [1] 2.9
### mean income
mean(CreditCard_f$income)
## [1] 3.366942
##Age

boxplot(CreditCard$age, main = "Boxplot of Age" ,ylab = "Age")

There is some useres under 18 and there is a lot of outliers on the higher spectrum

iqr_age <- IQR(CreditCard$age)
ggdensity(CreditCard_f, x = "age",  palette = "jco") +
  geom_vline(xintercept = median(CreditCard_f$age) - 0.5 * iqr_age, linetype = "dashed", color = "red") +
  geom_vline(xintercept = median(CreditCard_f$age) + 0.5 * iqr_age, linetype = "dashed", color = "red") +
  geom_text(x = median(CreditCard_f$age), y = 0.02, label = "IQR", color = "red", size = 4, vjust = -1, inherit.aes = FALSE)

### Plot is unimodal and right skewd
### median income
median(CreditCard_f$age)
## [1] 31.25
### mean income
mean(CreditCard_f$age)
## [1] 33.1482
## Expenditures
boxplot(CreditCard$expenditure, main = "Boxplot of expenditures " ,ylab = "Expenditures")

iqr_expenditure <- IQR(CreditCard$expenditure)
ggplot(CreditCard_f, aes(x = expenditure)) +
  geom_histogram(binwidth = 250, fill = "skyblue", color = "black") +
  geom_vline(xintercept = median(CreditCard_f$expenditure) - 0.5 * iqr_expenditure, linetype = "dashed", color = "red") +
  geom_vline(xintercept = median(CreditCard_f$expenditure) + 0.5 * iqr_expenditure, linetype = "dashed", color = "red") +
  geom_text(x = median(CreditCard_f$expenditure), y = 100, label = "IQR", color = "red", size = 4, vjust = -1) +
  labs(x = "Expenditure", y = "Frequency") +
  theme_minimal()

### Plot is unimodal and right skewd
### median income
median(CreditCard_f$expenditure)
## [1] 101.3963
### mean income
mean(CreditCard_f$expenditure)
## [1] 185.6613

Most of our client doesnt ahve major expendidures on their credit card

## Income base on the age
average_income <- CreditCard_f %>%
  group_by(age) %>%
  summarize(avg_income = mean(income))

# Create a scatter plot of income against age with different colors for different card types
ggplot(CreditCard_f, aes(x = age, y = income)) +
  geom_point() +
  geom_smooth(data = average_income, aes(x = age, y = avg_income), color = "blue", size = 1, method = "loess") +
  labs(x = "Age", y = "Income", color = "Card Type") +
  theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `geom_smooth()` using formula = 'y ~ x'

There is a lot of young people with low income Our clients reach peek income in their 50

CreditCard_f$expenditure_to_income <- CreditCard_f$expenditure / (CreditCard_f$income / 12)

# Create a density plot of the ratio
ggplot(CreditCard_f, aes(x = expenditure_to_income)) +
  geom_density(fill = "skyblue", color = "black") +
  labs(x = "Expenditure to Income Ratio", y = "Density") +
  theme_minimal()

Expenditures drops when income rises

#Histogram of age, with fill color representing credit risk level
ggplot(CreditCard_f, aes(x = age, fill = card)) +
  geom_histogram(binwidth = 5, color = "black", alpha = 0.7) +
  labs(x = "Age", y = "Frequency", fill = "Credit Risk") +
  theme_minimal()