Rのロジスティック回帰:`glm()` を用いた二値分類の完全チュートリアル
前回のレッスンでは、連続値(売上、気温など)を予測する線形回帰について学びました。しかし、現実の問題の80%は「~するか」という「はい/いいえ」の質問に関わっています。例えば、ユーザーは購入するだろうか? メールはクリックされるだろうか? ローンは延滞になるだろうか? といった具合です。このレッスンでは、確率やカテゴリを予測するロジスティック回帰について学びます。
このレッスンを修了すると、R を使用して、顧客離反予測、メールのクリック率予測、クレジットスコアリング、A/B テストのモデリングを行うことができるようになります。これらは、データサイエンスにおける分類問題の 60% を網羅しています。
1. 学習内容
- ロジスティック回帰の原理(ロジット変換+シグモイド関数)
- glm() 二項分布ファミリー
- 係数(オッズ比)の解釈
- predict type="response" 予測確率
- ROC曲線およびAUCによる評価
- ケアットによるトレーニングセットとテストセットの分割
- 閾値の選択(デフォルトは 0.5)
- 実用例:顧客離反予測
2. 顧客離反予測に関する事例
(1) 課題:どの顧客が離反しやすいか?
シャオ・ジャオは、あるSaaS企業のデータアナリストです。上司から、「来月、どの顧客が離反する可能性が高いか? それが起こる前に、どうすれば彼らを引き留めることができるか?」と尋ねられました。
データ:顧客1,000人;特徴量=年齢、利用期間、カスタマーサービスとのやり取り回数;ラベル=顧客が解約したかどうか。
(2) 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
3行のコード → 解約予測 + モデルの品質。
3. ロジスティック回帰の原理
(1) なぜロジスティック回帰が必要なのか?
graph TB
A[Y Category 0/1] --> B[Linear regression is not applicable]
B --> C[We need to map continuous values to 0-1]
C --> D[Logit Transformation + Sigmoid]
D --> E[Logistic Regression]
style A fill:#fff3cd
style B fill:#f8d7da
style C fill:#d4edda
style D fill:#cce5ff
style E fill:#e1d4ff
線形回帰は連続値を予測するのに対し、ロジスティック回帰は確率(0~1)を予測します。
(2) 数式
P(Y=1) = 1 / (1 + e^(-z))
│ │ │
│ │ └─ z = β₀ + β₁X₁ + β₂X₂ + ...
│ └─ e Index
└─ Sigmoid Function (Range 0-1)
等価表記(ロジット変換):
log(P/(1-P)) = β₀ + β₁X₁ + β₂X₂ + ...
オッズ = P / (1-P) = 成功の確率 / 失敗の確率。
(3) シグモイド関数
sigmoid <- function(x) 1 / (1 + exp(-x))
# Examples
sigmoid(0) # 0.5
sigmoid(2) # 0.881
sigmoid(-2) # 0.119
sigmoid(10) # 0.99995
4. glm() の基本的な使い方
(1) 構文
glm(formula, data, family = binomial)
| パラメータ | 意味 |
|---|---|
formula |
y ~ x1 + x2 (lm と同じ) |
data |
データフレーム |
family |
binomial(二値分類) / gaussian(線形) / poisson(計数) |
(2) 第1のロジスティック回帰
# 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
(3) 6つの主要な成果の分析
| 項目 | 意味 | 説明 |
|---|---|---|
| 推定値 | 係数(ロジット空間) | 正の係数 → この変数の値が増加すると、解約確率が上昇する |
| 標準誤差 | 標準誤差 | 係数の推定精度 |
| z値 | z統計量 | 推定値/標準誤差 |
| Pr(>|z|) | p値 | 係数が 有意に 0 ではない 確率 |
| ヌル偏差 | ゼロモデル偏差 | 切片のみのモデル |
| 残差偏差 | 残差偏差 | 値が小さいほど、適合度がよい |
z value は t 値の代わりとなる(大標本正規近似);p < 0.05 の場合、その係数は有意である。
5. 係数の解釈:オッズ比
(1) なぜオッズ比を用いるのか?
ロジスティック回帰の係数はロジット空間で表されるため、直感的に理解しにくい。解釈しやすくするために、これらをオッズ比(OR)に変換する:
# odds ratio = exp(Coefficient)
exp(coef(model))
# (Intercept) age usage
# 4670.123 1.091 0.856
(2) OR の解釈
| OR 値 | 意味 |
|---|---|
| OR = 1 | 変数には影響がない |
| OR > 1 | 変数の値が増加すると、オッズが増加する(その事象が発生する可能性が高くなる) |
| OR < 1 | 変数の値が増加すると、オッズが低下する(事象が発生する可能性が低くなる) |
# 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%
(3) 95%信頼区間
exp(confint(model))
# 2.5 % 97.5 %
# (Intercept) 12.345 12345.678
# age 1.002 1.198
# usage 0.745 0.978
CIには1が含まれていない → この係数は有意である。
6. 予測
(1) type パラメータ
# type = "response" <- Probability (0-1) * Most Commonly Used
predict(model, type = "response")
# type = "link" <- logit space (Default)
predict(model, type = "link")
(2) 実世界における予測
# 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%
(3) 閾値の選択
| 閾値 | 適用されるシナリオ |
|---|---|
| 0.5 | デフォルト。精度と再現率のバランス |
| 0.3 | 偽陰性の削減(医療診断、不正) |
| 0.7 | 誤検知(スパム)を減らす |
# Custom Thresholds
df$pred <- ifelse(df$prob > 0.3, 1, 0)
7. モデルの評価:ROC + AUC
(1) 混同行列
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
(2) 4つの主要指標
| 単位 | 計算式 | 意味 |
|---|---|---|
| 精度 | (TP + TN) / 合計 | 総合精度 |
| 精度 | TP / (TP+FP) | 陽性と予測された症例のうち、実際に陽性であるものの割合 |
| 再現率(感度) | TP / (TP+FN) | 実際の陽性例のうち正しく予測された割合 |
| F1 | 2×P×R/(P+R) | PとRの調和平均 |
(3) ROC曲線 + AUC
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
8. トレーニングセットとテストセットの分割
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)
9. 多クラス(多項)
# 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
10. 実践編:顧客離反予測プロセスの全容
以下は、このレッスンで取り上げたロジスティック回帰の概念をすべて結びつけた完全なワークフローの例です。
▶ サンプル:1,000人の顧客の離反予測
# ============================================
# 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
❓ よくある質問
lm()を、Yが0/1の二値変数ならglm(family = binomial)を使用します。nnet::multinom()(多クラスロジスティック回帰)またはcaret(自動モデル選択)を使用してください。クラスが3つ以上の場合は、ランダムフォレストを検討してください。📖 まとめ
- ロジスティック回帰:Y は 0/1 の二値分類であり、出力は 確率(0 または 1 ではない)である
- 数学:
log(P/(1-P)) = β₀ + β₁X + ...、P = sigmoid(z)と同等 glm(y ~ x, family = binomial)式の構文はlmと同じです。- 係数の解釈:OR = exp(β)。ORが1より大きい場合はその事象の発生確率が上昇していることを示し、ORが1より小さい場合は発生確率が低下していることを示す。
predict(model, type = "response")予測確率;type = "link"予測ロジット- ROC + AUC 評価:AUC 0.5~1.0(0.5 = ランダム、1.0 = 完全)
- 閾値:デフォルトは 0.5、必要に応じて調整(偽陰性と偽陽性のバランスを考慮)
- caret::createDataPartition を使用して、トレーニングセットとテストセットを 70 対 30 の比率で分割する
- 複数のカテゴリ:
nnet::multinom(y ~ x)
📝 練習問題
-
基本演習:データフレーム(200行、4列:churn + age + usage + support_calls)を作成し、
glmを使用してモデルを構築し、summaryを使用してすべての出力を解釈し、exp(coef(model))を使用してオッズ比を算出してください。 -
基本演習:前の問題のモデルを用いて、
predict(type = "response")を使用して訓練データを予測し、実際のラベルと予測確率のヒストグラムを作成し、ロジスティック回帰が確率(0~1)を出力することを確認してください。 -
基本演習:前の問題で作成したモデルを用いて、
pROC::roc()を使用して ROC 曲線をプロットし、AUC を算出してください。AUC が 0.7~0.9 の範囲にあることが、モデルが良好であることを示していることを確認してください。 -
応用問題:
mtcarsデータセットを用いて二値分類問題を作成し(vsは 0/1 のエンジンタイプを表す)、glm(vs ~ mpg + wt, family = binomial)を使用してモデルを構築し、データを 70/30 の比率で分割し、テストセットの AUC および混同行列を算出してください。 -
課題:顧客離反予測の完全実施—1,000人の顧客をシミュレート(特徴量4つ+ラベル1つ)。ワークフローの全工程:①探索 ②パーティショニング ③モデリング ④評価(混同行列+ROC曲線+AUC) ⑤閾値分析 ⑥高リスク顧客の特定 ⑦確率分布プロット ⑧モデルの保存。プロセスのスクリーンショットを保存してください。



