R: الانحدار اللوجستي R

# 1. Model Building in One Line
model <- glm(churn ~ age + usage + support_calls,
             data = df, family = binomial)

# 2. Probability per row
df$prob <- predict(model, type = "response")

# 3. One-Line Evaluation
library(pROC)
roc_obj <- roc(df$churn, df$prob)
auc(roc_obj)  # [1] 0.85  ← Model Quality

P(Y=1) = 1 / (1 + e^(-z))
       │      │      │
       │      │      └─ z = β₀ + β₁X₁ + β₂X₂ + ...
       │      └─ e Index
       └─ Sigmoid Function (Range 0-1)

log(P/(1-P)) = β₀ + β₁X₁ + β₂X₂ + ...

sigmoid <- function(x) 1 / (1 + exp(-x))

# Examples
sigmoid(0)     # 0.5
sigmoid(2)     # 0.881
sigmoid(-2)    # 0.119
sigmoid(10)    # 0.99995

glm(formula, data, family = binomial)

# Data
df <- data.frame(
  churn = c(0, 0, 0, 1, 1, 1, 0, 1, 0, 1),
  age = c(25, 30, 35, 50, 55, 60, 28, 58, 32, 65),
  usage = c(80, 70, 60, 30, 20, 10, 75, 15, 65, 5)
)

# Modeling
model <- glm(churn ~ age + usage, data = df, family = binomial)
summary(model)

Coefficients:
             Estimate Std. Error z value Pr(>|z|)    
(Intercept)   8.452      4.123   2.050   0.0403 *  
age           0.087      0.043   2.023   0.0431 *  
usage        -0.156      0.058  -2.690   0.0072 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

# odds ratio = exp(Coefficient)
exp(coef(model))
# (Intercept)         age         usage
#   4670.123      1.091      0.856

# age's OR = 1.09
# Analysis: For each 1 year increase in age, churn odds increase by 9%

# usage's OR = 0.86
# Analysis: For each 1 unit increase in usage, churn odds decrease by 14%

exp(confint(model))
#                  2.5 %    97.5 %
# (Intercept)  12.345  12345.678
# age           1.002      1.198
# usage         0.745      0.978

# type = "response"  <- Probability (0-1) * Most Commonly Used
predict(model, type = "response")

# type = "link"  <- logit space (Default)
predict(model, type = "link")

# Training Set Predictions
df$prob <- predict(model, type = "response")

# Threshold 0.5 to convert to category
df$pred <- ifelse(df$prob > 0.5, 1, 0)

# New Data Forecasts
new_customers <- data.frame(
  age = c(40, 55, 30),
  usage = c(50, 15, 80)
)
predict(model, new_customers, type = "response")
# [1] 0.123 0.876 0.045
# Analysis: Age 55, Usage 15, probability of customer churn 87.6%

# Custom Thresholds
df$pred <- ifelse(df$prob > 0.3, 1, 0)

library(caret)

# True vs Forecast
confusionMatrix(
  factor(df$pred),
  factor(df$churn),
  positive = "1"
)

#           Reference
# Prediction  0  1
#         0  50  5
#         1  10 35
# Accuracy: 0.85
# Sensitivity (Recall): 0.875
# Specificity: 0.833

library(pROC)

# Calculate ROC
roc_obj <- roc(df$churn, df$prob)
auc(roc_obj)
# [1] 0.92  ← The closer we get to 1 The better

# Draw ROC
plot(roc_obj, main = "ROC Curve", col = "blue", lwd = 2)
abline(a = 0, b = 1, lty = 2, col = "gray")  # Random Classification Baseline

# AUC Analysis
# 0.5-0.7: Poor
# 0.7-0.8: Fair
# 0.8-0.9: Good
# 0.9-1.0: Excellent

library(caret)

# Division 70% Training / 30% Test
set.seed(42)
train_index <- createDataPartition(df$churn, p = 0.7, list = FALSE)
train_data <- df[train_index, ]
test_data <- df[-train_index, ]

# Train a Model
model <- glm(churn ~ age + usage, data = train_data, family = binomial)

# Test Set Predictions
test_data$prob <- predict(model, test_data, type = "response")
test_data$pred <- ifelse(test_data$prob > 0.5, 1, 0)

# Evaluation
confusionMatrix(factor(test_data$pred), factor(test_data$churn), positive = "1")

# True AUC
roc_obj <- roc(test_data$churn, test_data$prob)
auc(roc_obj)

# For multi-class classification multinom (requires nnet package)
install.packages("nnet")
library(nnet)

# 3 Categories
df <- data.frame(
  y = c("A", "A", "B", "B", "C", "C"),
  x = c(1, 2, 3, 4, 5, 6)
)

model <- multinom(y ~ x, data = df)
summary(model)

# Forecast
predict(model, type = "class")      # Category
predict(model, type = "probs")      # Probability

# ============================================
# 1000 Customer Churn Prediction
# Features: The Complete Logistic Regression Workflow
# ============================================

