複現資料變異性

在 R 中以插補處理遺漏值

Michal Oleszak

Machine Learning Engineer

插補值的變異性

邊際圖：以散佈圖呈現「Height」對「Weight」，其中任一變數經插補的值以不同顏色標示。

  • 插補值缺乏變異性。
  • 我們希望插補能複現觀測資料的變異。
  • 以模型為基礎的插補，對相同自變數會給出相同插補值。
  • 解法：自條件分配抽樣。
在 R 中以插補處理遺漏值

什麼是預測

多數統計模型會估計應變數的條件分配：

$p(y|X)$

若要做單一預測，會摘要此條件分配：

  • 線性迴歸：條件分配的期望值。
  • 邏輯斯迴歸：機率最高的類別。

改用從這些分配中抽樣，可增加變異性。

在 R 中以插補處理遺漏值

自條件分配抽樣

常態分配的機率密度函數圖，平均數 25 已標示。

在 R 中以插補處理遺漏值

自條件分配抽樣

一個含四欄的表格：邏輯斯迴歸的預測機率（每列均為 0.7）、是否大於 0.5 的布林值（每列為 TRUE）、依門檻插補的值（每列為 1），以及自條件分配抽樣的插補值（多數為 1，但有些為 0）。

在 R 中以插補處理遺漏值

邏輯斯迴歸插補

任務：用邏輯斯迴歸從 nhanes 資料插補 PhysActive。

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
在 R 中以插補處理遺漏值

邏輯斯迴歸插補

任務：用邏輯斯迴歸從 nhanes 資料插補 PhysActive。

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
logreg_model <- glm(PhysActive ~ Age + Weight + Pulse, 
                    data = nhanes_imp, family = binomial)
在 R 中以插補處理遺漏值

邏輯斯迴歸插補

任務：用邏輯斯迴歸從 nhanes 資料插補 PhysActive。

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
logreg_model <- glm(PhysActive ~ Age + Weight + Pulse, 
                    data = nhanes_imp, family = binomial)
preds <- predict(logreg_model, type = "response")
在 R 中以插補處理遺漏值

邏輯斯迴歸插補

任務：用邏輯斯迴歸從 nhanes 資料插補 PhysActive。

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
logreg_model <- glm(PhysActive ~ Age + Weight + Pulse, 
                    data = nhanes_imp, family = binomial)
preds <- predict(logreg_model, type = "response")
preds <- ifelse(preds >= 0.5, 1, 0)
在 R 中以插補處理遺漏值

邏輯斯迴歸插補

任務：用邏輯斯迴歸從 nhanes 資料插補 PhysActive。

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
logreg_model <- glm(PhysActive ~ Age + Weight + Pulse, 
                    data = nhanes_imp, family = binomial)
preds <- predict(logreg_model, type = "response")
preds <- ifelse(preds >= 0.5, 1, 0)
nhanes_imp[missing_physactive, "PhysActive"] <- preds[missing_physactive]
在 R 中以插補處理遺漏值

邏輯斯迴歸插補

插補值的變異性：

table(preds[missing_physactive])

 1 
26

觀測到的 PhysActive 資料變異性：

table(nhanes$PhysActive)

  0   1 
181 610
在 R 中以插補處理遺漏值

依類別機率抽樣

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
logreg_model <- glm(PhysActive ~ Age + Weight + Pulse, 
                    data = nhanes_imp, family = binomial)
preds <- predict(logreg_model, type = "response")
preds <- ifelse(preds >= 0.5, 1, 0)
nhanes_imp[missing_physactive, "PhysActive"] <- preds[missing_physactive]
在 R 中以插補處理遺漏值

依類別機率抽樣

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
logreg_model <- glm(PhysActive ~ Age + Weight + Pulse, 
                    data = nhanes_imp, family = binomial)
preds <- predict(logreg_model, type = "response")

nhanes_imp[missing_physactive, "PhysActive"] <- preds[missing_physactive]
在 R 中以插補處理遺漏值

依類別機率抽樣

nhanes_imp <- hotdeck(nhanes)
missing_physactive <- is.na(nhanes$PhysActive)
logreg_model <- glm(PhysActive ~ Age + Weight + Pulse, 
                    data = nhanes_imp, family = binomial)
preds <- predict(logreg_model, type = "response")
preds <- rbinom(length(preds), size = 1, prob = preds)
nhanes_imp[missing_physactive, "PhysActive"] <- preds[missing_physactive]
在 R 中以插補處理遺漏值

依類別機率抽樣

插補值的變異性：

table(preds[missing_physactive])

0  1 
5 21

觀測到的 PhysActive 資料變異性：

table(nhanes$PhysActive)

  0   1 
181 610
在 R 中以插補處理遺漏值

一起來練習吧！

在 R 中以插補處理遺漏值

Preparing Video For Download...