Descriptive Statistics

Univariate Statistics

Your turn!

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.

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.

Preprocessing

income<-as.numeric(CreditCard$income)
expenditure<-as.numeric(CreditCard$expenditure)
age<-as.integer(CreditCard$age)
card<-as.factor(CreditCard$card)

Frequency Tables

In the first step of our analysis, we will group our data into a simple frequency table.

First, let’s look at the distribution of income in our sample and verify tabular validity using the TAI measure:

Ok, it looks quite ugly, so let’s wrap it up using the ‘kable’ package:

Incomes in kPLN

x label Freq Percent Valid Percent Cumulative Percent Valid 0-2 kPLN 236 17.9 17.9 17.9 2-4 kPLN 783 59.4 59.4 77.3 4-6 kPLN 205 15.5 15.5 92.8 6-8 kPLN 63 4.8 4.8 97.6 8-10 kPLN 23 1.7 1.7 99.3 10-12 kPLN 7 0.5 0.5 99.8 12-14 kPLN 2 0.2 0.2 100.0 Total 1319 100.0 100.0 Missing <blank> 0 0.0 <NA> 0 0.0 Total 1319 100.0

##        # classes  Goodness of fit Tabular accuracy 
##        7.0000000        0.9085328        0.6568085

As we can see - the TAI index is quite high. 0.65 means that we can accept the proposed construction of the frequency table.

Income

Based on these graphs we can observe a few things. First of all, in the first two graphs we can see that the income line of those who do not have cards is slightly shifted to the left, which means that their income is smaller compared to those with cards. We confirmed this observation by generating the mean of income for those two groups of people, where we can clearly see the difference. Moreover, the boxplot graphs show that the more extreme income values (above 10) occur mostly in the card-holders group with quite an advantage. Based on all that information there seems to be little corelation between income and card factor, however the difference is more significant when it comes to the range of income than its average

Expenditure

How about the relation between expenditure and card factor?

By this single plot we can observe that expenditure is highly dependent from card factor. As shown above, expenditure of card non-holders in all cases is close if not equal to zero, whereas for the other group this variable is in range from 0 to so much as 3000.

    mean(expenditure)

## [1] 185.0571

    median(expenditure)

## [1] 101.2983

    sd(expenditure) #standard deviation

## [1] 272.2189

    var(expenditure) #variance

## [1] 74103.14

    coeff_var<-sd(expenditure)/mean(expenditure) #coefficient of variability %
    coeff_var

## [1] 1.471

    IQR(expenditure)# difference between quartiles =Q3-Q1 

##      75% 
## 244.4525

    sx<-IQR(expenditure)/2  #interquartile deviation
    coeff_varx<-sx/median(expenditure) #IQR coefficient of variability %
    coeff_varx

##      75% 
## 1.206597

    min(expenditure)

## [1] 0

    max(expenditure)

## [1] 3099.505

    quantile(expenditure,probs=c(0,0.1,0.25,0.5,0.75,0.95,1),na.rm=TRUE)

##          0%         10%         25%         50%         75%         95% 
##    0.000000    0.000000    4.583333  101.298300  249.035800  640.730130 
##        100% 
## 3099.505000

Ok, we have calculated all of the basic summary statistics above. Let’s wrap them up together now.

card	boxplot	histogram	line1	line2	points1
no
yes

##Age

ggplot(CreditCard, aes(x=card, y=age)) + 
  geom_boxplot() +
  labs(title="Age distribution box plot", x="Credit card holdings", y="Age")

With age the correlation is similar to income. The mean and average is similar for both groups, but more extreme values are present in card holders group. Only this time mean seems to be higher for non-holders than for holders.

Ratio of monthly expenditure to income

## [1] 0.51205875 0.11976382 0.05747126 2.17116850 0.87252231 0.68145681

Since expenditure corelation with card factor is very high, ratio corelation will also be high.

## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_point()`).

Here the corelation can be clearly seen.

Summary tables

grouped_stats <- CreditCard %>%
  dplyr::group_by(card) %>%
  dplyr::summarise(
    Mean_Income = mean(income, na.rm = TRUE),
    SD_Income = sd(income, na.rm = TRUE),
    Median_Income = median(income, na.rm = TRUE),
    Mean_Expenditure = mean(expenditure, na.rm = TRUE),
    SD_Expenditure = sd(expenditure, na.rm = TRUE),
    Median_Expenditure = median(expenditure, na.rm = TRUE),
    Median_Age = median(age, na.rm = TRUE),
    Mean_Age = mean(age, na.rm = TRUE),
    SD_Age = sd(age, na.rm = TRUE),
   
  )

 print(grouped_stats)

