Giá trị bắt đầu mặc định phù hợp với hồi quy logistic với glm

Tôi tự hỏi làm thế nào là giá trị bắt đầu mặc định được chỉ định trong glm.

Bài đăng này gợi ý rằng các giá trị mặc định được đặt thành số không. Đây một nói rằng có một thuật toán đằng sau nó, tuy nhiên liên kết có liên quan bị phá vỡ.

Tôi đã cố gắng để phù hợp với mô hình hồi quy logistic đơn giản với theo dõi thuật toán:

set.seed(123)

x <- rnorm(100)
p <- 1/(1 + exp(-x))
y <- rbinom(100, size = 1, prob = p)

# to see parameter estimates in each step
trace(glm.fit, quote(print(coefold)), at = list(c(22, 4, 8, 4, 19, 3)))

Đầu tiên, không có đặc điểm kỹ thuật của các giá trị ban đầu:

glm(y ~ x, family = "binomial")

Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
NULL
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.386379 1.106234
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3991135 1.1653971
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3995188 1.1669508

Trong bước đầu tiên, giá trị ban đầu là NULL.

Thứ hai, tôi đặt giá trị bắt đầu là số không:

glm(y ~ x, family = "binomial", start = c(0, 0))

Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0 0
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3177530 0.9097521
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3909975 1.1397163
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3994147 1.1666173
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3995191 1.1669518

Và chúng ta có thể thấy rằng các lần lặp giữa cách tiếp cận thứ nhất và thứ hai khác nhau.

Để xem các giá trị ban đầu được chỉ định bởi glmtôi đã cố gắng khớp mô hình chỉ với một lần lặp:

glm(y ~ x, family = "binomial", control = list(maxit = 1))

Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
NULL

Call:  glm(formula = y ~ x, family = "binomial", control = list(maxit = 1))

Coefficients:
(Intercept)            x  
     0.3864       1.1062  

Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
Null Deviance:      134.6 
Residual Deviance: 115  AIC: 119

Ước tính các tham số (không đáng ngạc nhiên) tương ứng với ước tính của cách tiếp cận đầu tiên trong lần lặp thứ hai tức là, [1] 0.386379 1.106234 Đặt các giá trị này làm giá trị ban đầu dẫn đến trình tự lặp giống như trong cách tiếp cận đầu tiên:

