INFO-H510 Week 9 Data Dive

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggplot2)
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.0
## ✔ readr     2.1.4

## ── 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

library(lindia)
library(ggrepel)

data <- read.csv("../Churn_Modelling.csv")

str(data)

## 'data.frame':    10002 obs. of  14 variables:
##  $ RowNumber      : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ CustomerId     : int  15634602 15647311 15619304 15701354 15737888 15574012 15592531 15656148 15792365 15592389 ...
##  $ Surname        : chr  "Hargrave" "Hill" "Onio" "Boni" ...
##  $ CreditScore    : int  619 608 502 699 850 645 822 376 501 684 ...
##  $ Geography      : chr  "France" "Spain" "France" "France" ...
##  $ Gender         : chr  "Female" "Female" "Female" "Female" ...
##  $ Age            : num  42 41 42 39 43 44 50 29 44 NA ...
##  $ Tenure         : int  2 1 8 1 2 8 7 4 4 2 ...
##  $ Balance        : num  0 83808 159661 0 125511 ...
##  $ NumOfProducts  : int  1 1 3 2 1 2 2 4 2 1 ...
##  $ HasCrCard      : int  1 0 1 0 NA 1 1 1 0 1 ...
##  $ IsActiveMember : int  1 1 0 0 1 0 1 0 NA 1 ...
##  $ EstimatedSalary: num  101349 112543 113932 93827 79084 ...
##  $ Exited         : int  1 0 1 0 0 1 0 1 0 0 ...

Linear Regression Model

Variables : HasCrCard

Let the regression model predict the Credit Score of the individual. To start off with a binary term let it be, HasCrCard, which specifies the whether a customer has a Credit Card or not.

model_binary <-lm(CreditScore ~ HasCrCard, data = data)
summary(model_binary)

## 
## Call:
## lm(formula = CreditScore ~ HasCrCard, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -301.345  -67.197    0.803   66.803  199.803 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  651.345      1.781 365.726   <2e-16 ***
## HasCrCard     -1.148      2.120  -0.542    0.588    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 96.65 on 9999 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  2.933e-05,  Adjusted R-squared:  -7.067e-05 
## F-statistic: 0.2933 on 1 and 9999 DF,  p-value: 0.5881

From the model summary it can be inferred from the p-value that being very high (0.588) mean that model has very low significance. Which is an expected behavior as HasCrCard has very little to with predicting the customers Credit Score. In this case the model is clearly is under-fitting. So, the variable HasCrCard alone cannot predict the customers CreditScore.

Variables : Balance, HasCrCard

model <- lm(CreditScore ~ HasCrCard + Balance, data = data)
summary(model)

## 
## Call:
## lm(formula = CreditScore ~ HasCrCard + Balance, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -301.648  -66.752    1.526   67.263  200.526 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.506e+02  2.152e+00 302.384   <2e-16 ***
## HasCrCard   -1.129e+00  2.121e+00  -0.532    0.594    
## Balance      9.526e-06  1.549e-05   0.615    0.539    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 96.65 on 9998 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  6.715e-05,  Adjusted R-squared:  -0.0001329 
## F-statistic: 0.3357 on 2 and 9998 DF,  p-value: 0.7148

Although Balance is very good variable to predict the CreditScore, in this case it leads only a less significant relationship can be observed, with a p-value of 0.539, which is certainly better than p-value of HasCrCard, but it is too low to associate these variables having a strong association.

Variables : Age, Balance, EstimatedSalary * HasCrCard

Here the EstimatedSalary * HasCrCard is the interaction term

model <- lm(CreditScore ~ Age + Balance + EstimatedSalary * HasCrCard, data = data)
summary(model)

