Descriptive Statistics

Univariate Statistics

Data

In our example this week, we are going to use the fake data - about real estates in Wroclaw - prices by districts, size of apartments and many more.

Preprocessing

As you can see, not all formats of our variables are adapted. We need to prepare appropriate formats of our variables according to their measurement scale and future application.

apartments$district<-as.factor(apartments$district)
apartments$building_type<-as.factor(apartments$building_type)
apartments$rooms<-factor(apartments$rooms,ordered=TRUE)
attach(apartments)
apartments$price_PLN<-as.numeric(apartments$price_PLN)
apartments$price_EUR<-as.numeric(apartments$price_EUR)

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 housing prices 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:

Apartments in Wroclaw - prices in kPLN

x label Freq Percent Valid Percent Cumulative Percent Valid 350-450 kPLN 9 4.5 4.5 4.5 450-550 kPLN 21 10.5 10.5 15.0 550-650 kPLN 33 16.5 16.5 31.5 650-750 kPLN 36 18.0 18.0 49.5 750-850 kPLN 31 15.5 15.5 65.0 850-950 kPLN 36 18.0 18.0 83.0 950-1050 kPLN 21 10.5 10.5 93.5 1050-1150 kPLN 10 5.0 5.0 98.5 1150-1250 kPLN 2 1.0 1.0 99.5 1250-1350 kPLN 1 0.5 0.5 100.0 Total 200 100.0 100.0 Missing <blank> 0 0.0 <NA> 0 0.0 Total 200 100.0

##        # classes  Goodness of fit Tabular accuracy 
##       10.0000000        0.9780872        0.8508467

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

Basic plots

In this section, we should represent our data using basic (pre-installed in R) graphics. Select the most appropriate graphs depending on the scale of the selected variables. Explore the heterogeneity of the distribution by presenting the data by group (e.g., by neighborhood, building type, etc.). Don’t forget about main titles, labels and legends. Read more about graphical parameters here.

Note that the echo = FALSE parameter has been added to the code snippet to prevent printing the R code that generated the graph.

ggplot2 plots

Now, let’s use the ggplot2 and ggpubr libraries to plot.

Ggplot2 allows you to show the average value for each group using the stat_summary() function. You no longer need to calculate average values before creating a graph!

RainCloud Plot

Faceting

Faceting generates small multiples, each showing a different subset of the data. They are a powerful tool for exploratory data analysis: you can quickly compare patterns in different parts of the data and see if they are the same or different. Read more here.

Univariate Statistics

Before automatically reporting the full summary table of descriptive statistics, this time your goal is to measure the central tendency of the price distribution. Compare the mean, median, and mode along with positional measures - quantiles - by district and building type or number of rooms in the apartment.

    mean(price_PLN)

## [1] 760035

    median(price_PLN)

## [1] 755719.5

    sd(price_PLN) #standard deviation

## [1] 186099.8

    var(price_PLN) #variance

## [1] 34633125960

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

## [1] 0.2448568

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

##      75% 
## 282686.5

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

##       75% 
## 0.1870314

    min(price_PLN)

## [1] 359769

    max(price_PLN)

## [1] 1277691

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

##        0%       10%       25%       50%       75%       95%      100% 
##  359769.0  518806.8  619073.8  755719.5  901760.2 1054250.8 1277691.0

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

rooms	boxplot	histogram	line1	line2	points1
1
2
3
4

Summary tables

Ok, now we will finally summarize the basic measures of central tendency for prices by district/building type using the ‘kable’ package. Feel free to customize your final report. See some hints here.

##  'qwraps2_summary_table' chr [1:14, 1:5] "\\bf{Price in PLN}" "~~ Min" ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:5] "" "1 (N = 44)" "2 (N = 50)" "3 (N = 58)" ...
##  - attr(*, "qable_args")=List of 6
##   ..$ rtitle    : chr ""
##   ..$ rgroup    : Named int 13
##   .. ..- attr(*, "names")= chr "Price in PLN"
##   ..$ rnames    : chr [1:13] "Min" "Max" "Q1" "Median" ...
##   ..$ cnames    : chr [1:5] "" "1 (N = 44)" "2 (N = 50)" "3 (N = 58)" ...
##   ..$ markup    : chr "latex"
##   ..$ kable_args: list()

