Biais de régression logistique des événements rares: comment simuler les p sous-estimés avec un exemple minimal?

CrossValidated a plusieurs questions sur le moment et la manière d'appliquer la correction du biais des événements rares par King et Zeng (2001) . Je cherche quelque chose de différent: une démonstration minimale basée sur la simulation que le biais existe.

En particulier, King et Zeng State

"... dans les données d'événements rares, les biais dans les probabilités peuvent être significativement significatifs avec des tailles d'échantillon par milliers et sont dans une direction prévisible: les probabilités d'événement estimées sont trop faibles."

Voici ma tentative de simuler un tel biais dans 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)

Lorsque je lance ceci, j'ai tendance à obtenir de très petits scores z, et l'histogramme des estimations est très proche de centré sur la vérité p = 0,01.

Qu'est-ce que je rate? Est-ce que ma simulation n'est pas assez grande pour montrer le vrai biais (et évidemment très petit)? Le biais nécessite-t-il d'inclure une sorte de covariable (plus que l'ordonnée à l'origine)?

Mise à jour 1: King et Zeng incluent une approximation approximative du biais de dans l'équation 12 de leur article. Notant le dans le dénominateur, j'ai considérablement réduit pour être et relancé la simulation, mais toujours aucun biais dans les probabilités d'événement estimées n'est évident. (Je l'ai utilisé uniquement comme source d'inspiration. Notez que ma question ci-dessus concerne les probabilités d'événement estimées, pas .)$\beta_0$NN5$\hat \beta_0$

Mise à jour 2: suite à une suggestion dans les commentaires, j'ai inclus une variable indépendante dans la régression, conduisant à des résultats équivalents:

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

Explication: Je me suis utilisé pcomme variable indépendante, où pest un vecteur avec des répétitions d'une petite valeur (0,01) et d'une plus grande valeur (0,2). Au final, simne stocke que les probabilités estimées correspondant à et il n'y a aucun signe de biais.$p = 0.01$

Mise à jour 3 (5 mai 2016): cela ne modifie pas sensiblement les résultats, mais ma nouvelle fonction de simulation interne est

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

Explication: Le MLE lorsque y est identique à zéro n'existe pas ( merci aux commentaires ici pour le rappel ). R ne lance pas d'avertissement car sa « tolérance de convergence positive » est effectivement satisfaite. Plus libéralement parlant, le MLE existe et est moins l'infini, ce qui correspond à ; d'où ma mise à jour de fonction. La seule autre chose cohérente à laquelle je peux penser est de rejeter les cycles de simulation où y est identique à zéro, mais cela conduirait clairement à des résultats encore plus contraires à l'affirmation initiale selon laquelle "les probabilités d'événement estimées sont trop petites".$p=0$

C'est une question intéressante - j'ai fait quelques simulations que je poste ci-dessous dans l'espoir que cela stimule la discussion.

Tout d'abord, quelques remarques générales:

• L'article que vous citez concerne les biais liés aux événements rares. Ce qui n'était pas clair pour moi auparavant (également en ce qui concerne les commentaires qui ont été faits ci-dessus), c'est s'il y a quelque chose de spécial dans les cas où vous avez 10/10000 par opposition à 10/30 observations. Cependant, après quelques simulations, je suis d'accord.

• Un problème que j'avais en tête (je l'ai rencontré souvent, et il y a eu récemment un article dans Methods in Ecology and Evolution à ce sujet, je n'ai pas pu trouver la référence cependant) est que vous pouvez obtenir des cas dégénérés avec des GLM en petites données situations, où le MLE est loin de la vérité, ou même à - / + infini (en raison du lien non linéaire, je suppose). Je ne sais pas comment traiter ces cas dans l'estimation du biais, mais d'après mes simulations, je dirais qu'ils semblent essentiels pour le biais des événements rares. Mon intuition serait de les supprimer, mais alors on ne sait pas trop dans quelle mesure ils doivent être retirés. Peut-être quelque chose à garder à l'esprit pour la correction des biais.

• De plus, ces cas dégénérés semblent enclins à causer des problèmes numériques (j'ai donc augmenté le maxit dans la fonction glm, mais on pourrait aussi penser à augmenter epsilon pour s'assurer que l'on rapporte bien le vrai MLE).

Quoi qu'il en soit, voici un code qui calcule la différence entre les estimations et la vérité pour l'interception, la pente et les prédictions dans une régression logistique, d'abord pour une situation d'échantillon faible / d'incidence modérée:

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)

Le biais résultant et les erreurs standard pour l'interception, la pente et la prédiction sont

-0.120429315  0.296453122 -0.001619793
 0.016105833  0.032835468  0.002040664

Je conclurais qu'il existe des preuves assez bonnes pour un léger biais négatif dans l'ordonnée à l'origine et un léger biais positif dans la pente, bien qu'un examen des résultats tracés montre que le biais est faible par rapport à la variance des valeurs estimées.

Si je règle les paramètres sur une situation d'événement rare

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

Je reçois un biais plus important pour l'interception, mais toujours AUCUN sur la prédiction

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

Dans l'histogramme des valeurs estimées, on voit le phénomène d'estimations dégénérées des paramètres (si on les appelle ainsi)

Supprimons toutes les lignes pour lesquelles les estimations d'interception sont <20

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

Le biais diminue et les choses deviennent un peu plus claires dans les chiffres - les estimations des paramètres ne sont clairement pas distribuées normalement. Je me demande que cela signifie pour la validité des IC qui sont signalés.

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

Je conclurais que le biais des événements rares sur l'ordonnée à l'origine est motivé par les événements rares eux-mêmes, à savoir ces estimations rares et extrêmement petites. Je ne sais pas si nous voulons les supprimer ou non, je ne sais pas quelle serait la coupure.

Une chose importante à noter cependant est que, de toute façon, il ne semble y avoir aucun biais sur les prédictions à l'échelle de la réponse - la fonction de lien absorbe simplement ces valeurs extrêmement faibles.

Un biais d'événements rares ne se produit que lorsqu'il existe des régresseurs. Cela ne se produira pas dans un modèle d'interception uniquement comme celui simulé ici. Voir cet article pour plus de détails: http://statisticalhorizons.com/linear-vs-logistic#comment-276108

La figure 7 du document semble répondre le plus directement à la question du biais dans les prévisions. Je ne comprends pas complètement la figure (en particulier, l'interprétation "les probabilités d'événement estimées sont trop petites" semble être une simplification excessive) mais j'ai réussi à reproduire quelque chose de similaire en fonction de leur description concise de leur simulation dans la section 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')

Le premier graphique est ma réplication de leur figure 7, avec l'ajout de courbes en pointillés représentant la gamme complète des résultats sur 10 essais.

Selon l'article, xvoici une variable prédictive dans la régression tirée d'une normale standard. Ainsi, comme illustré dans le deuxième graphique, la fréquence relative des observations pour x > 3(où le biais le plus visible se produit dans le premier graphique) est de plus en plus faible.

Le troisième graphique montre les "vraies" probabilités de simulation dans le processus de génération en fonction de x. Il apparaît que le biais le plus important se produit là où il xest rare ou inexistant.

Pris ensemble, ceux-ci suggèrent que le PO a complètement mal interprété l'allégation centrale du document en confondant "événement rare" (c'est-à-dire x > 3) avec "événement pour lequel P(Y = 1)est très petit". On peut supposer que le document concerne le premier au lieu du second.