project
moses kithaka
2025-09-23
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.
setwd("C:/COLLINS")#LOADING LIBRARY
library(rio)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.2
## ✔ ggplot2 4.0.0 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── 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(MASS)##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## selectIMPORT DATA
data=read.csv("Customer.csv")
head(data)## customerID gender SeniorCitizen Partner Dependents tenure PhoneService
## 1 7590-VHVEG Female 0 Yes No 1 No
## 2 5575-GNVDE Male 0 No No 34 Yes
## 3 3668-QPYBK Male 0 No No 2 Yes
## 4 7795-CFOCW Male 0 No No 45 No
## 5 9237-HQITU Female 0 No No 2 Yes
## 6 9305-CDSKC Female 0 No No 8 Yes
## MultipleLines InternetService OnlineSecurity OnlineBackup DeviceProtection
## 1 No phone service DSL No Yes No
## 2 No DSL Yes No Yes
## 3 No DSL Yes Yes No
## 4 No phone service DSL Yes No Yes
## 5 No Fiber optic No No No
## 6 Yes Fiber optic No No Yes
## TechSupport StreamingTV StreamingMovies Contract PaperlessBilling
## 1 No No No Month-to-month Yes
## 2 No No No One year No
## 3 No No No Month-to-month Yes
## 4 Yes No No One year No
## 5 No No No Month-to-month Yes
## 6 No Yes Yes Month-to-month Yes
## PaymentMethod MonthlyCharges TotalCharges Churn
## 1 Electronic check 29.85 29.85 No
## 2 Mailed check 56.95 1889.50 No
## 3 Mailed check 53.85 108.15 Yes
## 4 Bank transfer (automatic) 42.30 1840.75 No
## 5 Electronic check 70.70 151.65 Yes
## 6 Electronic check 99.65 820.50 Yeshead(data, 10)## customerID gender SeniorCitizen Partner Dependents tenure PhoneService
## 1 7590-VHVEG Female 0 Yes No 1 No
## 2 5575-GNVDE Male 0 No No 34 Yes
## 3 3668-QPYBK Male 0 No No 2 Yes
## 4 7795-CFOCW Male 0 No No 45 No
## 5 9237-HQITU Female 0 No No 2 Yes
## 6 9305-CDSKC Female 0 No No 8 Yes
## 7 1452-KIOVK Male 0 No Yes 22 Yes
## 8 6713-OKOMC Female 0 No No 10 No
## 9 7892-POOKP Female 0 Yes No 28 Yes
## 10 6388-TABGU Male 0 No Yes 62 Yes
## MultipleLines InternetService OnlineSecurity OnlineBackup
## 1 No phone service DSL No Yes
## 2 No DSL Yes No
## 3 No DSL Yes Yes
## 4 No phone service DSL Yes No
## 5 No Fiber optic No No
## 6 Yes Fiber optic No No
## 7 Yes Fiber optic No Yes
## 8 No phone service DSL Yes No
## 9 Yes Fiber optic No No
## 10 No DSL Yes Yes
## DeviceProtection TechSupport StreamingTV StreamingMovies Contract
## 1 No No No No Month-to-month
## 2 Yes No No No One year
## 3 No No No No Month-to-month
## 4 Yes Yes No No One year
## 5 No No No No Month-to-month
## 6 Yes No Yes Yes Month-to-month
## 7 No No Yes No Month-to-month
## 8 No No No No Month-to-month
## 9 Yes Yes Yes Yes Month-to-month
## 10 No No No No One year
## PaperlessBilling PaymentMethod MonthlyCharges TotalCharges Churn
## 1 Yes Electronic check 29.85 29.85 No
## 2 No Mailed check 56.95 1889.50 No
## 3 Yes Mailed check 53.85 108.15 Yes
## 4 No Bank transfer (automatic) 42.30 1840.75 No
## 5 Yes Electronic check 70.70 151.65 Yes
## 6 Yes Electronic check 99.65 820.50 Yes
## 7 Yes Credit card (automatic) 89.10 1949.40 No
## 8 No Mailed check 29.75 301.90 No
## 9 Yes Electronic check 104.80 3046.05 Yes
## 10 No Bank transfer (automatic) 56.15 3487.95 Nostr(data)## 'data.frame': 7043 obs. of 21 variables:
## $ customerID : chr "7590-VHVEG" "5575-GNVDE" "3668-QPYBK" "7795-CFOCW" ...
## $ gender : chr "Female" "Male" "Male" "Male" ...
## $ SeniorCitizen : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Partner : chr "Yes" "No" "No" "No" ...
## $ Dependents : chr "No" "No" "No" "No" ...
## $ tenure : int 1 34 2 45 2 8 22 10 28 62 ...
## $ PhoneService : chr "No" "Yes" "Yes" "No" ...
## $ MultipleLines : chr "No phone service" "No" "No" "No phone service" ...
## $ InternetService : chr "DSL" "DSL" "DSL" "DSL" ...
## $ OnlineSecurity : chr "No" "Yes" "Yes" "Yes" ...
## $ OnlineBackup : chr "Yes" "No" "Yes" "No" ...
## $ DeviceProtection: chr "No" "Yes" "No" "Yes" ...
## $ TechSupport : chr "No" "No" "No" "Yes" ...
## $ StreamingTV : chr "No" "No" "No" "No" ...
## $ StreamingMovies : chr "No" "No" "No" "No" ...
## $ Contract : chr "Month-to-month" "One year" "Month-to-month" "One year" ...
## $ PaperlessBilling: chr "Yes" "No" "Yes" "No" ...
## $ PaymentMethod : chr "Electronic check" "Mailed check" "Mailed check" "Bank transfer (automatic)" ...
## $ MonthlyCharges : num 29.9 57 53.9 42.3 70.7 ...
## $ TotalCharges : num 29.9 1889.5 108.2 1840.8 151.7 ...
## $ Churn : chr "No" "No" "Yes" "No" ...colnames(data)## [1] "customerID" "gender" "SeniorCitizen" "Partner"
## [5] "Dependents" "tenure" "PhoneService" "MultipleLines"
## [9] "InternetService" "OnlineSecurity" "OnlineBackup" "DeviceProtection"
## [13] "TechSupport" "StreamingTV" "StreamingMovies" "Contract"
## [17] "PaperlessBilling" "PaymentMethod" "MonthlyCharges" "TotalCharges"
## [21] "Churn"data$TotalCharges <- as.numeric(trimws(data$TotalCharges))data <- data%>% drop_na(TotalCharges)categorical_cols <- c("gender","Partner","Dependents","PhoneService",
"MultipleLines","InternetService","OnlineSecurity",
"OnlineBackup","DeviceProtection","TechSupport",
"StreamingTV","StreamingMovies","Contract",
"PaperlessBilling","PaymentMethod","Churn")
data[categorical_cols] <- lapply(data[categorical_cols], as.factor)summary(data[, c("tenure","MonthlyCharges","TotalCharges")])## tenure MonthlyCharges TotalCharges
## Min. : 1.00 Min. : 18.25 Min. : 18.8
## 1st Qu.: 9.00 1st Qu.: 35.59 1st Qu.: 401.4
## Median :29.00 Median : 70.35 Median :1397.5
## Mean :32.42 Mean : 64.80 Mean :2283.3
## 3rd Qu.:55.00 3rd Qu.: 89.86 3rd Qu.:3794.7
## Max. :72.00 Max. :118.75 Max. :8684.8table(data$Churn)##
## No Yes
## 5163 1869prop.table(table(data$Churn)) * 100##
## No Yes
## 73.4215 26.5785ggplot(data, aes(x = Churn, y = MonthlyCharges, fill = Churn)) +
geom_boxplot()
ggplot(data, aes(x = tenure, fill = Churn)) +
geom_histogram(binwidth = 5, position = "dodge")
ggplot(data, aes(x = Contract, fill = Churn)) +
geom_bar(position = "fill") +
ylab("Proportion")
model_log <- glm(Churn ~ tenure + MonthlyCharges + Contract,
data = data, family = "binomial")
summary(model_log)##
## Call:
## glm(formula = Churn ~ tenure + MonthlyCharges + Contract, family = "binomial",
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.600590 0.089669 -17.85 <2e-16 ***
## tenure -0.035931 0.002049 -17.53 <2e-16 ***
## MonthlyCharges 0.028637 0.001350 21.22 <2e-16 ***
## ContractOne year -1.057378 0.100627 -10.51 <2e-16 ***
## ContractTwo year -1.993535 0.166946 -11.94 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 8143.4 on 7031 degrees of freedom
## Residual deviance: 6143.5 on 7027 degrees of freedom
## AIC: 6153.5
##
## Number of Fisher Scoring iterations: 6ggplot(data, aes(x = Churn, fill = Churn)) +
geom_bar() +
labs(title = "Customer Churn Distribution")
ggplot(data, aes(x = Contract, fill = Churn)) +
geom_bar(position = "fill") +
ylab("Proportion") +
labs(title = "Churn by Contract Type")
ggplot(data, aes(x = tenure, fill = Churn)) +
geom_histogram(binwidth = 5, position = "dodge") +
labs(title = "Customer Tenure Distribution by Churn")
ggplot(data, aes(x = Churn, y = MonthlyCharges, fill = Churn)) +
geom_boxplot() +
labs(title = "Monthly Charges by Churn Status")
ggplot(data, aes(x = InternetService, fill = Churn)) +
geom_bar(position = "fill") +
ylab("Proportion") +
labs(title = "Churn by Internet Service Type")
ggplot(data, aes(x = Partner, fill = Churn)) +
geom_bar(position = "fill") +
ylab("Proportion") +
labs(title = "Churn by Partnership Status")
ggplot(data, aes(x = PaymentMethod, fill = Churn)) +
geom_bar(position = "fill") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
ylab("Proportion") +
labs(title = "Churn by Payment Method")
ggplot(data, aes(x = factor(SeniorCitizen), fill = Churn)) +
geom_bar(position = "fill") +
ylab("Proportion") +
labs(title = "Churn by Senior Citizen Status", x = "Senior Citizen (0 = No, 1 = Yes)")
library(dplyr)
library(corrplot)## corrplot 0.95 loadednum_data <- data %>%
dplyr:: select(tenure, MonthlyCharges, TotalCharges)
corrplot(cor(num_data), method = "color", addCoef.col = "black",
title = "Correlation Heatmap", mar = c(0,0,1,0))
# Frequency table
table(data$Churn)##
## No Yes
## 5163 1869# Proportion
prop.table(table(data$Churn)) * 100##
## No Yes
## 73.4215 26.5785# Plot churn distribution
ggplot(data, aes(x = Churn, fill = Churn)) +
geom_bar() +
labs(title = "Churn Distribution")
churn_counts <- table(data$Churn)
pie(churn_counts,
labels = paste(names(churn_counts), round(100*churn_counts/sum(churn_counts), 1), "%"),
col = c("skyblue", "tomato"),
main = "Churn Distribution")
ggplot(data, aes(x = InternetService, y = MonthlyCharges, fill = InternetService)) +
geom_boxplot() +
labs(title = "Monthly Charges by Internet Service",
x = "Internet Service",
y = "Monthly Charges")
ggplot(data, aes(x = TotalCharges)) +
geom_density(fill = "lightblue", alpha = 0.6) +
labs(title = "Density of Total Charges",
x = "Total Charges", y = "Density")
ggplot(data, aes(x = Churn, y = TotalCharges, fill = Churn)) +
geom_boxplot() +
labs(title = "Total Charges by Churn Status",
x = "Churn", y = "Total Charges")
ggplot(data, aes(x = tenure, y = TotalCharges, color = Churn)) +
geom_point(alpha = 0.6) +
labs(title = "Tenure vs Total Charges",
x = "Tenure (months)", y = "Total Charges")
ggplot(data, aes(x = InternetService, y = TotalCharges, fill = InternetService)) +
geom_boxplot() +
labs(title = "Total Charges by Internet Service",
x = "Internet Service", y = "Total Charges")
# Hypothesis:
# H0: Churn is independent of Gender
# H1: Churn depends on Gender
tbl <- table(data$Churn, data$gender)
chisq.test(tbl)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tbl
## X-squared = 0.47545, df = 1, p-value = 0.4905# Hypothesis:
# H0: Mean TotalCharges is equal for Churn = Yes and No
# H1: Mean TotalCharges differs between Churn groups
t.test(TotalCharges ~ Churn, data = data)##
## Welch Two Sample t-test
##
## data: TotalCharges by Churn
## t = 18.801, df = 4042.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group No and group Yes is not equal to 0
## 95 percent confidence interval:
## 916.8121 1130.2840
## sample estimates:
## mean in group No mean in group Yes
## 2555.344 1531.796# Hypothesis:
# H0: Mean MonthlyCharges is equal across Internet Service groups
# H1: At least one group mean differs
anova_model <- aov(MonthlyCharges ~ InternetService, data = data)
summary(anova_model)## Df Sum Sq Mean Sq F value Pr(>F)
## InternetService 2 5221852 2610926 16065 <2e-16 ***
## Residuals 7029 1142369 163
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Hypothesis:
# H0: No correlation between tenure and TotalCharges
# H1: Significant correlation exists
cor.test(data$tenure, data$TotalCharges)##
## Pearson's product-moment correlation
##
## data: data$tenure and data$TotalCharges
## t = 122.81, df = 7030, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.8183033 0.8331706
## sample estimates:
## cor
## 0.8258805# Hypothesis:
# H0: Tenure does not significantly predict TotalCharges
# H1: Tenure significantly predicts TotalCharges
model1 <- lm(TotalCharges ~ tenure, data = data)
summary(model1)##
## Call:
## lm(formula = TotalCharges ~ tenure, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3997.2 -416.1 157.1 526.1 3382.8
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -189.529 25.254 -7.505 6.91e-14 ***
## tenure 76.271 0.621 122.810 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1278 on 7030 degrees of freedom
## Multiple R-squared: 0.6821, Adjusted R-squared: 0.682
## F-statistic: 1.508e+04 on 1 and 7030 DF, p-value: < 2.2e-16# Testing multiple predictors
model2 <- lm(TotalCharges ~ tenure + MonthlyCharges, data = data)
summary(model2)##
## Call:
## lm(formula = TotalCharges ~ tenure + MonthlyCharges, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1942.3 -465.4 -94.7 494.0 1911.8
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2162.4319 21.9899 -98.34 <2e-16 ***
## tenure 65.4141 0.3683 177.62 <2e-16 ***
## MonthlyCharges 35.8789 0.3005 119.42 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 734.5 on 7029 degrees of freedom
## Multiple R-squared: 0.895, Adjusted R-squared: 0.895
## F-statistic: 2.997e+04 on 2 and 7029 DF, p-value: < 2.2e-16# Logistic regression with key predictors
model3 <- glm(Churn ~ tenure + MonthlyCharges + TotalCharges + InternetService,
data = data,
family = "binomial")
summary(model3)##
## Call:
## glm(formula = Churn ~ tenure + MonthlyCharges + TotalCharges +
## InternetService, family = "binomial", data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.441e-01 1.888e-01 1.293 0.1960
## tenure -6.896e-02 5.716e-03 -12.065 < 2e-16 ***
## MonthlyCharges -8.541e-03 3.366e-03 -2.537 0.0112 *
## TotalCharges 2.863e-04 6.506e-05 4.400 1.08e-05 ***
## InternetServiceFiber optic 1.470e+00 1.236e-01 11.900 < 2e-16 ***
## InternetServiceNo -1.423e+00 1.507e-01 -9.440 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 8143.4 on 7031 degrees of freedom
## Residual deviance: 6194.9 on 7026 degrees of freedom
## AIC: 6206.9
##
## Number of Fisher Scoring iterations: 6# Odds ratio interpretation for logistic regression
exp(coef(model3))## (Intercept) tenure
## 1.2764978 0.9333610
## MonthlyCharges TotalCharges
## 0.9914954 1.0002863
## InternetServiceFiber optic InternetServiceNo
## 4.3506086 0.2410518# Predict churn probabilities
pred_prob <- predict(model3, type = "response")
# Classify: Yes if probability > 0.5
pred_class <- ifelse(pred_prob > 0.5, "Yes", "No")
# Confusion Matrix
table(Predicted = pred_class, Actual = data$Churn)## Actual
## Predicted No Yes
## No 4709 1045
## Yes 454 824library(ggplot2)
ggplot(data, aes(x = tenure, y = as.numeric(Churn == "Yes"))) +
geom_point(alpha = 0.3) +
stat_smooth(method = "glm", method.args = list(family = "binomial"), se = FALSE) +
labs(title = "Logistic Regression: Churn vs Tenure",
x = "Tenure (Months)", y = "Churn Probability")## `geom_smooth()` using formula = 'y ~ x'