gtsummary

We can calculate easily descriptive statistics also using gtsummary package:

apartments %>%
  select(price_PLN,rooms) %>%
  tbl_summary(label= price_PLN ~ "Price",digits=c(price_PLN)~2,by=rooms,type = all_continuous() ~ "continuous2", statistic = all_continuous() ~ c("{N_nonmiss}", "{median} ({p25}, {p75})", "{min}, {max}"),missing = "no")

Characteristic	1, N = 44	2, N = 50	3, N = 58	4, N = 48
Price
N	44.00	50.00	58.00	48.00
Median (IQR)	520,507.00 (479,684.75, 555,024.75)	677,260.00 (634,757.25, 717,728.50)	846,303.50 (769,683.75, 901,078.75)	964,338.50 (909,371.50, 1,050,976.75)
Range	359,769.00, 657,146.00	590,286.00, 888,634.00	632,770.00, 965,829.00	736,669.00, 1,277,691.00

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.

dfSummary(apartments,
          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

apartments

Dimensions: 200 x 6
Duplicates: 0

No	Variable	Stats / Values	Freqs (% of Valid)	Graph	Missing
1	price_PLN [numeric]	Mean (sd) : 760035 (186099.8) min < med < max: 359769 < 755719.5 < 1277691 IQR (CV) : 282686.5 (0.2)	200 distinct values		0 (0.0%)
2	price_EUR [numeric]	Mean (sd) : 175934 (43078.6) min < med < max: 83280 < 174935 < 295762 IQR (CV) : 65436.2 (0.2)	200 distinct values		0 (0.0%)
3	rooms [ordered, factor]	1. 1 2. 2 3. 3 4. 4	44 (22.0%) 50 (25.0%) 58 (29.0%) 48 (24.0%)		0 (0.0%)
4	size [numeric]	Mean (sd) : 46.2 (20.1) min < med < max: 17 < 43.7 < 87.7 IQR (CV) : 30.2 (0.4)	162 distinct values		0 (0.0%)
5	district [factor]	1. Biskupin 2. Krzyki 3. Srodmiescie	65 (32.5%) 79 (39.5%) 56 (28.0%)		0 (0.0%)
6	building_type [factor]	1. kamienica 2. niski blok 3. wiezowiec	61 (30.5%) 63 (31.5%) 76 (38.0%)		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():

(stats_by_rooms <- stby(data      = apartments, INDICES   = apartments$rooms, FUN       = descr, stats     = "common", transpose = TRUE))

## Non-numerical variable(s) ignored: rooms, district, building_type

Descriptive Statistics
apartments
Group: rooms = 1
N: 44

	Mean	Std.Dev	Min	Median	Max	N.Valid	Pct.Valid
price_EUR	119332.95	15497.90	83280.00	120488.00	152117.00	44.00	100.00
price_PLN	515518.05	66951.03	359769.00	520507.00	657146.00	44.00	100.00
size	19.28	1.46	17.00	19.10	21.90	44.00	100.00

Group: rooms = 2
N: 50

	Mean	Std.Dev	Min	Median	Max	N.Valid	Pct.Valid
price_EUR	158233.22	15063.13	136640.00	156773.00	205702.00	50.00	100.00
price_PLN	683567.70	65072.66	590286.00	677260.00	888634.00	50.00	100.00
size	36.80	4.46	29.60	35.95	43.70	50.00	100.00

Group: rooms = 3
N: 58

	Mean	Std.Dev	Min	Median	Max	N.Valid	Pct.Valid
price_EUR	192987.55	20125.88	146475.00	195904.00	223572.00	58.00	100.00
price_PLN	833706.02	86943.90	632770.00	846303.50	965829.00	58.00	100.00
size	53.33	7.21	41.20	53.45	65.20	58.00	100.00

Group: rooms = 4
N: 48

	Mean	Std.Dev	Min	Median	Max	N.Valid	Pct.Valid
price_EUR	225650.42	26347.03	170525.00	223226.50	295762.00	48.00	100.00
price_PLN	974809.96	113819.21	736669.00	964338.50	1277691.00	48.00	100.00
size	72.05	10.18	53.30	70.85	87.70	48.00	100.00

Tidy Tables

When generating freq() or descr() tables, it is possible to turn the results into “tidy” tables with the use of the tb() function (think of tb as a diminutive for tibble). For example:

apartments %>%
  descr(stats = "common") %>%
  tb()

## # A tibble: 3 × 8
##   variable      mean       sd    min      med       max n.valid pct.valid
##   <chr>        <dbl>    <dbl>  <dbl>    <dbl>     <dbl>   <dbl>     <dbl>
## 1 price_EUR 175934.   43079.   83280 174935    295762       200       100
## 2 price_PLN 760035.  186100.  359769 755720.  1277691       200       100
## 3 size          46.2     20.1     17     43.7      87.7     200       100

Here are some examples showing how lists created using stby() or group_by() can be transformed into tidy tibbles.

grouped_descr <- stby(data    = apartments,INDICES = apartments$rooms, FUN     = descr, stats   = "common")

grouped_descr %>% tb()

## # A tibble: 12 × 9
##    rooms variable      mean        sd      min      med    max n.valid pct.valid
##    <fct> <chr>        <dbl>     <dbl>    <dbl>    <dbl>  <dbl>   <dbl>     <dbl>
##  1 1     price_EUR 119333.   15498.    83280   120488   1.52e5      44       100
##  2 1     price_PLN 515518.   66951.   359769   520507   6.57e5      44       100
##  3 1     size          19.3      1.46     17       19.1 2.19e1      44       100
##  4 2     price_EUR 158233.   15063.   136640   156773   2.06e5      50       100
##  5 2     price_PLN 683568.   65073.   590286   677260   8.89e5      50       100
##  6 2     size          36.8      4.46     29.6     36.0 4.37e1      50       100
##  7 3     price_EUR 192988.   20126.   146475   195904   2.24e5      58       100
##  8 3     price_PLN 833706.   86944.   632770   846304.  9.66e5      58       100
##  9 3     size          53.3      7.21     41.2     53.4 6.52e1      58       100
## 10 4     price_EUR 225650.   26347.   170525   223226.  2.96e5      48       100
## 11 4     price_PLN 974810.  113819.   736669   964338.  1.28e6      48       100
## 12 4     size          72.0     10.2      53.3     70.8 8.77e1      48       100

A Bridge to Other Packages

stby(data    = apartments, 
     INDICES = apartments$rooms, 
     FUN     = descr, 
     stats   = "fivenum") %>%
  tb(order = 3) %>%
  kable(format = "html", digits = 2) %>%
  collapse_rows(columns = 1, valign = "top")

variable	rooms	min	q1	med	q3	max
price_EUR	1	83280.0	110881.0	120488.00	128568.00	152117.0
	2	136640.0	146754.0	156773.00	166259.00	205702.0
	3	146475.0	177478.0	195904.00	208599.00	223572.0
	4	170525.0	209827.5	223226.50	243300.00	295762.0
price_PLN	1	359769.0	479005.5	520507.00	555411.50	657146.0
	2	590286.0	633978.0	677260.00	718237.00	888634.0
	3	632770.0	766707.0	846303.50	901149.00	965829.0
	4	736669.0	906455.0	964338.50	1051055.50	1277691.0
size	1	17.0	18.1	19.10	20.60	21.9
	2	29.6	32.9	35.95	40.50	43.7
	3	41.2	47.9	53.45	59.70	65.2
	4	53.3	64.2	70.85	82.15	87.7

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.

# your code here
CreditCard$age<-as.numeric(CreditCard$age)
CreditCard$reports<-as.numeric(CreditCard$reports)
CreditCard$income<-as.numeric(CreditCard$income)
CreditCard$share<-as.numeric(CreditCard$share)
CreditCard$expenditure<-as.numeric(CreditCard$expenditure)
CreditCard$card<-as.factor(CreditCard$card)

credit_card_yes <- subset(CreditCard, card == 'yes')
credit_card_no <- subset(CreditCard, card == 'no')

credit_card_yes <- subset(CreditCard, card == 'yes')
credit_card_no <- subset(CreditCard, card == 'no')

age_yes <- credit_card_yes$age
age_no <- credit_card_no$age

summary(age_yes)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.1667 25.3333 31.0833 33.2160 39.7083 83.5000

summary(age_no)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.75   25.65   31.83   33.20   38.06   80.17

ggplot() +
  geom_density(data = credit_card_yes, aes(x = age, fill = "Card Owner"), color = "coral4", alpha = 0.7) +
  geom_density(data = credit_card_no, aes(x = age, fill = "Non-Owner"), color = "pink", alpha = 0.7) +
  labs(x = "Age", y = "Density", title = "Density Plot of Age by Card Ownership") +
  scale_fill_manual(values = c("Card Owner" = "coral4", "Non-Owner" = "pink"),
                    name = "Card Ownership",
                    labels = c("Owner", "Non-Owner")) +
  theme_minimal()

ggplot() +
  geom_boxplot(data = credit_card_yes, aes(x = "Card Owner", y = age, fill = "Card Owner"), color = "coral4", alpha = 0.7) +
  geom_boxplot(data = credit_card_no, aes(x = "Non-Owner", y = age, fill = "Non-Owner"), color = "pink", alpha = 0.7) +
  labs(x = "Card Ownership", y = "Age", title = "Boxplot of Age by Card Ownership") +
  scale_fill_manual(values = c("Card Owner" = "coral4", "Non-Owner" = "pink"),
                    name = "Card Ownership",
                    labels = c("Owner", "Non-Owner")) +
  theme_minimal()

summary_df_yes <- data.frame(
  Statistic = c("Mean", "Median", "Standard Deviation", "Variance", "Coefficient of Variability (%)", 
                "Interquartile Range (IQR)", "Interquartile Deviation", "IQR Coefficient of Variability (%)",
                "Minimum", "Maximum"),
  Card_Owners = c(
    mean(age_yes), median(age_yes), sd(age_yes), var(age_yes),
    sd(age_yes) / mean(age_yes) * 100, IQR(age_yes), IQR(age_yes) / 2,
    (IQR(age_yes) / 2) / median(age_yes) * 100, min(age_yes), max(age_yes)
  )
)

summary_df_no <- data.frame(
  Statistic = c("Mean", "Median", "Standard Deviation", "Variance", "Coefficient of Variability (%)", 
                "Interquartile Range (IQR)", "Interquartile Deviation", "IQR Coefficient of Variability (%)",
                "Minimum", "Maximum"),
  Non_Card_Owners = c(
    mean(age_no), median(age_no), sd(age_no), var(age_no),
    sd(age_no) / mean(age_no) * 100, IQR(age_no), IQR(age_no) / 2,
    (IQR(age_no) / 2) / median(age_no) * 100, min(age_no), max(age_no)
  )
)

summary_combined <- merge(summary_df_yes, summary_df_no, by = "Statistic", all = TRUE)

knitr::kable(summary_combined, format = "markdown", caption = "Summary Statistics for Age by Card Ownership") %>%
  kable_styling(full_width = FALSE, bootstrap_options = "striped", position = "center")

Summary Statistics for Age by Card Ownership

Statistic	Card_Owners	Non_Card_Owners
Coefficient of Variability (%)	30.7404349	29.880709
Interquartile Deviation	7.1875025	6.208333
Interquartile Range (IQR)	14.3750050	12.416665
IQR Coefficient of Variability (%)	23.1233349	19.502614
Maximum	83.5000000	80.166660
Mean	33.2160312	33.202984
Median	31.0833300	31.833335
Minimum	0.1666667	0.750000
Standard Deviation	10.2107524	9.921287
Variance	104.2594649	98.431938

Summing up the data showing from the table and two plots of age of people using credit cards and age of people who don’t we can present some interesting information:

• maximum age is bigger in the group using credit cards, which most people would think is oppositely,

• there is more people around age 25 who are owners of credit card then people around same age not owing credit cards,

• people owining cedit cards are mostly young people, we can see big decline around age 27 to 35,

• in the group owning credit card age is more diverse,

• in both groups we have some data errors because we can see some outliner around 0, which is impossible in real life,

income_yes <- credit_card_yes$income
income_no <- credit_card_no$income

summary(income_yes)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.210   2.350   3.000   3.451   4.000  13.500

summary(income_no)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.490   2.000   2.590   3.069   3.625  11.000

ggplot() +
  geom_density(data = credit_card_yes, aes(x = income, fill = "Card Owner"), color = "violetred2", alpha = 0.7) +
  geom_density(data = credit_card_no, aes(x = income, fill = "Non-Owner"), color = "violet", alpha = 0.7) +
  labs(x = "Income", y = "Density", title = "Density Plot of Income (in USD 10,000) by Card Owners") +
  scale_fill_manual(values = c("Card Owner" = "violetred2", "Non-Owner" = "violet"),
                    name = "Card Ownership",
                    labels = c("Owner", "Non-owner")) +
  theme_minimal()

ggplot() +
  geom_boxplot(data = credit_card_yes, aes(x = "Card Owner", y = income, fill = "Card Owner"), color = "violetred2", alpha = 0.7) +
  geom_boxplot(data = credit_card_no, aes(x = "Non-Owner", y = income, fill = "Non-Owner"), color = "violet", alpha = 0.7) +
  labs(x = "Card Ownership", y = "Income (in USD 10,000)", title = "Boxplot of Income (in USD 10,000) by Card Ownership") +
  scale_fill_manual(values = c("Card Owner" = "violetred2", "Non-Owner" = "violet"),
                    name = "Card Ownership",
                    labels = c("Owner", "Non-Owner")) +
  theme_minimal()

summary_df_yes <- data.frame(
  Statistic = c("Mean", "Median", "Standard Deviation", "Variance", "Coefficient of Variability (%)", 
                "Interquartile Range (IQR)", "Interquartile Deviation", "IQR Coefficient of Variability (%)",
                "Minimum", "Maximum"),
  Card_Owners = c(
    mean(income_yes), median(income_yes), sd(income_yes), var(income_yes),
    sd(income_yes) / mean(income_yes) * 100, IQR(income_yes), IQR(income_yes) / 2,
    (IQR(income_yes) / 2) / median(income_yes) * 100, min(income_yes), max(income_yes)
  )
)

summary_df_no <- data.frame(
  Statistic = c("Mean", "Median", "Standard Deviation", "Variance", "Coefficient of Variability (%)", 
                "Interquartile Range (IQR)", "Interquartile Deviation", "IQR Coefficient of Variability (%)",
                "Minimum", "Maximum"),
  Non_Card_Owners = c(
    mean(income_no), median(income_no), sd(income_no), var(income_no),
    sd(income_no) / mean(income_no) * 100, IQR(income_no), IQR(income_no) / 2,
    (IQR(income_no) / 2) / median(income_no) * 100, min(income_no), max(income_no)
  )
)

summary_combined <- merge(summary_df_yes, summary_df_no, by = "Statistic", all = TRUE)

knitr::kable(summary_combined, format = "markdown", caption = "Summary Statistics for Income by Card Ownership") %>%
  kable_styling(full_width = FALSE, bootstrap_options = "striped", position = "center")

Summary Statistics for Income by Card Ownership

Statistic	Card_Owners	Non_Card_Owners
Coefficient of Variability (%)	49.463385	52.642387
Interquartile Deviation	0.825000	0.812500
Interquartile Range (IQR)	1.650000	1.625000
IQR Coefficient of Variability (%)	27.500000	31.370656
Maximum	13.500000	11.000000
Mean	3.451273	3.068509
Median	3.000000	2.590000
Minimum	0.210000	0.490000
Standard Deviation	1.707116	1.615336
Variance	2.914247	2.609312

Analizing data from the plots and table we can conclude:

• there is bigger diversity in the income of card owners,

• if we group card owners by hey income we can tell that the most numerous group is the one of income 25000 USD,

• if we do the same with non card owners then the biggest group is the one of income around 20000 USD,

• people with credit cards have bigger average income then people without them,

• maximum income of credit card owners is bigger then in non owners.

income_age_yes <- credit_card_yes[, c("income", "age")]
summary(income_age_yes)

##      income            age         
##  Min.   : 0.210   Min.   : 0.1667  
##  1st Qu.: 2.350   1st Qu.:25.3333  
##  Median : 3.000   Median :31.0833  
##  Mean   : 3.451   Mean   :33.2160  
##  3rd Qu.: 4.000   3rd Qu.:39.7083  
##  Max.   :13.500   Max.   :83.5000

income_age_no <- credit_card_no[, c("income", "age")]
summary(income_age_no)

##      income            age       
##  Min.   : 0.490   Min.   : 0.75  
##  1st Qu.: 2.000   1st Qu.:25.65  
##  Median : 2.590   Median :31.83  
##  Mean   : 3.069   Mean   :33.20  
##  3rd Qu.: 3.625   3rd Qu.:38.06  
##  Max.   :11.000   Max.   :80.17

ggplot(income_age_yes, aes(x = age, y = income)) +
  geom_bar(stat = "identity", fill = "skyblue", color = "skyblue") +
  labs(x = "Age", y = "Income (in USD 10,000)", title = "Income by Age (For People with Cards)") +
  theme_grey()

ggplot(income_age_no, aes(x = age, y = income)) +
  geom_bar(stat = "identity", fill = "pink", color = "pink") +
  labs(x = "Age", y = "Income (in USD 10,000)", title = "Income by Age (For People Without Cards)") +
  theme_grey()

Now lets compare income by age in both of he groups: - with credit cards biggest income have people around age of 42, while for non - owners this age is a little bit smaller, because it’s around 35.

• we can see bigger differences in income of different age groups for card owners comparing to non-owners,

• there is more age groups lacking in the non-owners, which is only assuring us that there is bigger age diversity in the card owners group,

• again we can see some errors in data set, because here is group of people around age 0 which has some income and it’s rather impossible in real life, so based on this we can assume that those are errors.

ggplot() +
  geom_boxplot(data = credit_card_yes, aes(x = "Card Owner", y = share, fill = "Card Owner"), color = "turquoise2", alpha = 0.7) +
  geom_boxplot(data = credit_card_no, aes(x = "Non-Owner", y = share, fill = "Non-Owner"), color = "purple", alpha = 0.7) +
  labs(x = "Card Ownership", y = "Share", title = "Boxplot of Share by Card Ownership") +
  scale_fill_manual(values = c("Card Owner" = "turquoise2", "Non-Owner" = "purple"),
                    name = "Card Ownership",
                    labels = c("Owner", "Non-Owner")) +
  theme_minimal()

ggplot() +
  geom_density(data = credit_card_yes, aes(x = share, fill = "Card Owner"), color = "turquoise2", alpha = 0.7) +
  labs(x = "Share", y = "Density", title = "Density Plot of Share by Card Owners") +
  scale_fill_manual(values = c("Card Owner" = "turquoise2"),
                    name = "Card Ownership",
                    labels = c("Owner")) +
  theme_minimal()

share_yes <- credit_card_yes$share
share_no <- credit_card_no$share

summary_df_yes <- data.frame(
  Statistic = c("Mean", "Median", "Standard Deviation", "Variance", "Coefficient of Variability (%)", 
                "Interquartile Range (IQR)", "Interquartile Deviation", "IQR Coefficient of Variability (%)",
                "Minimum", "Maximum"),
  Card_Owners = c(
    mean(share_yes), median(share_yes), sd(share_yes), var(share_yes),
    sd(share_yes) / mean(share_yes) * 100, IQR(share_yes), IQR(share_yes) / 2,
    (IQR(share_yes) / 2) / median(share_yes) * 100, min(share_yes), max(share_yes)
  )
)

summary_df_no <- data.frame(
  Statistic = c("Mean", "Median", "Standard Deviation", "Variance", "Coefficient of Variability (%)", 
                "Interquartile Range (IQR)", "Interquartile Deviation", "IQR Coefficient of Variability (%)",
                "Minimum", "Maximum"),
  Non_Card_Owners = c(
    mean(share_no), median(share_no), sd(share_no), var(share_no),
    sd(share_no) / mean(share_no) * 100, IQR(share_no), IQR(share_no) / 2,
    (IQR(share_no) / 2) / median(share_no) * 100, min(share_no), max(share_no)
  )
)

summary_combined <- merge(summary_df_yes, summary_df_no, by = "Statistic", all = TRUE)

knitr::kable(summary_combined, format = "markdown", caption = "Summary Statistics for Age by Card Ownership") %>%
  kable_styling(full_width = FALSE, bootstrap_options = "striped", position = "center")

Summary Statistics for Age by Card Ownership

Statistic	Card_Owners	Non_Card_Owners
Coefficient of Variability (%)	111.9670714	44.6937484
Interquartile Deviation	0.0436119	0.0001345
Interquartile Range (IQR)	0.0872238	0.0002689
IQR Coefficient of Variability (%)	72.4336454	29.0204022
Maximum	0.9063205	0.0024490
Mean	0.0884815	0.0004768
Median	0.0602094	0.0004633
Minimum	0.0001860	0.0001091
Standard Deviation	0.0990702	0.0002131
Variance	0.0098149	0.0000000

Those plots and table shows us share (Ratio of monthly credit card expenditure to yearly income) of card owners and non-owners, and it shows us something very interesting. We could assume that share for non-owners should be 0, because how someone without credit card can have a ratio of monthly credit card expenditure to yearly income, but from the table it’s says that those are extremely small numbers, which we can assume are just incorrect values.

So we will be only focusing on the group of card owners while analising the data.

• diversit of the share is quite big,

• when we gropu people by their share we can say, that most numerous gruop is of people having share around 0.12,

• maximum share is 0.9 which is almost 1 so it would mean that thoes people spend all their salary by credit card,

expenditures_age<-credit_card_yes[, c("expenditure", "age")]

summary(expenditures_age)

##   expenditure           age         
##  Min.   :   0.00   Min.   : 0.1667  
##  1st Qu.:  66.52   1st Qu.:25.3333  
##  Median : 150.18   Median :31.0833  
##  Mean   : 238.60   Mean   :33.2160  
##  3rd Qu.: 313.96   3rd Qu.:39.7083  
##  Max.   :3099.51   Max.   :83.5000

ggplot(expenditures_age, aes(x = age, y = expenditure)) +
  geom_bar(stat = "identity", fill = "maroon", color = "maroon") +
  labs(x = "Age", y = "Expenditure", title = "Expenditure by Age") +
  theme_minimal()

Now just quick conclusion from this bar plot:

• mostly young people are paying with credit card,

• biggest expenditure have people around 35,

• expedtiture of people after 50 is decreasing,

• again we see incorrect data around age 0.

share_age<-credit_card_yes[, c("share", "age")]

summary(share_age)

##      share               age         
##  Min.   :0.000186   Min.   : 0.1667  
##  1st Qu.:0.026635   1st Qu.:25.3333  
##  Median :0.060209   Median :31.0833  
##  Mean   :0.088482   Mean   :33.2160  
##  3rd Qu.:0.113858   3rd Qu.:39.7083  
##  Max.   :0.906320   Max.   :83.5000

ggplot(share_age, aes(x = age, y = share)) +
  geom_bar(stat = "identity", fill = "slateblue2" ,color = "slateblue2") +
  labs(x = "Age", y = "Share", title = "Ratio of monthly credit card expenditure to yearly income by Age") +
  theme_minimal()

And quick assumptions from this one:

• biggest share have people around age of 25,

• we can see that after age of 40 the share is way smaller compering to younger people,

• again we see some incorrect data values around age 0.

Summing up all the data analysis we have few most important conclusions:

• more people use credit card then not,

• biggest group age of credit card users are young people, around age 20-30,

• people who have bigger income they tend to have credit cards,

• young people use credit card more frequently then people after 40s.