library(ggplot2)
library(dplyr)
library(caret)
library(pROC)

# 1. Prepare data
set.seed(42)
n <- 1000
df <- tibble(
  age = round(rnorm(n, 40, 12)),
  usage = round(rnorm(n, 50, 20)),
  support_calls = sample(0:10, n, replace = TRUE),
  plan = sample(c("Basics", "Advanced", "Company"), n, replace = TRUE,
                prob = c(0.5, 0.3, 0.2))
) |>
  mutate(
    # Probability of attrition: Older, Use less, Many customer service calls -> Prone to churn
    logit_p = -3 + 0.03 * age - 0.05 * usage + 0.3 * support_calls,
    p = 1 / (1 + exp(-logit_p)),
    churn = rbinom(n, 1, p)
  ) |>
  select(-logit_p, -p)

cat("=== Data Preview ===\n")
print(head(df, 3))
cat("\nChurn rate:", round(mean(df$churn) * 100, 2), "%\n")

# 2. Training/Test Set Partitioning
set.seed(42)
train_index <- createDataPartition(df$churn, p = 0.7, list = FALSE)
train_data <- df[train_index, ]
test_data <- df[-train_index, ]

cat("\nTraining Set:", nrow(train_data), "rows\n")
cat("Test Set:", nrow(test_data), "rows\n\n")

# 3. Train a Model
model <- glm(churn ~ age + usage + support_calls + plan,
             data = train_data, family = binomial)
cat("=== Model Summary ===\n")
summary(model)

# 4. Explanation of Coefficients
cat("\n=== Coefficient odds ratio ===\n")
or_df <- tidy(model, conf.int = TRUE, exponentiate = TRUE)
print(or_df |> select(term, estimate, std.error, p.value, conf.low, conf.high))

# 5. Training Set Predictions
train_data$prob <- predict(model, type = "response")
train_data$pred <- ifelse(train_data$prob > 0.5, 1, 0)

# 6. Test Set Predictions
test_data$prob <- predict(model, test_data, type = "response")
test_data$pred <- ifelse(test_data$prob > 0.5, 1, 0)

# 7. Training Set Evaluation
cat("\n=== Training Set Evaluation ===\n")
train_cm <- confusionMatrix(factor(train_data$pred), factor(train_data$churn),
                             positive = "1")
print(train_cm)

# 8. Test Set Evaluation
cat("\n=== Test Set Evaluation ===\n")
test_cm <- confusionMatrix(factor(test_data$pred), factor(test_data$churn),
                            positive = "1")
print(test_cm)

# 9. ROC + AUC
cat("\n=== AUC ===\n")
roc_train <- roc(train_data$churn, train_data$prob)
roc_test <- roc(test_data$churn, test_data$prob)
cat("Training Set AUC:", round(auc(roc_train), 3), "\n")
cat("Test Set AUC:", round(auc(roc_test), 3), "\n")

# 10. Draw ROC
plot(roc_test, main = "ROC Curve", col = "blue", lwd = 2)
abline(a = 0, b = 1, lty = 2, col = "gray")
legend("bottomright",
       legend = paste0("AUC = ", round(auc(roc_test), 3)),
       col = "blue", lwd = 2)

# 11. Threshold Analysis
cat("\n=== Threshold Analysis ===\n")
thresholds <- seq(0.1, 0.9, by = 0.1)
threshold_results <- lapply(thresholds, function(t) {
  pred <- ifelse(test_data$prob > t, 1, 0)
  cm <- confusionMatrix(factor(pred), factor(test_data$churn), positive = "1")
  data.frame(
    threshold = t,
    precision = cm$byClass["Precision"],
    recall = cm$byClass["Sensitivity"],
    f1 = cm$byClass["F1"]
  )
}) |> bind_rows()
print(threshold_results)

# 12. Identify high-risk customers
cat("\n=== High-Risk Clients Top 5 (Probability of attrition > 70%) ===\n")
high_risk <- test_data |>
  filter(prob > 0.7) |>
  arrange(desc(prob)) |>
  head(5) |>
  select(age, usage, support_calls, plan, prob, pred)
print(high_risk)

# 13. Probability Distribution Chart
ggplot(test_data, aes(x = prob, fill = factor(churn))) +
  geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
  labs(title = "Probability Distribution of Attrition (Sorted by True label)",
       x = "Predict the Probability of Churn", y = "Frequency", fill = "True label") +
  scale_fill_brewer(palette = "Set1", labels = c("Not churned", "Churned")) +
  theme_minimal()

# 14. Save Model
saveRDS(model, "churn_model.rds")
cat("\n=== The model has been saved: churn_model.rds ===\n")

=== Training Set Evaluation ===
Confusion Matrix:
          Reference
Prediction   0   1
         0 525  42
         1  18 115
Accuracy: 0.91
Sensitivity: 0.733
Specificity: 0.967

=== Test Set Evaluation ===
Accuracy: 0.89
AUC = 0.92