R: funzione glm con specifica famiglia = "binomiale" e "peso"


14

Sono molto confuso da come funziona il peso in glm con family = "binomial". Nella mia comprensione, la probabilità del glm con la famiglia = "binomiale" è specificata come segue: dove è la "proporzione di successo osservato" e è il numero noto di prove.yn

f(y)=(nny)pny(1-p)n(1-y)=exp(n[ylogp1-p-(-log(1-p))]+log(nny))
yn

A mio avviso, la probabilità di successo è parametrizzata con alcuni coefficienti lineari \ beta come p = p (\ beta) e funzione glm con family = "binomial" cerca: \ textrm {arg} \ max _ {\ beta} \ sum_i \ log f (y_i). Quindi questo problema di ottimizzazione può essere semplificato come:β p = p ( β ) arg max β i log f ( y i ) .pβp=p(β)

argmaxβilogf(yi).

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

Quindi se lasciamo nio*=nioc per tutti io=1,...,N per qualche costante c , allora deve anche essere vero che:
argmaxβΣiologf(yio)=argmaxβΣionio*[yiologp(β)1-p(β)-(-log(1-p(β)))]
Da questo, ho pensato che il ridimensionamento del numero di prove nio con una costante NON influisce sulle stime di massima verosimiglianza di data la percentuale di successoβyio .

Il file di aiuto di glm dice:

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

Pertanto mi aspettavo che il ridimensionamento del peso non influisse sulla stima data la percentuale di successo come risposta. Tuttavia i seguenti due codici restituiscono valori di coefficiente diversi:β

 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)

Questo produce:

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

 Coefficients:
 (Intercept)  
      -2.197     

mentre se moltiplico tutti i pesi per 1000, i coefficienti stimati sono diversi:

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

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

 Coefficients:
 (Intercept)  
    -3.153e+15  

Ho visto molti altri esempi come questo anche con un modesto ridimensionamento dei pesi. Cosa sta succedendo qui?


3
Per quello che vale, l' weightsargomento finisce in due punti all'interno della glm.fitfunzione (in glm.R ), che è ciò che fa il lavoro in R: 1) nei residui di devianza, tramite la funzione C binomial_dev_resids(in family.c ) e 2) nell'IWLS tramite Cdqrls(in lm.c ). Non conosco abbastanza C per essere di maggiore aiuto nel tracciare la logica
Shadowtalker,

3
Controlla qui le risposte .
Stat

@ssdecontrol Sto leggendo glm.fit nel link che mi hai dato ma non riesco a trovare dove la funzione C "binomial_dev_resids" è chiamata in glm.fit. Ti dispiacerebbe se lo fai notare?
FairyOnIce

@ssdecontrol Oh, scusa, penso di aver capito. Ogni "famiglia" è un elenco e uno degli elementi è "dev.resids". Quando scrivo il binomio nella console R, vedo la definizione dell'oggetto binomiale e ha una linea: dev.resids <- function (y, mu, wt) .Call (C_binomial_dev_resids, y, mu, wt)
FairyOnIce

Risposte:


4

Il tuo esempio sta semplicemente causando un errore di arrotondamento in R. I pesi di grandi dimensioni non funzionano bene glm. È vero che il ridimensionamento wdi praticamente qualsiasi numero più piccolo, come 100, porta alle stesse stime dei non graduati w.

Se si desidera un comportamento più affidabile con gli argomenti dei pesi, provare a utilizzare la svyglmfunzione dal surveypacchetto.

Vedere qui:

    > 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

1

glm.fitfamily$initializeglm.fitWXXW

Il $intializecodice rilevante è:

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!")
}

Ecco una versione semplificata di glm.fitcui mostra il mio 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"

Possiamo ripetere l'ultima parte altre due volte per vedere che il metodo Newton-Raphson differisce:

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

Questo non succede se inizi weights <- 1:nrow(y)o dici weights <- 1:nrow(y) * 100.

Si noti che è possibile evitare divergenze impostando l' mustartargomento. Ad esempio

> 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

Penso che i pesi influiscano più degli argomenti da inizializzare. Con la regressione logistica, Newton Raphson stima la massima probabilità che esiste ed è unica quando i dati non sono separati. Fornire diversi valori iniziali all'ottimizzatore non arriverà a valori diversi, ma richiederà forse più tempo per arrivarci.
AdamO,

"Fornire diversi valori iniziali all'ottimizzatore non arriverà a valori diversi ..." . Bene, il metodo Newton non diverge e trova il massimo univoco nell'ultimo esempio in cui ho impostato i valori iniziali (vedi l'esempio in cui fornisco l' mustart argomento). Sembra una questione legata alla stima iniziale scadente .
Benjamin Christoffersen,
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.