Diferencia de error estándar residual entre optim y glm

16

Trato de reproducirme con optimlos resultados de una regresión lineal simple con glmo incluso nlsfunciones R.
Las estimaciones de los parámetros son las mismas, pero la estimación de la varianza residual y los errores estándar de los otros parámetros no son los mismos, particularmente cuando el tamaño de la muestra es bajo. Supongo que esto se debe a las diferencias en la forma en que se calcula el error estándar residual entre los enfoques de máxima verosimilitud y el mínimo cuadrado (dividiendo por n o por n-k + 1 ver abajo en el ejemplo).
Según mis lecturas en la web, entiendo que la optimización no es una tarea simple, pero me preguntaba si sería posible reproducir de manera simple las estimaciones de error estándar glmdurante el uso optim.

Simula un pequeño conjunto de datos

set.seed(1)
n = 4 # very small sample size !
b0 <- 5
b1 <- 2
sigma <- 5
x <- runif(n, 1, 100)
y =  b0 + b1*x + rnorm(n, 0, sigma)

Estima con optim

negLL <- function(beta, y, x) {
    b0 <- beta[1]
    b1 <- beta[2]
    sigma <- beta[3]
    yhat <- b0 + b1*x
    likelihood <- dnorm(y, yhat, sigma)
    return(-sum(log(likelihood)))
}

res <- optim(starting.values, negLL, y = y, x = x, hessian=TRUE)
estimates <- res$par     # Parameters estimates
se <- sqrt(diag(solve(res$hessian))) # Standard errors of the estimates
cbind(estimates,se)


    > cbind(estimates,se)
      estimates         se
b0     9.016513 5.70999880
b1     1.931119 0.09731153
sigma  4.717216 1.66753138

Comparación con glm y nls

> m <- glm(y ~ x)
> summary(m)$coefficients
            Estimate Std. Error   t value    Pr(>|t|)
(Intercept) 9.016113  8.0759837  1.116411 0.380380963
x           1.931130  0.1376334 14.030973 0.005041162
> sqrt(summary(m)$dispersion) # residuals standard error
[1] 6.671833
> 
> summary(nls( y ~ b0 + b1*x, start=list(b0 = 5, b1= 2)))

Formula: y ~ b0 + b1 * x

Parameters:
   Estimate Std. Error t value Pr(>|t|)   
b0   9.0161     8.0760   1.116  0.38038   
b1   1.9311     0.1376  14.031  0.00504 **
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 6.672 on 2 degrees of freedom

Puedo reproducir las diferentes estimaciones de error estándar residual como esta:

> # optim / Maximum Likelihood estimate
> sqrt(sum(resid(m)^2)/n)
[1] 4.717698
> 
> # Least squares estimate (glm and nls estimates)
> k <- 3 # number of parameters
> sqrt(sum(resid(m)^2)/(n-k+1))
[1] 6.671833

r maximum-likelihood optimization

— Gilles
fuente

9

El problema es que los errores estándar provienen de

{\hat{σ}}^{2} (X^{⊤} X)^{- 1}

$\hat\sigma^2 (X^\top X)^{-1}$

$\hat\sigma^2$ summary.lm

summary.lm
#R function (object, correlation = FALSE, symbolic.cor = FALSE, 
#R     ...) 
#R {
#R    z <- object
#R    p <- z$rank
#R    rdf <- z$df.residual
#R    ...
#R    Qr <- qr.lm(object) 
#R    ... 
#R    r <- z$residuals
#R    f <- z$fitted.values
#R    w <- z$weights
#R    if (is.null(w)) {
#R         mss <- if (attr(z$terms, "intercept")) 
#R             sum((f - mean(f))^2)
#R         else sum(f^2)
#R         rss <- sum(r^2)
#R    }
#R    ...
#R    resvar <- rss/rdf
#R    ...
#R    R <- chol2inv(Qr$qr[p1, p1, drop = FALSE])
#R    se <- sqrt(diag(R) * resvar)
#R    ...

