R: fungsi glm dengan spesifikasi family = "binomial" dan "weight"

Saya sangat bingung dengan bagaimana berat bekerja di glm dengan family = "binomial". Dalam pemahaman saya, kemungkinan glm dengan family = "binomial" ditentukan sebagai berikut: mana adalah "proporsi keberhasilan yang diamati" dan adalah jumlah percobaan yang diketahui.y

$$f(y) = {n\choose{ny}} p^{ny} (1-p)^{n(1-y)} = \exp \left(n \left[ y \log \frac{p}{1-p} - \left(-\log (1-p)\right) \right] + \log {n \choose ny}\right)$$ $y$$n$

Dalam pemahaman saya, probabilitas keberhasilan adalah parametrized dengan beberapa koefisien linier sebagai dan fungsi glm dengan pencarian family = "binomial" untuk: Maka masalah optimasi ini dapat disederhanakan sebagai:β p = p ( β ) arg max β ∑$p$$\beta$$p=p(\beta)$

$$\textrm{arg}\max_{\beta} \sum_i \log f(y_i).$$

$$\textrm{arg}\max_{\beta} \sum_i \log f(y_i)= \textrm{arg}\max_{\beta} \sum_i n_i \left[ y_i \log \frac{p(\beta)}{1-p(\beta)} - \left(-\log (1-p(\beta))\right) \right] + \log {n_i \choose n_iy_i}\\ = \textrm{arg}\max_{\beta} \sum_i n_i \left[ y_i \log \frac{p(\beta)}{1-p(\beta)} - \left(-\log (1-p(\beta))\right) \right] \\ $$
Oleh karena itu jika kita membiarkan $n_i^*=n_ic$ untuk semua $i=1,...,N$ untuk beberapa konstanta $c$ , maka harus juga benar bahwa: $$\textrm{arg}\max_{\beta} \sum_i \log f(y_i) = \textrm{arg}\max_{\beta} \sum_i n^*_i \left[ y_i \log \frac{p(\beta)}{1-p(\beta)} - \left(-\log (1-p(\beta))\right) \right] \\ $$ Dari sini, saya berpikir bahwa Scaling dari jumlah percobaan $n_i$dengan konstanta TIDAK mempengaruhi perkiraan kemungkinan maksimum $\beta$ mengingat proporsi keberhasilan $y_i$ .

File bantuan glm mengatakan:

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

Oleh karena itu saya berharap bahwa penskalaan berat tidak akan mempengaruhi perkiraan $\beta$ mengingat proporsi keberhasilan sebagai respons. Namun dua kode berikut mengembalikan nilai koefisien yang berbeda:

 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)

Ini menghasilkan:

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

 Coefficients:
 (Intercept)  
      -2.197     

sementara jika saya kalikan semua bobot dengan 1000, koefisien yang diperkirakan berbeda:

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

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

 Coefficients:
 (Intercept)  
    -3.153e+15  

Saya melihat banyak contoh lain seperti ini bahkan dengan beberapa skala dalam bobot. Apa yang terjadi disini?

Contoh Anda hanya menyebabkan kesalahan pembulatan di R. Bobot besar tidak berkinerja baik di glm. Benar bahwa penskalaan wdengan jumlah yang lebih kecil, seperti 100, mengarah ke perkiraan yang sama dengan yang tidak dihitung w.

Jika Anda ingin perilaku yang lebih andal dengan argumen bobot, coba gunakan svyglmfungsi dari surveypaket.

Lihat disini:

    > 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

glm.fitfamily$initializeglm.fit$\sqrt{W}X$$X$$\sqrt{W}$

$intializeKode yang relevan adalah:

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

Ini adalah versi sederhana glm.fityang menunjukkan poin saya

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

Kita dapat mengulangi bagian terakhir dua kali lagi untuk melihat bahwa metode Newton-Raphson berbeda:

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

Ini tidak terjadi jika Anda memulai weights <- 1:nrow(y)atau mengatakan weights <- 1:nrow(y) * 100.

Perhatikan bahwa Anda dapat menghindari perbedaan dengan menetapkan mustartargumen. Misalnya lakukan

> 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