R: función glm con familia = especificación "binomial" y "peso"

14

Estoy muy confundido con cómo funciona el peso en glm con family = "binomial". En mi opinión, la probabilidad de la glm con family = "binomial" se especifica de la siguiente manera:

f(y)=(nny)pny(1p)n(1y)=exp(n[ylogp1p(log(1p))]+log(nny))
dondeyes la "proporción de éxito observado"n es el número conocido de ensayos.

En mi opinión, la probabilidad de éxito p se parametriza con algunos coeficientes lineales β como p=p(β) y la función glm con family = "binomial" busca:

argmaxβilogf(yi).
Entonces este problema de optimización se puede simplificar como:

argmaxβilogf(yi)=argmaxβini[yilogp(β)1p(β)(log(1p(β)))]+log(niniyi)=argmaxβini[yilogp(β)1p(β)(log(1p(β)))]

Por lo tanto, si dejamos que para toda i = 1 , . . . , N para alguna constante c , entonces también debe ser cierto que: arg max β i log f ( y i ) = arg max β i n i [ y i log p ( β )ni=nici=1,...,Nc
argmaxβilogf(yi)=argmaxβini[yilogp(β)1p(β)(log(1p(β)))]
A partir de esto, pensé que la escala del número de ensayos con una constante NO afecta las estimaciones de probabilidad máxima de β dada la proporción de éxito y iniβyyo .

El archivo de ayuda de glm dice:

 "For a binomial GLM prior weights are used to give the number of trials 
  when the response is the proportion of successes" 

Por lo tanto, esperaba que el aumento de peso no afectara la estimada dada la proporción de éxito como respuesta. Sin embargo, los siguientes dos códigos devuelven valores de coeficientes diferentes:β

 Y <- c(1,0,0,0) ## proportion of observed success
 w <- 1:length(Y) ## weight= the number of trials
 glm(Y~1,weights=w,family=binomial)

Esto produce:

 Call:  glm(formula = Y ~ 1, family = "binomial", weights = w)

 Coefficients:
 (Intercept)  
      -2.197     

mientras que si multiplico todos los pesos por 1000, los coeficientes estimados son diferentes:

 glm(Y~1,weights=w*1000,family=binomial)

 Call:  glm(formula = Y ~ 1, family = binomial, weights = w * 1000)

 Coefficients:
 (Intercept)  
    -3.153e+15  

Vi muchos otros ejemplos como este, incluso con una escala moderada en los pesos. ¿Que esta pasando aqui?

HadaOnIce
fuente
3
Por lo que vale, el weightsargumento termina en dos lugares dentro de la glm.fitfunción (en glm.R ), que es lo que hace el trabajo en R: 1) en los residuales de desviación, a través de la función C binomial_dev_resids(en family.c ) y 2) en el paso IWLS a modo de Cdqrls(en lm.c ). No sé lo suficiente C para ser de más ayuda en el seguimiento de la lógica
shadowtalker
3
Mira las respuestas aquí .
Estadísticas
@ssdecontrol Estoy leyendo a través de glm.fit en el enlace que me diste pero no puedo encontrar dónde se llama la función C "binomial_dev_resids" en glm.fit. ¿Te importaría si lo señalas?
FairyOnIce
@ssdecontrol Oh, lo siento, creo que entiendo. Cada "familia" es una lista y uno de los elementos es "dev.resids". Cuando escribo binomial en la consola R, veo la definición del objeto binomial y tiene una línea: dev.resids <- function (y, mu, wt) .Call (C_binomial_dev_resids, y, mu, wt)
FairyOnIce

Respuestas:

4

Su ejemplo simplemente está causando un error de redondeo en R. Los pesos grandes no funcionan bien en glm. Es cierto que escalar wen prácticamente cualquier número más pequeño, como 100, conduce a las mismas estimaciones que las sin escalaw .

Si desea un comportamiento más confiable con los argumentos de pesos, intente usar la svyglmfunción delsurvey paquete.

Mira aquí:

    > svyglm(Y~1, design=svydesign(ids=~1, weights=~w, data=data.frame(w=w*1000, Y=Y)), family=binomial)
Independent Sampling design (with replacement)
svydesign(ids = ~1, weights = ~w, data = data.frame(w = w * 1000, 
    Y = Y))

Call:  svyglm(formula = Y ~ 1, design = svydesign(ids = ~1, weights = ~w2, 
    data = data.frame(w2 = w * 1000, Y = Y)), family = binomial)

Coefficients:
(Intercept)  
     -2.197  

Degrees of Freedom: 3 Total (i.e. Null);  3 Residual
Null Deviance:      2.601 
Residual Deviance: 2.601    AIC: 2.843
AdamO
fuente
1

glm.fitfamily$initializeglm.fitWXXW

El $intializecódigo relevante es:

