Differenza di errore standard residua tra optim e glm

16

Provo a riprodurre con optimi risultati di una semplice regressione lineare dotata di glmo anche nlsfunzioni R.
Le stime dei parametri sono le stesse ma la stima della varianza residua e gli errori standard degli altri parametri non sono gli stessi, in particolare quando la dimensione del campione è bassa. Suppongo che ciò sia dovuto alle differenze nel modo in cui l'errore standard residuo viene calcolato tra gli approcci di Probabilità massima e Minimo quadrato (dividendo per n o per n-k + 1 vedi sotto nell'esempio).
Capisco dalle mie letture sul web che l'ottimizzazione non è un compito semplice, ma mi chiedevo se sarebbe possibile riprodurre in modo semplice le stime di errore standard glmdurante l'utilizzo optim.

Simula un piccolo set di dati

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)

Stima 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

Confronto con glm e 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

Posso riprodurre le diverse stime di errore standard residue come questa:

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

9

Il problema è che provengono gli errori standard

{\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

Per elaborare di più come richiesto da usεr11852 , la probabilità di log è

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

Possiamo fare lo stesso con una decomposizione QR come lmfa

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

Quindi per rispondere

Capisco dalle mie letture sul web che l'ottimizzazione non è un compito semplice, ma mi chiedevo se sarebbe possibile riprodurre in modo semplice le stime di errore standard glmdurante l'utilizzo optim.

quindi è necessario ridimensionare gli errori standard nell'esempio gaussiano che si utilizza.

— Benjamin Christoffersen
fonte

1

+1. Non sono sicuro al 100% che hai capito bene, ma questo è decisamente nella direzione corretta. Puoi spiegare perché ti aspetti questo fattore?

— Usεr11852 dice Reinstate Monic,

Adesso è più chiaro?

— Benjamin Christoffersen,

1

Sì. Buona risposta! (L'ho già votato)

— usεr11852 dice Reinstate Monic il

1

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

— papgeo
fonte

1

Grazie per la tua risposta. Mi rendo conto che la mia domanda non era abbastanza chiara (ora l'ho modificata). Non voglio solo riprodurre il calcolo dell'errore standard residuo ma anche gli errori standard dei parametri ...

— Gilles

@Gilles Non so come riprodurre gli errori standard. Le differenze sono dovute a: 1. glm utilizza la matrice di informazioni di Fisher, mentre ottimizza l'assia e 2. glm considera questo un problema di 2 parametri (trova b0 e b1), mentre ottimizza un problema di 3 parametri (b0, b1 e sigma2) . Non sono sicuro che queste differenze possano essere colmate.

— papgeo,