glm(y ~ x, family = "binomial", start = c(0.386379, 1.106234))

Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.386379 1.106234
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3991135 1.1653971
Tracing glm.fit(x = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  .... step 22,4,8,4,19,3 
[1] 0.3995188 1.1669508

Vậy câu hỏi là, những giá trị này được tính như thế nào?

TL; DR

• start=c(b0,b1)khởi tạo eta thành b0+x*b1(mu đến 1 / (1 + exp (-eta)))
• start=c(0,0) khởi tạo eta thành 0 (mu đến 0,5) bất kể giá trị y hoặc x.
• start=NULL khởi tạo eta = 1.098612 (mu = 0,75) nếu y = 1, bất kể giá trị x.

• start=NULL khởi tạo eta = -1,098612 (mu = 0,25) nếu y = 0, bất kể giá trị x.

• Khi eta (và do đó mu và var (mu)) đã được tính toán, wvà zđược tính toán và gửi đến người giải quyết QR, theo tinh thần qr.solve(cbind(1,x) * w, z*w).

Longform

Xây dựng tắt bình luận Roland: Tôi làm một glm.fit.truncated(), nơi tôi đã glm.fitxuống đến C_Cdqrlscuộc gọi, và sau đó nhận xét nó ra. glm.fit.truncatedxuất ra các giá trị zvà w(cũng như các giá trị của các đại lượng được sử dụng để tính toán zvà w) sau đó sẽ được chuyển đến C_Cdqrlscuộc gọi:

## call Fortran code via C wrapper
fit <- .Call(C_Cdqrls, x[good, , drop = FALSE] * w, z * w,
             min(1e-7, control$epsilon/1000), check=FALSE) 

Nhiều hơn có thể được đọc về C_Cdqrls đây . May mắn thay, chức năng qr.solvetrong cơ sở R chạm trực tiếp vào các phiên bản LINPACK được gọi vào glm.fit().

Vì vậy, chúng tôi chạy glm.fit.truncatedcho các thông số kỹ thuật giá trị bắt đầu khác nhau và sau đó thực hiện cuộc gọi qr.solvevới các giá trị w và z và chúng tôi xem cách tính "giá trị bắt đầu" (hoặc giá trị lặp được hiển thị đầu tiên). Như Roland đã chỉ ra, việc chỉ định start=NULLhoặc start=c(0,0)trong glm () ảnh hưởng đến các tính toán cho w và z, không phải cho start.

Đối với start = NULL: zlà một vectơ trong đó các phần tử có giá trị 2.431946 hoặc -2.431946 và wlà một vectơ trong đó tất cả các phần tử là 0.4330127:

start.is.null <- glm.fit.truncated(x,y,family=binomial(), start=NULL)
start.is.null
w <- start.is.null$w
z <- start.is.null$z
## if start is NULL, the first displayed values are:
qr.solve(cbind(1,x) * w, z*w)  
# > qr.solve(cbind(1,x) * w, z*w)  
#                 x 
# 0.386379 1.106234 

Đối với start = c (0,0): zlà một vectơ trong đó các phần tử có giá trị 2 hoặc -2 và wlà một vectơ trong đó tất cả các phần tử là 0,5:

## if start is c(0,0)    
start.is.00 <- glm.fit.truncated(x,y,family=binomial(), start=0)
start.is.00
w <- start.is.00$w
z <- start.is.00$z
## if start is c(0,0), the first displayed values are:    
qr.solve(cbind(1,x) * w, z*w)  
# > qr.solve(cbind(1,x) * w, z*w)  
#                   x 
# 0.3177530 0.9097521 

Vì vậy, đó là tất cả tốt và tốt, nhưng làm thế nào để chúng ta tính toán wvà z? Gần cuối glm.fit.truncated()chúng ta thấy

z <- (eta - offset)[good] + (y - mu)[good]/mu.eta.val[good]
w <- sqrt((weights[good] * mu.eta.val[good]^2)/variance(mu)[good])

Nhìn vào các so sánh sau đây giữa các giá trị xuất ra của các đại lượng được sử dụng để tính toán zvà w:

cbind(y, start.is.null$mu, start.is.00$mu)
cbind(y, start.is.null$eta, start.is.00$eta)
cbind(start.is.null$var_mu, start.is.00$var_mu)
cbind(start.is.null$mu.eta.val, start.is.00$mu.eta.val)

Lưu ý rằng start.is.00sẽ có vectơ muchỉ có các giá trị 0,5 vì eta được đặt thành 0 và mu (eta) = 1 / (1 + exp (-0)) = 0,5. start.is.nullđặt những người có y = 1 là mu = 0,75 (tương ứng với eta = 1,098612) và những người có y = 0 là mu = 0,25 (tương ứng với eta = -1,098612), và do đó var_mu= 0,75 * 0,25 = 0,1875.

Tuy nhiên, một điều thú vị cần lưu ý là tôi đã thay đổi hạt giống và chạy lại mọi thứ và mu = 0,75 cho y = 1 và mu = 0,25 cho y = 0 (và do đó, các đại lượng khác giữ nguyên). Điều đó có nghĩa là, start = NULL tạo ra sự giống nhau wvà zbất kể là gì yvà xbởi vì chúng khởi tạo eta = 1.098612 (mu = 0.75) nếu y = 1 và eta = -1.098612 (mu = 0.25) nếu y = 0.

Vì vậy, có vẻ như một giá trị bắt đầu cho hệ số Chặn và cho hệ số X không được đặt cho start = NULL, mà là các giá trị ban đầu được trao cho eta tùy thuộc vào giá trị y và độc lập với giá trị x. Từ đó wvà zđược tính toán, sau đó được gửi cùng với xqr.solver.

Mã để chạy trước các đoạn trên:

set.seed(123)

x <- rnorm(100)
p <- 1/(1 + exp(-x))
y <- rbinom(100, size = 1, prob = p)


glm.fit.truncated <- function(x, y, weights = rep.int(1, nobs), 
start = 0,etastart = NULL, mustart = NULL, 
offset = rep.int(0, nobs),
family = binomial(), 
control = list(), 
intercept = TRUE,
singular.ok = TRUE
){
control <- do.call("glm.control", control)
x <- as.matrix(x)
xnames <- dimnames(x)[[2L]]
ynames <- if(is.matrix(y)) rownames(y) else names(y)
conv <- FALSE
nobs <- NROW(y)
nvars <- ncol(x)
EMPTY <- nvars == 0
## define weights and offset if needed
if (is.null(weights))
  weights <- rep.int(1, nobs)
if (is.null(offset))
  offset <- rep.int(0, nobs)

## get family functions:
variance <- family$variance
linkinv  <- family$linkinv
if (!is.function(variance) || !is.function(linkinv) )
  stop("'family' argument seems not to be a valid family object", call. = FALSE)
dev.resids <- family$dev.resids
aic <- family$aic
mu.eta <- family$mu.eta
unless.null <- function(x, if.null) if(is.null(x)) if.null else x
valideta <- unless.null(family$valideta, function(eta) TRUE)
validmu  <- unless.null(family$validmu,  function(mu) TRUE)
if(is.null(mustart)) {
  ## calculates mustart and may change y and weights and set n (!)
  eval(family$initialize)
} else {
  mukeep <- mustart
  eval(family$initialize)
  mustart <- mukeep
}
if(EMPTY) {
  eta <- rep.int(0, nobs) + offset
  if (!valideta(eta))
    stop("invalid linear predictor values in empty model", call. = FALSE)
  mu <- linkinv(eta)
  ## calculate initial deviance and coefficient
  if (!validmu(mu))
    stop("invalid fitted means in empty model", call. = FALSE)
  dev <- sum(dev.resids(y, mu, weights))
  w <- sqrt((weights * mu.eta(eta)^2)/variance(mu))
  residuals <- (y - mu)/mu.eta(eta)
  good <- rep_len(TRUE, length(residuals))
  boundary <- conv <- TRUE
  coef <- numeric()
  iter <- 0L
} else {
  coefold <- NULL
  eta <-
    if(!is.null(etastart)) etastart
  else if(!is.null(start))
    if (length(start) != nvars)
      stop(gettextf("length of 'start' should equal %d and correspond to initial coefs for %s", nvars, paste(deparse(xnames), collapse=", ")),
           domain = NA)
  else {
    coefold <- start
    offset + as.vector(if (NCOL(x) == 1L) x * start else x %*% start)
  }
  else family$linkfun(mustart)
  mu <- linkinv(eta)
  if (!(validmu(mu) && valideta(eta)))
    stop("cannot find valid starting values: please specify some", call. = FALSE)
  ## calculate initial deviance and coefficient
  devold <- sum(dev.resids(y, mu, weights))
  boundary <- conv <- FALSE

  ##------------- THE Iteratively Reweighting L.S. iteration -----------
  for (iter in 1L:control$maxit) {
    good <- weights > 0
    varmu <- variance(mu)[good]
    if (anyNA(varmu))
      stop("NAs in V(mu)")
    if (any(varmu == 0))
      stop("0s in V(mu)")
    mu.eta.val <- mu.eta(eta)
    if (any(is.na(mu.eta.val[good])))
      stop("NAs in d(mu)/d(eta)")
    ## drop observations for which w will be zero
    good <- (weights > 0) & (mu.eta.val != 0)

    if (all(!good)) {
      conv <- FALSE
      warning(gettextf("no observations informative at iteration %d",
                       iter), domain = NA)
      break
    }
    z <- (eta - offset)[good] + (y - mu)[good]/mu.eta.val[good]
    w <- sqrt((weights[good] * mu.eta.val[good]^2)/variance(mu)[good])
    # ## call Fortran code via C wrapper
    # fit <- .Call(C_Cdqrls, x[good, , drop = FALSE] * w, z * w,
    #              min(1e-7, control$epsilon/1000), check=FALSE)
    # 

    #print(iter)
    #print(z)
    #print(w)
  }


  }
  return(list(z=z, w=w, mustart=mustart, etastart=etastart, eta=eta, offset=offset, mu=mu, mu.eta.val=mu.eta.val,
              weight=weights, var_mu=variance(mu)))

}