library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors#Loading data
data <- read_delim("../Churn_Modelling.csv", delim = ",")## Rows: 10002 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Surname, Geography, Gender
## dbl (11): RowNumber, CustomerId, CreditScore, Age, Tenure, Balance, NumOfPro...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.str(data)## spc_tbl_ [10,002 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ RowNumber : num [1:10002] 1 2 3 4 5 6 7 8 9 10 ...
## $ CustomerId : num [1:10002] 15634602 15647311 15619304 15701354 15737888 ...
## $ Surname : chr [1:10002] "Hargrave" "Hill" "Onio" "Boni" ...
## $ CreditScore : num [1:10002] 619 608 502 699 850 645 822 376 501 684 ...
## $ Geography : chr [1:10002] "France" "Spain" "France" "France" ...
## $ Gender : chr [1:10002] "Female" "Female" "Female" "Female" ...
## $ Age : num [1:10002] 42 41 42 39 43 44 50 29 44 NA ...
## $ Tenure : num [1:10002] 2 1 8 1 2 8 7 4 4 2 ...
## $ Balance : num [1:10002] 0 83808 159661 0 125511 ...
## $ NumOfProducts : num [1:10002] 1 1 3 2 1 2 2 4 2 1 ...
## $ HasCrCard : num [1:10002] 1 0 1 0 NA 1 1 1 0 1 ...
## $ IsActiveMember : num [1:10002] 1 1 0 0 1 0 1 0 NA 1 ...
## $ EstimatedSalary: num [1:10002] 101349 112543 113932 93827 79084 ...
## $ Exited : num [1:10002] 1 0 1 0 0 1 0 1 0 0 ...
## - attr(*, "spec")=
## .. cols(
## .. RowNumber = col_double(),
## .. CustomerId = col_double(),
## .. Surname = col_character(),
## .. CreditScore = col_double(),
## .. Geography = col_character(),
## .. Gender = col_character(),
## .. Age = col_double(),
## .. Tenure = col_double(),
## .. Balance = col_double(),
## .. NumOfProducts = col_double(),
## .. HasCrCard = col_double(),
## .. IsActiveMember = col_double(),
## .. EstimatedSalary = col_double(),
## .. Exited = col_double()
## .. )
## - attr(*, "problems")=<externalptr>CATEGORICAL_COLS <- c("Geography", "Gender", "HasCrCard", "IsActiveMember", "Exited")
NUMERIC_COLS <- c("Age", "Balance", "EstimatedSalary", "CreditScore", "Tenure", "NumOfProducts")n_rows = nrow(data)
sample_proportion <- 0.5
n_rows_sample <- n_rows * sample_proportion
data_sample_1 <- data[sample(n_rows, size=n_rows_sample, replace=TRUE), ]
data_sample_2 <- data[sample(n_rows, size=n_rows_sample, replace=TRUE), ]
data_sample_3 <- data[sample(n_rows, size=n_rows_sample, replace=TRUE), ]
data_sample_4 <- data[sample(n_rows, size=n_rows_sample, replace=TRUE), ]
data_sample_5 <- data[sample(n_rows, size=n_rows_sample, replace=TRUE), ]To inspect each sample individually by passing them into a
summary() function and print() function would
be a tedious task. So, to minimize code let’s create a data frame with
all 5 samples, and a new column stating the sample it belongs to.
samples_combined <- bind_rows(
mutate(data_sample_1, Sample="1"),
mutate(data_sample_2, Sample="2"),
mutate(data_sample_3, Sample="3"),
mutate(data_sample_4, Sample="4"),
mutate(data_sample_5, Sample="5"),
)Since, the samples are combined into a new data frame summary statistics can be easily applied now.
numeric_summary_statistics <- samples_combined |>
group_by(Sample) |>
summarize(
Credit_Score = mean(CreditScore, na.rm = TRUE),
Age = mean(Age, na.rm = TRUE),
Balance = mean(Balance,na.rm = TRUE),
NumOfProducts = mean(NumOfProducts, na.rm = TRUE),
EstimatedSalary = mean(EstimatedSalary, na.rm = TRUE),
Tenure = mean(Tenure, na.rm=TRUE)
)
print(numeric_summary_statistics)## # A tibble: 5 × 7
## Sample Credit_Score Age Balance NumOfProducts EstimatedSalary Tenure
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 652. 39.0 76693. 1.53 100203. 5.02
## 2 2 650. 39.0 75422. 1.53 100284. 5.00
## 3 3 651. 38.9 76120. 1.53 101096. 5.00
## 4 4 650. 38.9 76683. 1.53 100264. 5.04
## 5 5 651. 39.0 77334. 1.52 99590. 4.96Within the sampled data, columns CreditScore,
Age ,Tenure and NumOfProducts
have maintained a fairly even distribution. There is very little
difference among these 3 columns, among the maximum and the minimum
values. However, for Balance and
EstimatedSalary columns significant differences are
observed.
For Balance column, sample 1,
3 and 5 have a fairly even distribution, but a
significant difference of nearly 3000 is observed among the
values from samples of 2 and 4. Similarly,
with the EstimatedSalary column samples other than
3 have a fairly even mean value, but the value of the
3 sample is significantly lower compared to the rest.
for (column in CATEGORICAL_COLS) {
cat(column)
col_data <- samples_combined[c("Sample", column)]
for (sample_num in c("1", "2", "3", "4", "5")) {
filtered_data <- filter(col_data, Sample == sample_num)
print(table(filtered_data))
cat("\n")
}
cat("\n\n")
}## Geography Geography
## Sample France Germany Spain
## 1 2477 1287 1237
##
## Geography
## Sample France Germany Spain
## 2 2532 1260 1209
##
## Geography
## Sample France Germany Spain
## 3 2530 1236 1233
##
## Geography
## Sample France Germany Spain
## 4 2465 1249 1287
##
## Geography
## Sample France Germany Spain
## 5 2497 1285 1219
##
##
##
## Gender Gender
## Sample Female Male
## 1 2308 2693
##
## Gender
## Sample Female Male
## 2 2282 2719
##
## Gender
## Sample Female Male
## 3 2249 2752
##
## Gender
## Sample Female Male
## 4 2297 2704
##
## Gender
## Sample Female Male
## 5 2308 2693
##
##
##
## HasCrCard HasCrCard
## Sample 0 1
## 1 1516 3482
##
## HasCrCard
## Sample 0 1
## 2 1454 3547
##
## HasCrCard
## Sample 0 1
## 3 1405 3596
##
## HasCrCard
## Sample 0 1
## 4 1473 3528
##
## HasCrCard
## Sample 0 1
## 5 1448 3553
##
##
##
## IsActiveMember IsActiveMember
## Sample 0 1
## 1 2408 2593
##
## IsActiveMember
## Sample 0 1
## 2 2423 2578
##
## IsActiveMember
## Sample 0 1
## 3 2393 2608
##
## IsActiveMember
## Sample 0 1
## 4 2429 2572
##
## IsActiveMember
## Sample 0 1
## 5 2374 2627
##
##
##
## Exited Exited
## Sample 0 1
## 1 3960 1041
##
## Exited
## Sample 0 1
## 2 3965 1036
##
## Exited
## Sample 0 1
## 3 4015 986
##
## Exited
## Sample 0 1
## 4 3974 1027
##
## Exited
## Sample 0 1
## 5 3953 1048Due to limited number of possibilities among each categorical variable, the difference among each sample is fairly same.
To find complex patterns, we can combine categorical and numeric columns, and perform summary statistics.
numeric_summary_statistics <- samples_combined |>
filter(Exited == 0, Geography == "France") |>
group_by(Sample) |>
summarize(
Credit_Score = mean(CreditScore, na.rm = TRUE),
Age = mean(Age, na.rm = TRUE),
Balance = mean(Balance,na.rm = TRUE),
NumOfProducts = mean(NumOfProducts, na.rm = TRUE),
EstimatedSalary = mean(EstimatedSalary, na.rm = TRUE),
Tenure = mean(Tenure, na.rm=TRUE)
)
print(numeric_summary_statistics)## # A tibble: 5 × 7
## Sample Credit_Score Age Balance NumOfProducts EstimatedSalary Tenure
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 652. 37.3 60247. 1.54 98007. 5
## 2 2 649. 37.2 61786. 1.54 99095. 4.91
## 3 3 652. 37.3 59319. 1.55 99584. 4.92
## 4 4 649. 37.3 61192. 1.53 99275. 5.03
## 5 5 653. 37.4 60147. 1.54 99918. 4.97The output indicates that the Balance column has a
significant variation compared to other columns. A fairly
disproportional pattern is also observed among
EstimatedSalary as well, thought not as significant as
Balance. A difference of nearly 2000 is
observed among extremes of EstimatedSalary.
Tenure column stays fair similar, which is a pattern
observed in the earlier cases as well.
numeric_summary_statistics <- samples_combined |>
filter(Gender == "Female", IsActiveMember == 1) |>
group_by(Sample) |>
summarize(
Credit_Score = mean(CreditScore, na.rm = TRUE),
Age = mean(Age, na.rm = TRUE),
Balance = mean(Balance,na.rm = TRUE),
NumOfProducts = mean(NumOfProducts, na.rm = TRUE),
EstimatedSalary = mean(EstimatedSalary, na.rm = TRUE),
Tenure = mean(Tenure, na.rm=TRUE)
)
print(numeric_summary_statistics)## # A tibble: 5 × 7
## Sample Credit_Score Age Balance NumOfProducts EstimatedSalary Tenure
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 656. 40.2 77476. 1.53 100391. 4.65
## 2 2 651. 40.1 70959. 1.54 99773. 4.76
## 3 3 656. 39.9 76575. 1.54 100094. 4.81
## 4 4 652. 39.6 74419. 1.56 101155. 4.86
## 5 5 651. 40.4 74134. 1.56 100535. 4.89Similar pattern is observed with EstimatedSalary,
Balance and Tenure. A significant difference
among former 2 columns and fairly similar distribution among the
later.
In both these cases difference in nearly 2000 could
result in incorrect inference, as the samples differ significantly.
Moreover, these differences would be even more significant as the data
is filtered much further.
Consistent pattern among these samples is that the
Tenure values are fairly similar.