Рідкісні похибки логістичної регресії: як імітувати занижені р з мінімальним прикладом?

У CrossValidated є кілька запитань щодо того, коли і як застосувати виправлення зміщення рідкісних подій Кінгом і Дзенгом (2001) . Я шукаю щось інше: мінімальна демонстрація на основі симуляції того, що упередженість існує.

Зокрема, Кінг і Дзенг

"... у даних про рідкісні події ухили до ймовірностей можуть мати істотне значення з розмірами вибірки в тисячах і знаходяться в передбачуваному напрямку: передбачувані ймовірності подій занадто малі."

Ось моя спроба моделювати такий зміщення в R:

# FUNCTIONS
do.one.sim = function(p){
    N = length(p)
    # Draw fake data based on probabilities p  
    y = rbinom(N, 1, p)  
    # Extract the fitted probability.
    #    If p is constant, glm does y ~ 1, the intercept-only model.
    #    If p is not constant, assume its smallest value is p[1]:
    glm(y ~ p, family = 'binomial')$fitted[1]
}
mean.of.K.estimates = function(p, K){
    mean(replicate(K, do.one.sim(p) ))
}

# MONTE CARLO
N = 100
p = rep(0.01, N)
reps = 100
# The following line may take about 30 seconds
sim = replicate(reps, mean.of.K.estimates(p, K=100))
# Z-score:
abs(p[1]-mean(sim))/(sd(sim)/sqrt(reps))
# Distribution of average probability estimates:
hist(sim)

Коли я запускаю це, я, як правило, отримую дуже малі z-бали, і гістограма оцінок дуже близька до центру правдивості p = 0,01.

Що я пропускаю? Це те, що моє моделювання недостатньо велике, показує справжню (і очевидно, дуже малу) упередженість? Чи вимагає включення ухилу якийсь коваріат (більше, ніж перехоплення)?

Оновлення 1: Кінг і Зенг містять приблизне наближення для зміщення у рівнянні 12 своєї статті. Зазначивши знаменник у знаменнику, я різко скоротився до того, щоб перетворити симуляцію та перепрофілював її, але все ж ніяких упереджень у передбачуваних ймовірностях події не видно. (Я використовував це лише як натхнення. Зверніть увагу , що моє запитання вище становить близько розрахункових ймовірностей подій, а НЕ β 0 ) .$\beta_0$NN5$\hat \beta_0$

Оновлення 2: Після пропозиції в коментарях я включив в регресію незалежну змінну, що призводить до еквівалентних результатів:

p.small = 0.01
p.large = 0.2
p = c(rep(p.small, round(N/2) ), rep(p.large, N- round(N/2) ) )
sim = replicate(reps, mean.of.K.estimates(p, K=100))

Пояснення: Я використовував pсебе як незалежну змінну, де pвектор з повторами малого значення (0,01) та більшого значення (0,2). Зрештою, simзберігається лише орієнтовна ймовірність, що відповідає і немає ознак упередженості.$p = 0.01$

Оновлення 3 (5 травня 2016 р.): Це помітно не змінює результати, але моя нова функція внутрішнього моделювання є

do.one.sim = function(p){
    N = length(p)
    # Draw fake data based on probabilities p  
    y = rbinom(N, 1, p)
    if(sum(y) == 0){ # then the glm MLE = minus infinity to get p = 0
        return(0)
    }else{
        # Extract the fitted probability.
        #    If p is constant, glm does y ~ 1, the intercept only model.
        #    If p is not constant, assume its smallest value is p[1]:
        return(glm(y ~ p, family = 'binomial')$fitted[1])
    }
}

$p=0$

Це цікаве питання - я зробив декілька моделей, які розміщую нижче, сподіваючись, що це стимулює подальшу дискусію.

Перш за все, кілька загальних коментарів:

• Документ, який ви цитуєте, стосується упередженості рідкісних подій. Те, що мені раніше не було зрозуміло (також стосовно коментарів, які були зроблені вище), це якщо є щось особливе стосовно випадків, коли у вас є 10/10000 на відміну від 10/30 спостережень. Однак, після деяких симуляцій, я погодився б є.

• Проблема, яку я мав на увазі (я часто стикався з цим, і нещодавно в статті «Методи з екології та еволюції», на яку я не міг знайти посилання), є те, що ви можете отримати вироджені випадки з ГЛМ у малих даних ситуації, коли MLE знаходиться на відстані від істини, або навіть у - / + нескінченності (я вважаю, що нелінійне посилання я думаю). Мені незрозуміло, як слід ставитися до цих випадків при оцінці упередженості, але з моїх симуляцій я б сказав, що вони здаються ключовими для упереджених випадків. Моя інтуїція полягала б у тому, щоб видалити їх, але тоді не зовсім зрозуміло, як далеко вони повинні бути видалені. Можливо, щось слід пам’ятати для корекції упередженості.

• Крім того, ці вироджені випадки можуть спричинити чисельні проблеми (тому я збільшив максимум у функції glm, але можна подумати і про збільшення epsilon, щоб переконатися, що він справді повідомляє справжній MLE).

У будь-якому випадку, тут є якийсь код, який обчислює різницю між оцінками та істинністю для перехоплення, нахилу та прогнозів у логістичній регресії, спочатку для низького розміру вибірки / помірної кількості випадків:

set.seed(123)
replicates = 1000
N= 40
slope = 2 # slope (linear scale)
intercept = - 1 # intercept (linear scale)

bias <- matrix(NA, nrow = replicates, ncol = 3)
incidencePredBias <- rep(NA, replicates)

