Utilisation de lm pour le test de proportion à 2 échantillons

J'utilise des modèles linéaires pour effectuer des tests de proportion à 2 échantillons depuis un certain temps, mais je me suis rendu compte que cela pourrait ne pas être complètement correct. Il semble que l'utilisation d'un modèle linéaire généralisé avec un lien famille binomiale + identité donne exactement les résultats du test de proportion à 2 échantillons non regroupés. Cependant, l'utilisation d'un modèle linéaire (ou glm avec famille gaussienne) donne un résultat légèrement différent. Je rationalise que cela pourrait être dû à la façon dont R résout la glm pour les familles binomiales vs gaussiennes, mais pourrait-il y avoir une autre cause?

## prop.test gives pooled 2-sample proportion result
## glm w/ binomial family gives unpooled 2-sample proportion result
## lm and glm w/ gaussian family give unknown result

library(dplyr)
library(broom)
set.seed(12345)

## set up dataframe -------------------------
n_A <- 5000
n_B <- 5000

outcome <- rbinom(
  n = n_A + n_B,
  size = 1,
  prob = 0.5
)
treatment <- c(
  rep("A", n_A),
  rep("B", n_B)
)

df <- tbl_df(data.frame(outcome = outcome, treatment = treatment))


## by hand, 2-sample prop tests ---------------------------------------------
p_A <- sum(df$outcome[df$treatment == "A"])/n_A
p_B <- sum(df$outcome[df$treatment == "B"])/n_B

p_pooled <- sum(df$outcome)/(n_A + n_B)
z_pooled <- (p_B - p_A) / sqrt( p_pooled * (1 - p_pooled) * (1/n_A + 1/n_B) )
pvalue_pooled <- 2*(1-pnorm(abs(z_pooled)))

z_unpooled <- (p_B - p_A) / sqrt( (p_A * (1 - p_A))/n_A + (p_B * (1 - p_B))/n_B )
pvalue_unpooled <- 2*(1-pnorm(abs(z_unpooled)))


## using prop.test --------------------------------------
res_prop_test <- tidy(prop.test(
  x = c(sum(df$outcome[df$treatment == "A"]), 
        sum(df$outcome[df$treatment == "B"])),
  n = c(n_A, n_B),
  correct = FALSE
))
res_prop_test # same as pvalue_pooled
all.equal(res_prop_test$p.value, pvalue_pooled)
# [1] TRUE


# using glm with identity link -----------------------------------
res_glm_binomial <- df %>%
  do(tidy(glm(outcome ~ treatment, family = binomial(link = "identity")))) %>%
  filter(term == "treatmentB")
res_glm_binomial # same as p_unpooled
all.equal(res_glm_binomial$p.value, pvalue_unpooled)
# [1] TRUE


## glm and lm gaussian --------------------------------

res_glm <- df %>%
  do(tidy(glm(outcome ~ treatment))) %>%
  filter(term == "treatmentB")
res_glm 
all.equal(res_glm$p.value, pvalue_unpooled)
all.equal(res_glm$p.value, pvalue_pooled)

res_lm <- df %>%
  do(tidy(lm(outcome ~ treatment))) %>% 
  filter(term == "treatmentB")
res_lm
all.equal(res_lm$p.value, pvalue_unpooled)
all.equal(res_lm$p.value, pvalue_pooled)

all.equal(res_lm$p.value, res_glm$p.value)
# [1] TRUE

Ce n'est pas à voir avec la façon dont ils résolvent les problèmes d'optimisation qui correspondent à l'ajustement des modèles, c'est à voir avec les problèmes d'optimisation réels que posent les modèles.

Plus précisément, dans les grands échantillons, vous pouvez effectivement le considérer comme comparant deux problèmes de moindres carrés pondérés

lm$\text{Var}(\hat{p})=\text{Var}(X/n) = p(1-p)/n$

* au moins dans certaines situations, mais pas nécessairement dans une comparaison directe des proportions

En termes de calcul, comparer l'erreur standard du coefficient treatmentB pour lm vs glm binomial. Vous avez la formule de l'erreur standard du coefficient treatmentB dans le glm binomial (le dénominateur de z_unpooled). L'erreur type du coefficient treatmentB dans le lm standard est (SE_lm):

    test = lm(outcome ~ treatment, data = df)
    treat_B =  as.numeric(df$treatment == "B")
    SE_lm = sqrt( sum(test$residuals^2)/(n_A+n_B-2) / 
              sum((treat_B - mean(treat_B))^2))

$\sigma^2$$n_A+n_B$$-2$$n_A = n_B$