if (NCOL(y) == 1) {
    if (is.factor(y)) 
        y <- y != levels(y)[1L]
    n <- rep.int(1, nobs)
    y[weights == 0] <- 0
    if (any(y < 0 | y > 1)) 
        stop("y values must be 0 <= y <= 1")
    mustart <- (weights * y + 0.5)/(weights + 1)
    m <- weights * y
    if (any(abs(m - round(m)) > 0.001)) 
        warning("non-integer #successes in a binomial glm!")
}

Aquí hay una versión simplificada de la glm.fitcual muestra mi punto

> #####
> # setup
> y <- matrix(c(1,0,0,0), ncol = 1)
> weights <- 1:nrow(y) * 1000
> nobs <- length(y)
> family <- binomial()
> X <- matrix(rep(1, nobs), ncol = 1) # design matrix used later
> 
> # set mu start as with family$initialize
> if (NCOL(y) == 1) {
+   n <- rep.int(1, nobs)
+   y[weights == 0] <- 0
+   mustart <- (weights * y + 0.5)/(weights + 1)
+   m <- weights * y
+   if (any(abs(m - round(m)) > 0.001)) 
+     warning("non-integer #successes in a binomial glm!")
+ }
> 
> mustart # starting value
             [,1]
[1,] 0.9995004995
[2,] 0.0002498751
[3,] 0.0001666111
[4,] 0.0001249688
> (eta <- family$linkfun(mustart))
          [,1]
[1,]  7.601402
[2,] -8.294300
[3,] -8.699681
[4,] -8.987322
> 
> #####
> # Start loop to fit
> mu <- family$linkinv(eta)
> mu_eta <- family$mu.eta(eta)
> z <- drop(eta + (y - mu) / mu_eta)
> w <- drop(sqrt(weights * mu_eta^2 / family$variance(mu = mu)))
> 
> # code is simpler here as (X^T W X) is a scalar
> X_w <- X * w
> (.coef <- drop(crossprod(X_w)^-1 * ((w * z) %*% X_w)))
[1] -5.098297
> (eta <- .coef * X)
          [,1]
[1,] -5.098297
[2,] -5.098297
[3,] -5.098297
[4,] -5.098297
> 
> # repeat a few times from "start loop to fit"

Podemos repetir la última parte dos veces más para ver que el método Newton-Raphson diverge:

> #####
> # Start loop to fit
> mu <- family$linkinv(eta)
> mu_eta <- family$mu.eta(eta)
> z <- drop(eta + (y - mu) / mu_eta)
> w <- drop(sqrt(weights * mu_eta^2 / family$variance(mu = mu)))
> 
> # code is simpler here as (X^T W X) is a scalar
> X_w <- X * w
> (.coef <- drop(crossprod(X_w)^-1 * ((w * z) %*% X_w)))
[1] 10.47049
> (eta <- .coef * X)
         [,1]
[1,] 10.47049
[2,] 10.47049
[3,] 10.47049
[4,] 10.47049
> 
> 
> #####
> # Start loop to fit
> mu <- family$linkinv(eta)
> mu_eta <- family$mu.eta(eta)
> z <- drop(eta + (y - mu) / mu_eta)
> w <- drop(sqrt(weights * mu_eta^2 / family$variance(mu = mu)))
> 
> # code is simpler here as (X^T W X) is a scalar
> X_w <- X * w
> (.coef <- drop(crossprod(X_w)^-1 * ((w * z) %*% X_w)))
[1] -31723.76
> (eta <- .coef * X)
          [,1]
[1,] -31723.76
[2,] -31723.76
[3,] -31723.76
[4,] -31723.76

Esto no sucede si comienzas weights <- 1:nrow(y)o dices weights <- 1:nrow(y) * 100.

Tenga en cuenta que puede evitar divergencias configurando el mustartargumento. Eg hacer

> glm(Y ~ 1,weights = w * 1000, family = binomial, mustart = rep(0.5, 4))

Call:  glm(formula = Y ~ 1, family = binomial, weights = w * 1000, mustart = rep(0.5, 
    4))

Coefficients:
(Intercept)  
     -2.197  

Degrees of Freedom: 3 Total (i.e. Null);  3 Residual
Null Deviance:      6502 
Residual Deviance: 6502     AIC: 6504
Benjamin Christoffersen
fuente
Creo que los pesos afectan más que los argumentos para inicializar. Con la regresión logística, Newton Raphson estima la probabilidad máxima que existe y es única cuando los datos no están separados. Proporcionar diferentes valores iniciales al optimizador no llegará a diferentes valores, pero tal vez llevará más tiempo llegar allí.
AdamO
"Proporcionar valores de inicio diferentes al optimizador no llegará a valores diferentes ..." . Bueno, el método de Newton no diverge y encuentra el máximo único en el último ejemplo donde configuré los valores iniciales (vea el ejemplo donde proporciono el mustart argumento). Parece un asunto relacionado con una mala estimación inicial .
Benjamin Christoffersen