404 Not Found

404 Not Found


nginx

Rのロジスティック回帰:`glm()` を用いた二値分類の完全チュートリアル

前回のレッスンでは、連続値(売上、気温など)を予測する線形回帰について学びました。しかし、現実の問題の80%は「~するか」という「はい/いいえ」の質問に関わっています。例えば、ユーザーは購入するだろうか? メールはクリックされるだろうか? ローンは延滞になるだろうか? といった具合です。このレッスンでは、確率カテゴリを予測するロジスティック回帰について学びます。

このレッスンを修了すると、R を使用して、顧客離反予測、メールのクリック率予測、クレジットスコアリング、A/B テストのモデリングを行うことができるようになります。これらは、データサイエンスにおける分類問題の 60% を網羅しています。

1. 学習内容



2. 顧客離反予測に関する事例

(1) 課題:どの顧客が離反しやすいか?

シャオ・ジャオは、あるSaaS企業のデータアナリストです。上司から、「来月、どの顧客が離反する可能性が高いか? それが起こる前に、どうすれば彼らを引き留めることができるか?」と尋ねられました。

データ:顧客1,000人;特徴量=年齢、利用期間、カスタマーサービスとのやり取り回数;ラベル=顧客が解約したかどうか。

(2) 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

3行のコード → 解約予測 + モデルの品質



3. ロジスティック回帰の原理

(1) なぜロジスティック回帰が必要なのか?

100%
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) 数式

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

等価表記(ロジット変換):

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

オッズ = P / (1-P) = 成功の確率 / 失敗の確率。

(3) シグモイド関数

R
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) 構文

R
glm(formula, data, family = binomial)
パラメータ 意味
formula y ~ x1 + x2 (lm と同じ)
data データフレーム
family binomial(二値分類) / gaussian(線形) / poisson(計数)

(2) 第1のロジスティック回帰

R
# 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)

出力:

R
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)に変換する:

R
# 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 変数の値が増加すると、オッズが低下する(事象が発生する可能性が低くなる)
R
# 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%信頼区間

R
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 パラメータ

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

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

(2) 実世界における予測

R
# 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 誤検知(スパム)を減らす
R
# Custom Thresholds
df$pred <- ifelse(df$prob > 0.3, 1, 0)


7. モデルの評価:ROC + AUC

(1) 混同行列

R
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

R
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. トレーニングセットとテストセットの分割

R
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. 多クラス(多項)

R
# 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人の顧客の離反予測

R
# ============================================
# 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")
▶ 試してみよう

期待される出力(抜粋):

R
=== 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

❓ よくある質問

Q ロジスティック回帰と線形回帰の違いは?
A Yが連続変数ならlm()を、Yが0/1の二値変数ならglm(family = binomial)を使用します。
Q 良いAUC値とはどの程度ですか?
A 0.5 = ランダム、0.7~0.8 = 平均的、0.8~0.9 = 良好、0.9以上 = 優秀。
Q 多クラス分類には何を使えばよいですか?
A nnet::multinom()(多クラスロジスティック回帰)またはcaret(自動モデル選択)を使用してください。クラスが3つ以上の場合は、ランダムフォレストを検討してください。

📖 まとめ


📝 練習問題

  1. 基本演習:データフレーム(200行、4列:churn + age + usage + support_calls)を作成し、glm を使用してモデルを構築し、summary を使用してすべての出力を解釈し、exp(coef(model)) を使用してオッズ比を算出してください。

  2. 基本演習:前の問題のモデルを用いて、predict(type = "response") を使用して訓練データを予測し、実際のラベルと予測確率のヒストグラムを作成し、ロジスティック回帰が確率(0~1)を出力することを確認してください。

  3. 基本演習:前の問題で作成したモデルを用いて、pROC::roc() を使用して ROC 曲線をプロットし、AUC を算出してください。AUC が 0.7~0.9 の範囲にあることが、モデルが良好であることを示していることを確認してください。

  4. 応用問題mtcars データセットを用いて二値分類問題を作成し(vs は 0/1 のエンジンタイプを表す)、glm(vs ~ mpg + wt, family = binomial) を使用してモデルを構築し、データを 70/30 の比率で分割し、テストセットの AUC および混同行列を算出してください。

  5. 課題:顧客離反予測の完全実施—1,000人の顧客をシミュレート(特徴量4つ+ラベル1つ)。ワークフローの全工程:①探索 ②パーティショニング ③モデリング ④評価(混同行列+ROC曲線+AUC) ⑤閾値分析 ⑥高リスク顧客の特定 ⑦確率分布プロット ⑧モデルの保存。プロセスのスクリーンショットを保存してください。

Web-Tutorial.com

Web-Tutorial 技術チーム

複数の開発者によって共同維持されているプログラミングチュートリアルプラットフォーム。各チュートリアルは専門分野の開発者が執筆・レビューしています。正確で信頼性の高いコンテンツを目指しています — 問題を見つけた場合はお知らせください。

100%