$(\beta_0, \beta_1)$ $\hat\sigma^2$ $(\beta_0, \beta_1, \sigma)$ $\sigma$ $\sqrt{n/(n-3 + 1)}$

set.seed(1)
n = 4 # very small sample size !
b0 <- 5
b1 <- 2
sigma <- 5
x <- runif(n, 1, 100)
y =  b0 + b1*x + rnorm(n, 0, sigma) 

negLL <- function(beta, y, x) {
  b0 <- beta[1]
  b1 <- beta[2]
  sigma <- beta[3]
  yhat <- b0 + b1*x
  return(-sum(dnorm(y, yhat, sigma, log = TRUE)))
}

res <- optim(c(0, 0, 1), negLL, y = y, x = x, hessian=TRUE)
estimates <- res$par     # Parameters estimates
(se <- sqrt(diag(solve(res$hessian))))
#R [1] 5.690 0.097 1.653
k <- 3
se * sqrt(n / (n-k+1))
#R [1] 8.047 0.137 2.338

Para elaborar más a medida que las solicitudes de usrsr11852 , la probabilidad de registro es

l (\vec{β}, σ) = - \frac{n}{2} \log (2 π) - n \log σ - \frac{1}{2 σ^{2}} (\vec{y} - X \vec{β})^{⊤} (\vec{y} - X \vec{β})

$l(\vec{\beta},\sigma) = -\frac{n}{2}\log(2\pi) - n\log{\sigma} - \frac{1}{2\sigma^2}(\vec{y}-X\vec\beta)^\top(\vec{y}-X\vec\beta)$

$X$ $n$

- \nabla_{\vec{β}} \nabla_{\vec{β}}^{⊤} l (\vec{β}, σ) = \frac{1}{σ^{2}} X^{⊤} X

$-\nabla_{\vec{\beta}}\nabla_{\vec{\beta}}^\top l(\vec{\beta},\sigma) = \frac{1}{\sigma^2}X^\top X$

$\sigma$

m <- lm(y ~ x)
X <- cbind(1, x)
sqrt(sum(resid(m)^2)/n       * diag(solve(crossprod(X))))
#R                     x 
#R 5.71058285 0.09732149
k <- 3
sqrt(sum(resid(m)^2)/(n-k+1) * diag(solve(crossprod(X))))
#R                   x 
#R 8.0759837 0.1376334

Podemos hacer lo mismo con una descomposición QR como lo lmhace

obj <- qr(X)
sqrt(sum(resid(m)^2)/(n-k+1) * diag(chol2inv(obj$qr)))
#R [1] 8.0759837 0.1376334

Entonces para responder

Según mis lecturas en la web, entiendo que la optimización no es una tarea simple, pero me preguntaba si sería posible reproducir de manera simple las estimaciones de error estándar glmdurante el uso optim.

entonces necesita escalar los errores estándar en el ejemplo gaussiano que usa.

— Benjamin Christoffersen
fuente

1

+1. No estoy 100% seguro de que lo haya entendido correctamente, pero esto definitivamente está en la dirección correcta. ¿Puedes explicar por qué esperas ese factor?

— usεr11852 dice Reinstate Monic el

¿Está más claro ahora?

— Benjamin Christoffersen

1

Si. ¡Buena respuesta! (Ya lo voté)

— usεr11852 dice Reinstate Monic el

1

optim $n$ $n-k+1$ $n$ $n-k+1$ sqrt(4.717216^2*4/2) = 6.671151

— papgeo
fuente

1

Gracias por su respuesta. Me doy cuenta de que mi pregunta no era lo suficientemente clara (ahora la he editado). No solo quiero reproducir el cálculo del error estándar residual sino también los errores estándar de los parámetros ...

— Gilles

@Gilles No sé cómo reproducir los errores estándar. Las diferencias se deben a: 1. glm usa la matriz de información de Fisher, mientras optimiza el hessian, y 2. glm considera que es un problema de 2 parámetros (encuentre b0 y b1), mientras que optimiza un problema de 3 parámetros (b0, b1 y sigma2) . No estoy seguro de si estas diferencias se pueden salvar.

— papgeo