Pregiudizio di regressione logistica di eventi rari: come simulare le p sottostimate con un esempio minimo?

CrossValidated ha diverse domande su quando e come applicare la rara correzione del bias di eventi di King e Zeng (2001) . Sto cercando qualcosa di diverso: una dimostrazione minima basata sulla simulazione dell'esistenza del pregiudizio.

In particolare, il re e lo stato di Zeng

"... in dati di eventi rari le distorsioni nelle probabilità possono essere sostanzialmente significative con le dimensioni del campione in migliaia e sono in una direzione prevedibile: le probabilità di eventi stimate sono troppo piccole."

Ecco il mio tentativo di simulare un simile pregiudizio in 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)

Quando eseguo questo, tendo a ottenere punteggi z molto piccoli e l'istogramma delle stime è molto vicino al centrato sulla verità p = 0,01.

Che cosa mi manca? La mia simulazione non è abbastanza grande per mostrare il vero (e evidentemente molto piccolo) pregiudizio? Il pregiudizio richiede un tipo di covariata (più dell'intercettazione) da includere?

Aggiornamento 1: King e Zeng includono un'approssimazione approssimativa per il bias di nell'equazione 12 del loro articolo. Notando il nel denominatore, mi sono drasticamente ridotto e ho eseguito nuovamente la simulazione, ma non è ancora evidente alcuna distorsione nelle probabilità di evento stimate. (Ho usato questo solo come fonte di ispirazione. Nota che la mia domanda di cui sopra è di circa le probabilità di eventi stimate, non β 0 .)$\beta_0$NN5$\hat \beta_0$

Aggiornamento 2: seguendo un suggerimento nei commenti, ho incluso una variabile indipendente nella regressione, portando a risultati equivalenti:

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

Spiegazione: Mi sono usato pcome variabile indipendente, dove pè un vettore con una ripetizione di un valore piccolo (0,01) e un valore più grande (0,2). Alla fine, simmemorizza solo le probabilità stimate corrispondenti a e non vi è alcun segno di distorsione.$p = 0.01$

Aggiornamento 3 (5 maggio 2016): questo non modifica sensibilmente i risultati, ma la mia nuova funzione di simulazione interna è

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$

Questa è una domanda interessante: ho fatto alcune simulazioni che inserisco di seguito nella speranza che ciò stimoli ulteriori discussioni.

Prima di tutto, alcuni commenti generali:

• Il documento che citi riguarda il pregiudizio per eventi rari. Ciò che non mi era chiaro prima (anche per quanto riguarda i commenti che sono stati fatti sopra) è se c'è qualcosa di speciale nei casi in cui hai 10/10000 rispetto a 10/30 osservazioni. Tuttavia, dopo alcune simulazioni, sarei d'accordo che ci sia.

• Un problema che avevo in mente (l'ho riscontrato spesso e di recente c'era un articolo in Metodi in ecologia ed evoluzione su questo, non riuscivo a trovare il riferimento però) è che puoi ottenere casi degeneri con GLM in piccoli dati situazioni, in cui il MLE è FAAAR lontano dalla verità, o addirittura a - / + infinito (a causa del collegamento non lineare suppongo). Non mi è chiaro come si debbano trattare questi casi nella stima del bias, ma dalle mie simulazioni direi che sembrano fondamentali per il bias di eventi rari. La mia intuizione sarebbe quella di rimuoverli, ma poi non è del tutto chiaro quanto debbano essere rimossi. Forse qualcosa da tenere a mente per la correzione del bias.

• Inoltre, questi casi degeneri sembrano inclini a causare problemi numerici (ho quindi aumentato il massimo nella funzione glm, ma si potrebbe pensare di aumentare anche epsilon per assicurarsi che si riporti effettivamente il vero MLE).

Comunque, qui un codice che calcola la differenza tra stime e verità per intercettazione, pendenza e previsioni in una regressione logistica, prima per una dimensione del campione bassa / situazione di incidenza moderata:

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)

La distorsione risultante e gli errori standard per intercettazione, pendenza e previsione sono

-0.120429315  0.296453122 -0.001619793
 0.016105833  0.032835468  0.002040664

Concluderei che ci sono prove abbastanza buone per una leggera inclinazione negativa nell'intercetta e una leggera inclinazione positiva nella pendenza, anche se uno sguardo ai risultati tracciati mostra che la distorsione è piccola rispetto alla varianza dei valori stimati.

Se sto impostando i parametri su una situazione di evento raro

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

Sto ottenendo un pregiudizio maggiore per l'intercettazione, ma NESSUNO sulla previsione

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

Nell'istogramma dei valori stimati, vediamo il fenomeno delle stime degenerate dei parametri (se dovremmo chiamarli così)

Rimuoviamo tutte le righe per le quali le stime di intercettazione sono <20

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

La distorsione diminuisce e le cose diventano un po 'più chiare nelle figure: le stime dei parametri chiaramente non sono normalmente distribuite. Mi chiedo che ciò significhi per la validità degli EC segnalati.

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

Concluderei che la distorsione da evento raro sull'intercettazione è guidata da eventi rari stessi, vale a dire quelle stime rare ed estremamente piccole. Non sono sicuro se vogliamo rimuoverli o meno, non sono sicuro di quale sarebbe il taglio.

Una cosa importante da notare è che, in entrambi i casi, non sembra esserci alcun pregiudizio sulle previsioni sulla scala di risposta: la funzione di collegamento assorbe semplicemente questi valori estremamente piccoli.

La distorsione da eventi rari si verifica solo in presenza di regressori. Non si verificherà in un modello di sola intercettazione come quello simulato qui. Vedi questo post per dettagli: http://statisticalhorizons.com/linear-vs-logistic#comment-276108

La figura 7 nel documento sembra affrontare direttamente la questione della distorsione nelle previsioni. Non capisco fino in fondo la figura (in particolare, l'interpretazione "le probabilità di eventi stimate sono troppo piccole" sembra una semplificazione eccessiva) ma sono riuscito a riprodurre qualcosa di simile ad esso sulla base della loro descrizione concisa della loro simulazione nella Sezione 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')

La prima trama è la mia replica della loro figura 7, con l'aggiunta di curve tratteggiate che rappresentano l'intera gamma di risultati in 10 prove.

Come da articolo, xecco una variabile predittiva nella regressione ricavata da una normale norma. Pertanto, come illustrato nel secondo diagramma, la frequenza relativa delle osservazioni per x > 3(in cui si verifica la distorsione più visibile nel primo diagramma) è sempre più piccola.

Il terzo diagramma mostra le "vere" probabilità di simulazione nel processo di generazione in funzione di x. Sembra che il pregiudizio maggiore si verifichi laddove xè raro o inesistente.

Nel loro insieme, questi suggeriscono che il PO ha interpretato in modo errato la rivendicazione centrale dell'articolo confondendo "evento raro" (cioè x > 3) con "evento per il quale P(Y = 1)è molto piccolo". Presumibilmente il documento riguarda il primo anziché il secondo.