## 
## Call:
## lm(formula = CreditScore ~ Age + Balance + EstimatedSalary * 
##     HasCrCard, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -301.860  -66.827    1.449   67.210  202.089 
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                6.513e+02  5.229e+00 124.540   <2e-16 ***
## Age                       -4.000e-02  9.223e-02  -0.434    0.665    
## Balance                    9.779e-06  1.550e-05   0.631    0.528    
## EstimatedSalary            8.776e-06  3.085e-05   0.285    0.776    
## HasCrCard                  5.007e-01  4.267e+00   0.117    0.907    
## EstimatedSalary:HasCrCard -1.638e-05  3.679e-05  -0.445    0.656    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 96.67 on 9994 degrees of freedom
##   (2 observations deleted due to missingness)
## Multiple R-squared:  0.0001085,  Adjusted R-squared:  -0.0003918 
## F-statistic: 0.2168 on 5 and 9994 DF,  p-value: 0.9555

An interesting observation that can be made from the model summary is that the attributes have a large p-value than before, indicating that these variables have much less association compared to earlier.

cor(data[c("Age", "Balance", "EstimatedSalary", "HasCrCard", "CreditScore")], use = "complete.obs")

##                          Age      Balance EstimatedSalary    HasCrCard
## Age              1.000000000  0.028292129    -0.007124611 -0.011720094
## Balance          0.028292129  1.000000000     0.012779822 -0.014915746
## EstimatedSalary -0.007124611  0.012779822     1.000000000 -0.009955185
## HasCrCard       -0.011720094 -0.014915746    -0.009955185  1.000000000
## CreditScore     -0.004119021  0.006197433    -0.001465107 -0.005438606
##                  CreditScore
## Age             -0.004119021
## Balance          0.006197433
## EstimatedSalary -0.001465107
## HasCrCard       -0.005438606
## CreditScore      1.000000000

In summary, based on these correlation coefficients, there are very weak relationships between the variables in the dataset. It is the case with the attribute CreditScore to other attributes as well, suggesting that there is a very low significance among the CreditScore attribute and others, which is a possible reason for low performance of the Linear Regression Models.

Model Evaluation

Plot 1 - Residuals vs. Fitted Values

plot(model$fitted.values, residuals(model),
     xlab = "Fitted Values", ylab = "Residuals",
     main = "Residuals vs. Fitted Values Plot")

From the above plot it can be inferred that either these is Homoscedasticity or Non-Linearity among the variables. The primary issue is non-linear relationship among these variables, which can be seen from the plot below.

ggplot(data, aes(x = CreditScore, y = Balance)) +
  geom_point(alpha=0.25) +
  theme_minimal() +
  labs(x = "Credit Score", y = "Balance", title = "Scatter Plot of Balance vs Credit Score")

ggplot(data, aes(x = CreditScore, y = Age)) +
  geom_point(alpha=0.25) +
  theme_minimal() +
  labs(x = "Credit Score", y = "Age", title = "Scatter Plot of Age vs Credit Score")

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

Therefore from the plots above it is clear the the primary cause for this behavior is due non-linear nature of the variables.

Plot 2 - Residuals vs. x values

plots <- gg_resX(model, plot.all = FALSE)

plots$Age

plots$Balance

plots$EstimatedSalary

Similar to earlier clearly there is no linear relationship among these variables, which is root cause for low association. And the dashed line here indicates that majority of the prediction made with random guessing can have fairly same result.

Plot 3 - Residual Histogram

gg_reshist(model, bins=50)

The histogram of residuals is an expected result, as the model was performing poorly and given that most of the values are present at the center, indicates that high number of error in the middle, while lesser errors in the rest of the regions.

Plot 4 - QQ-Plots

gg_qqplot(model)

This is an expected result, as from the previous graph the residuals are distributed fairly normally. And the slight variation of these values, can be attributes for linger tail in the left-end.

Plot 5 - Cook’s D by Observation

gg_cooksd(model, threshold = 'matlab')

From the plot is it clear that very few observations have influence on the model, majority of the models have no influence on the model, which is one of possible reason for models’ low performance.

To summarize, a joint observation that can be made is that there is a high non-linearity among these variables and it is the root cause among many issues observed in various plots. A possible solution is to transform the data using non-linear transformations, use complex models to capture the non-linear nature of data or fitting models using subsets of the data that has linear relationship.

INFO H-510 Week 9

Sashank

2024-03-04