INFO H-510 Week 8
Sashank
2024-03-04
INFO-H510 Week 8 Data Dive
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 errorslibrary(dplyr)
library(ggplot2)
#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>There is multiple variables that could appeal as valuable,
due to numerous variables encapsulating crucial information, such as
Balance, CreditScore,
EstimatedSalary etc. But often the later 2 variables have
association with Balance, thus among all the attributes of
the data is can be safe to assume that Balance would the
most valuable column. There are attributes such as
Tenure, HasCrCard and
NumOfProducts do also have association with the column
Balance, therefore the column Balance could be
considered the most valuable.
Further, other column priority do change upon the domain of the
analyst, but the column Balance tends to be of greater
interest for most of people.
Let Geography be the categorical column which serves as
the influencing variable and Exited be the response
variable.
Null Hypothesis (H0): There is no significant difference in the mean churn rates among customers from different countries (France, Spain, Germany).
Alternative Hypothesis (H1): There is a significant difference in the mean churn rates among customers from different countries.
anova_result <- aov(Exited ~ Geography, data = data)
summary(anova_result)## Df Sum Sq Mean Sq F value Pr(>F)
## Geography 2 49 24.522 155.8 <2e-16 ***
## Residuals 9998 1574 0.157
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 1 observation deleted due to missingnessFrom the results the Pr(>F) value is
<2e-16, which is a value much smaller than the usual
significance level (0.05). Further, the
F value is 155.8, which essentially is the
evidence against the null hypothesis. From the result of both these
values it can be concluded that there is a significant difference in
churn rates among customers from different countries.
ggplot(data, aes(x = Geography, y = Exited)) +
geom_boxplot() +
stat_summary(fun = mean, geom = "point", shape = 20, size = 3, color = "red") +
labs(x = "Geography", y = "Exited") +
ggtitle("Boxplot of Churn Rates by Geography")
Hence, there is enough evidence to conclude that there is a significant difference in means churn rates among countries. Therefore, it would be safe to assume that there are significant differences in churn rates among the countries, based on the results of the ANOVA test.
Let, Balance be the influencing variable and
EstimatedSalary be the response variable, it is safe to
assume that age could potentially have a linear relationship with the
likelihood of a customer churning, as younger or older customers might
be more or less likely to leave the bank.
model <- lm(Balance ~ EstimatedSalary, data = data)
summary(model)##
## Call:
## lm(formula = Balance ~ EstimatedSalary, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -77868 -75955 20770 51017 174669
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.511e+04 1.252e+03 59.982 <2e-16 ***
## EstimatedSalary 1.378e-02 1.085e-02 1.271 0.204
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 62390 on 10000 degrees of freedom
## Multiple R-squared: 0.0001614, Adjusted R-squared: 6.141e-05
## F-statistic: 1.614 on 1 and 10000 DF, p-value: 0.2039We can visualize the result of the model -
predictions <- predict(model)
plot(data$Balance, data$EstimatedSalary, col = "blue", main = "Observed vs. Predicted Values", xlab = "Balance", ylab = "Estimated Salary")
abline(model, col = "red")
legend("topright", legend = "Regression Line", col = "red", lty = 1)
Contrary to the assumption Balance and
EstimatedSalary do not have a linear relationship, due to
the highly scatter values of these 2 column leads to a linear regression
model with slope close to 0. From the visualization it can be stated
that, the column Balance does not scale linearly with
EstimatedSalary, which is counter intuitive to general
assumption.
Similar to earlier, let Balance be the response variable
and CreditScore be the explanatory variable.
model <- lm(Balance ~ CreditScore, data = data)
predictions <- predict(model)
plot(data$CreditScore, data$Balance, col = "blue", main = "Observed vs. Predicted Values", xlab = "Credit Score", ylab = "Balance")
abline(model, col = "red")
legend("topright", legend = "Regression Line", col = "red", lty = 1)
Similar to earlier, both the variables do not have a linear relation as well. This is also a contrastive result since, often the case is that individuals with higher balance tend to have a very high credit scores, and users with low balances tend to have medium to low scores. But is can inferred from the visualization that the popular belief is clearly wrong.
model <- lm(Balance ~ CreditScore, data = data)
# Summarize the model
summary(model)##
## Call:
## lm(formula = Balance ~ CreditScore, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -77314 -76278 20599 51243 174389
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 73807.820 4245.234 17.386 <2e-16 ***
## CreditScore 4.125 6.455 0.639 0.523
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 62400 on 10000 degrees of freedom
## Multiple R-squared: 4.083e-05, Adjusted R-squared: -5.916e-05
## F-statistic: 0.4083 on 1 and 10000 DF, p-value: 0.5228# Plot observed vs. predicted values
predictions <- predict(model)
plot(data$CreditScore, data$Balance, col = "blue", main = "Observed vs. Predicted Values", xlab = "Credit Score", ylab = "Balance")
abline(model, col = "red")
legend("topright", legend = "Regression Line", col = "red", lty = 1)