Залишкова стандартна різниця похибок між оптимальним та glm

Я намагаюся відтворити optimрезультати з простої лінійної регресії, забезпеченої glmабо навіть nlsR-функціями.
Оцінки параметрів однакові, але оцінка залишкової дисперсії та стандартні похибки інших параметрів не однакові, особливо коли розмір вибірки невеликий. Я припускаю, що це пов'язано з різницею в тому, як обчислюється залишкова стандартна помилка між максимальною ймовірністю та найменшим квадратним підходом (ділення на n або n-k + 1, див. Нижче в прикладі).
З моїх читань в Інтернеті я розумію, що оптимізація не є простим завданням, але мені було цікаво, чи можна буде відтворити простим способом стандартні оцінки помилок glmпід час використання optim.

Моделюйте невеликий набір даних

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

Порівняння з glm та 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

Я можу відтворити різні залишкові стандартні оцінки помилок, як це:

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

Проблеми полягають у тому, що походять стандартні помилки

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

Щоб розробити більше, як usεr11852 запитів, вірогідність журналу є

$X$$n$

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

Ми можемо зробити те ж саме з розкладанням QR, як lmі

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

Отже, щоб відповісти

З моїх читань в Інтернеті я розумію, що оптимізація не є простим завданням, але мені було цікаво, чи можна буде відтворити простим способом стандартні оцінки помилок glmпід час використання optim.

то вам потрібно масштабувати стандартні помилки на прикладі Гаусса, який ви використовуєте.

Якщо я добре зрозумів, рішення просте: optimмаксимізує ймовірність, діливши суму квадратних залишків на$n$. Те, що ви хочете, - розділити суму квадратів на$n-k+1$. Тож скасуйте поділ на$n$ і розділити по $n-k+1$: sqrt(4.717216^2*4/2) = 6.671151