井出草平の研究ノート

感度分析(Leave-one-out)・クックの距離・DFBETAS

今回はケースが一つなかったとしても安定した推定が回帰分析において可能かを調べるためら感度分析を行う。

mtcarsデータセットを使用する。

data <- mtcars
model <- mpg ~ wt + hp

感度分析 sensitivityパッケージ

感度分析で、ケースを1名ずつ除外したモデルを自動生成し評価する。感度分析にはいくつかの方法があるが、今回の目的に向いているのはLeave-one-out法である。

library(sensitivity)

# データの準備
data <- mtcars
n <- nrow(data)

# 結果を格納する配列の初期化
results <- matrix(NA, nrow = n, ncol = 3)
colnames(results) <- c("wt", "hp", "intercept")

# leave-one-out分析の実行
for(i in 1:n) {
    # i番目のケースを除いたデータセットで回帰分析
    model_i <- lm(mpg ~ wt + hp, data = data[-i,])
    
    # 係数を保存
    results[i,] <- coef(model_i)
}

# オリジナルの回帰係数
original_coef <- coef(lm(mpg ~ wt + hp, data = data))

# 結果の要約
summary_results <- data.frame(
    coefficient = names(original_coef),
    original = original_coef,
    mean = colMeans(results),
    sd = apply(results, 2, sd),
    min = apply(results, 2, min),
    max = apply(results, 2, max)
)

# 結果の表示
print(summary_results)

# 係数の変動を箱ひげ図で可視化
boxplot(results, 
        main="Sensitivity of Regression Coefficients",
        ylab="Coefficient Value")
abline(h=0, lty=2, col="red")

結果

            coefficient    original        mean          sd         min         max
(Intercept) (Intercept) 37.22727012 37.22938685 0.400479099 36.05264248 38.57946617
wt                   wt -3.87783074 -3.87660057 0.138024437 -4.41965838 -3.56296301
hp                   hp -0.03177295 -0.03183678 0.001684373 -0.03955498 -0.0291948

分析では、自動車のデータを使って燃費に対する重量と馬力の影響を調べる重回帰分析の安定性を評価した。分析方法として、データから1台ずつ車を除いて計算を繰り返し、係数がどの程度変化するのかを調べた。

分析の結果、モデルは非常に安定していることがわかった。まず、切片(定数項)は約37.2という値を示し、車を1台除いても36.1から38.6の間でしか変動しなかった。

重量の影響を見ると、係数は約-3.9を示しており、これは重量が1単位増えると燃費が3.9マイル/ガロン減少することを意味する。この関係性も安定しており、どの車を除いても-4.4から-3.6の範囲内に収まっている。

馬力についても同様に安定した結果が得られた。係数は約-0.032で、馬力が1馬力増えると燃費が0.032マイル/ガロン減少する関係を示している。この値も車を1台除いても-0.040から-0.029の狭い範囲でしか変動しなかった。

このように、今回の分析では特定の車のデータに大きく依存することなく、重量と馬力が燃費に与える影響を安定して推定できることが確認できた。

箱ひげ図

回帰係数の感度分析の結果を示す。横軸には3つのパラメータ(重量wt、馬力hp、切片intercept)が示され、縦軸は係数の値を表している。

各パラメータは以下のように解釈できる:

  1. 重量(wt): 箱の位置が約-4付近にあり、ほとんどの係数がこの近くに集中している。ひげの長さが比較的短く、外れ値も見られない。これは重量の係数が安定していることを示すものである。

  2. 馬力(hp): 箱が0に近い位置(約-0.03付近)にある。箱とひげの範囲が非常に狭く、係数の変動が小さい。これは馬力の係数が非常に安定していることを示している。

  3. 切片(intercept): 箱の位置が約37付近にある。ひげの長さは他のパラメータと同様に短い。これは切片も安定した値を示していることを表している。

図中の点線(y=0)は基準線を示すものであり、係数が正か負かを判断する際の参考となる。全体として、この箱ひげ図からはどのパラメータも安定した推定値を示していることが確認できる。

クックの距離とDFBETAS

クックの距離

クックの距離は、個々のデータポイントがモデル全体に与える影響度を測る指標である。この統計量は、あるデータポイントを除外した場合の予測値の変化に基づいて計算される。一般的に、4/n(nはサンプルサイズ)を超える値を示すケースは、影響度が高いと判断される。クックの距離が大きい観測値は、回帰モデルの推定に強い影響を与えている可能性がある。

DFBETAS

DFBETASは、個々のデータポイントが各回帰係数の推定値に与える影響を測る指標である。この統計量は、特定のデータポイントを除外した場合の回帰係数の変化を標準化したものである。一般的に、絶対値が2/√n を超える値を示すケースは、その係数の推定に対して強い影響を持つと判断される。

ちなみにD は「Difference」(差分)の略でFBETAS は「標準化された回帰係数の変化」のことで、ディー・エフ・ベータスと読む。

# クックの距離の計算
data <- mtcars
model <- lm(mpg ~ wt + hp, data = data)

# クックの距離
cooks_d <- cooks.distance(model)

# DFBETASの計算
dfbetas <- dfbetas(model)

# 結果の表示
results_df <- data.frame(
   car = rownames(data),
   cooks_d = cooks_d,
   dfbetas_intercept = dfbetas[,"(Intercept)"],
   dfbetas_wt = dfbetas[,"wt"],
   dfbetas_hp = dfbetas[,"hp"]
)

# 閾値の計算(一般的な基準)
n <- nrow(data)
p <- length(coef(model))
cooks_threshold <- 4/n
dfbetas_threshold <- 2/sqrt(n)

影響の大きいケースの特定

influential_cases <- results_df[results_df$cooks_d > cooks_threshold,]
print("クックの距離が閾値を超えるケース:")
print(influential_cases)
                                car   cooks_d dfbetas_intercept dfbetas_wt dfbetas_hp
Chrysler Imperial Chrysler Imperial 0.4236109      -0.924056752  0.9355997 -0.1480098
Fiat 128                   Fiat 128 0.1574263       0.605181396 -0.1672759 -0.3112466
Toyota Corolla       Toyota Corolla 0.2083933       0.804669969 -0.4114606 -0.1709342
Maserati Bora         Maserati Bora 0.2720397      -0.007482815 -0.4999049  0.8657637

DFBETASで影響の大きいケースの特定

dfbetas_influential <- results_df[apply(abs(dfbetas) > dfbetas_threshold, 1, any),]
print("DFBETASが閾値を超えるケース:")
print(dfbetas_influential)
                                car    cooks_d dfbetas_intercept dfbetas_wt dfbetas_hp
Chrysler Imperial Chrysler Imperial 0.42361090      -0.924056752  0.9355997 -0.1480098
Fiat 128                   Fiat 128 0.15742629       0.605181396 -0.1672759 -0.3112466
Toyota Corolla       Toyota Corolla 0.20839326       0.804669969 -0.4114606 -0.1709342
Lotus Europa           Lotus Europa 0.07353985       0.423409344 -0.4072338  0.1883967
Maserati Bora         Maserati Bora 0.27203975      -0.007482815 -0.4999049  0.8657637

Chrysler Imperial と Maserati Bora は、クックの距離とDFBETASの両方で高い影響力を示しており、特にモデル全体や特定の変数に対して注意が必要である。一方で、Fiat 128 と Toyota Corolla は中程度の影響を示しているが、モデルの安定性に対するリスクは比較的小さい。