for (i in 1:replicates){
  pred = runif(N,min=-1,max=1) 
  linearResponse = intercept + slope*pred
  data = rbinom(N, 1, plogis(linearResponse))  
  fit <- glm(data ~ pred, family = 'binomial', control = list(maxit = 300))
  bias[i,1:2] = fit$coefficients - c(intercept, slope)
  bias[i,3] = mean(predict(fit,type = "response")) - mean(plogis(linearResponse))
}

par(mfrow = c(1,3))
text = c("Bias intercept", "Bias slope", "Bias prediction")

for (i in 1:3){
  hist(bias[,i], breaks = 100, main = text[i])
  abline(v=mean(bias[,i]), col = "red", lwd = 3)  
}

apply(bias, 2, mean)
apply(bias, 2, sd) / sqrt(replicates)

Отримані упередження та стандартні помилки для перехоплення, нахилу та прогнозування є

-0.120429315  0.296453122 -0.001619793
 0.016105833  0.032835468  0.002040664

Я б зробив висновок, що є досить хороші докази незначного негативного зміщення перехоплення та незначного позитивного зміщення у схилі, хоча погляд на намічені результати показує, що ухил невеликий порівняно з дисперсією оціночних значень.

Якщо я встановлюю параметри на ситуацію, що рідко відбувається

N= 4000
slope = 2 # slope (linear scale)
intercept = - 10 # intercept (linear scale)

Я отримую більшу упередженість щодо перехоплення, але все ще НІКОЛИ на прогнозі

   -1.716144e+01  4.271145e-01 -3.793141e-06
    5.039331e-01  4.806615e-01  4.356062e-06

У гістограмі оцінених значень ми бачимо явище вироджених оцінок параметрів (якщо їх слід так називати)

Видалимо всі рядки, для яких оцінка перехоплення становить <20

apply(bias[bias[,1] > -20,], 2, mean)
apply(bias[bias[,1] > -20,], 2, sd) / sqrt(length(bias[,1] > -10))

Зміщення зменшується, і на малюнках все стає дещо чіткішим - оцінки параметрів явно не розподіляються. Цікаво, що це означає для дійсності ІС, про які повідомляється.

-0.6694874106  1.9740437782  0.0002079945
1.329322e-01 1.619451e-01 3.242677e-06

Я б зробив висновок, що рідкісні упередження подій на перехоплення визначаються самими рідкісними подіями, а саме тими рідкісними, надзвичайно малими оцінками. Не впевнені, хочемо ми їх видалити чи ні, не впевнені, що буде зрізом.

Важливо зауважити, що в будь-якому випадку, здається, немає упередженості прогнозувань на шкалі відгуку - функція зв'язку просто поглинає ці надзвичайно малі значення.

Зсув рідкісних подій відбувається лише тоді, коли є регресори. Це не відбудеться в моделі, що перехоплює лише одну, як модель, що імітується тут. Детальніше дивіться у цій публікації: http://statistichorizons.com/linear-vs-logistic#comment-276108

Малюнок 7 у статті, як видається, найбільш безпосередньо стосується питання упередженості прогнозів. Я не повністю розумію цифру (конкретно, тлумачення "передбачувані ймовірності подій занадто малі" здається надмірним спрощенням), але мені вдалося відтворити щось подібне до неї, грунтуючись на їх короткому описі їх моделювання в Розділі 6.1:

n_grid = 40
x_grid = seq(0, 7, length.out = n_grid)
beta0 = -6
beta1 = 1

inverse_logit = function(x) 1/(1 + exp(-x))

do.one.sim = function(){
    N = 5000
    x = rnorm(N)
    p = inverse_logit(beta0 + beta1*x)
    # Draw fake data based on probabilities p
    y = rbinom(N, 1, p)
    if(sum(y) == 0){ # then the glm MLE = minus infinity to get p = 0
        return(rep(0, n_grid))
    }else{
        # Extract the error
        mod = glm(y ~ x, family = 'binomial')
        truth = inverse_logit(beta0 + beta1*x_grid)
        pred = predict(mod, newdata = data.frame(x = x_grid),
            type = 'response')
        return(pred - truth)
    }
}
mean.of.K.estimates = function(K){
    rowMeans(replicate(K, do.one.sim()))
}

set.seed(1)
bias = replicate(10, mean.of.K.estimates(100))
maxes = as.numeric(apply(bias, 1, max))
mins = as.numeric(apply(bias, 1, min))

par(mfrow = c(3, 1), mar = c(4,4,2,2))
plot(x_grid, rowMeans(bias), type = 'l',
    ylim = c(min(bias), max(bias)),
    xlab = 'x', ylab = 'bias')
lines(x_grid, maxes, lty = 2)
lines(x_grid, mins, lty = 2)
plot(x_grid, dnorm(x_grid), type = 'l',
    xlab = 'x', ylab = 'standard normal density')
plot(x_grid, inverse_logit(beta0 + beta1*x_grid),
    xlab = 'x', ylab = 'true simulation P(Y = 1)',
    type = 'l')

Перший сюжет - це моя реплікація їх фігури 7, з додаванням пунктирних кривих, що представляють повний спектр результатів протягом 10 випробувань.

Згідно з документом, xтут є змінною прогнозу в регресії, проведеній зі стандартної норми. Таким чином, як проілюстровано у другому сюжеті, відносна частота спостережень за x > 3(де найбільш помітні зміщення трапляються в першому сюжеті) зменшується мало.

Третій графік показує "справжні" ймовірності моделювання в процесі генерації як функції x. Виявляється, найбільший ухил виникає там, де xвін рідкісний або не існує.

У сукупності вони говорять про те, що ОП повністю неправильно трактувала основну заяву статті, плутаючи "рідкісну подію" (тобто x > 3) з "подією, для якої P(Y = 1)дуже мало". Імовірно, стаття стосується першої замість другої.