## # A tibble: 2 × 10
##   card  Mean_Income SD_Income Median_Income Mean_Expenditure SD_Expenditure
##   <fct>       <dbl>     <dbl>         <dbl>            <dbl>          <dbl>
## 1 no           3.07      1.62          2.59               0              0 
## 2 yes          3.45      1.71          3                239.           288.
## # ℹ 4 more variables: Median_Expenditure <dbl>, Median_Age <dbl>,
## #   Mean_Age <dbl>, SD_Age <dbl>

gtsummary

We can calculate easily descriptive statistics also using gtsummary package:

gt_summary_table <- CreditCard %>%
  select(income, expenditure, age, card) %>%
  tbl_summary(
    by = card,
    statistic = list(all_continuous() ~ "{mean} ({sd})")

  )

gt_summary_table

Characteristic	no, N = 2961	yes, N = 1,0231
income	3.07 (1.62)	3.45 (1.71)
expenditure	0 (0)	239 (288)
age	33 (10)	33 (10)
1 Mean (SD)

dfSummary

dfSummary() creates a summary table with statistics, frequencies and graphs for all variables in a data frame. The information displayed is type-specific (character, factor, numeric, date) and also varies according to the number of distinct values.

When using dfSummary() in R Markdown documents, it is generally a good idea to exclude a column or two to avoid margin overflow. Since the Valid and Missing columns are redundant, we can drop either one of them.

 CreditCard<- CreditCard %>%
  select(income, expenditure, age, card)
dfSummary(
  CreditCard,
  plain.ascii = FALSE,
  style = "grid",
  graph.magnif = 0.75,
  valid.col = FALSE,
  tmp.img.dir = "/tmp"
)

## temporary images written to 'C:\tmp'

Data Frame Summary

CreditCard

Dimensions: 1319 x 4
Duplicates: 1

No	Variable	Stats / Values	Freqs (% of Valid)	Graph	Missing
1	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%)
2	expenditure [numeric]	Mean (sd) : 185.1 (272.2) min < med < max: 0 < 101.3 < 3099.5 IQR (CV) : 244.5 (1.5)	981 distinct values		0 (0.0%)
3	age [numeric]	Mean (sd) : 33.2 (10.1) min < med < max: 0.2 < 31.2 < 83.5 IQR (CV) : 14 (0.3)	418 distinct values		0 (0.0%)
4	card [factor]	1. no 2. yes	296 (22.4%) 1023 (77.6%)		0 (0.0%)

To produce optimal results, summarytools has its own version of the base by() function. It’s called stby(), and we use it exactly as we would by():

## # A tibble: 3 × 8
##   variable      mean     sd   min   med    max n.valid pct.valid
##   <chr>        <dbl>  <dbl> <dbl> <dbl>  <dbl>   <dbl>     <dbl>
## 1 age          33.2   10.1  0.167  31.2   83.5    1319       100
## 2 expenditure 185.   272.   0     101.  3100.     1319       100
## 3 income        3.37   1.69 0.21    2.9   13.5    1319       100

## # A tibble: 6 × 9
##   card  variable      mean     sd   min    med    max n.valid pct.valid
##   <fct> <chr>        <dbl>  <dbl> <dbl>  <dbl>  <dbl>   <dbl>     <dbl>
## 1 no    age          33.2    9.92 0.75   31.8    80.2     296       100
## 2 no    expenditure   0      0    0       0       0       296       100
## 3 no    income        3.07   1.62 0.49    2.59   11       296       100
## 4 yes   age          33.2   10.2  0.167  31.1    83.5    1023       100
## 5 yes   expenditure 239.   288.   0     150.   3100.     1023       100
## 6 yes   income        3.45   1.71 0.21    3      13.5    1023       100

variable	card	min	q1	med	q3	max
age	no	0.75	25.62	31.83	38.12	80.17
age	yes	0.17	25.33	31.08	39.75	83.50
expenditure	no	0.00	0.00	0.00	0.00	0.00
expenditure	yes	0.00	66.30	150.18	314.49	3099.50
income	no	0.49	2.00	2.59	3.65	11.00
income	yes	0.21	2.35	3.00	4.00	13.50