Simular regresión lineal con heterocedasticidad

Estoy tratando de simular un conjunto de datos que coincida con los datos empíricos que tengo, pero no estoy seguro de cómo estimar los errores en los datos originales. Los datos empíricos incluyen la heterocedasticidad, pero no estoy interesado en transformarlos, sino en utilizar un modelo lineal con un término de error para reproducir simulaciones de los datos empíricos.

Por ejemplo, supongamos que tengo un conjunto de datos empírico y un modelo:

n=rep(1:100,2)
a=0
b = 1
sigma2 = n^1.3
eps = rnorm(n,mean=0,sd=sqrt(sigma2))
y=a+b*n + eps
mod <- lm(y ~ n)

usando plot(n,y)obtenemos lo siguiente.

Sin embargo, si trato de simular los datos simulate(mod), la heterocedasticidad se elimina y el modelo no la captura.

Puedo usar un modelo generalizado de mínimos cuadrados

VMat <- varFixed(~n)
mod2 = gls(y ~ n, weights = VMat)

eso proporciona un mejor ajuste del modelo basado en AIC, pero no sé cómo simular datos usando la salida.

Mi pregunta es, ¿cómo creo un modelo que me permita simular datos para que coincidan con los datos empíricos originales (ny e anteriores). Específicamente, ¿necesito una forma de estimar sigma2, el error, usando cualquiera de los dos usando un modelo?

Para simular datos con una variación de error variable, debe especificar el proceso de generación de datos para la variación de error. Como se ha señalado en los comentarios, lo hizo cuando generó sus datos originales. Si tiene datos reales y desea probar esto, solo necesita identificar la función que especifica cómo la varianza residual depende de sus covariables. La forma estándar de hacerlo es ajustar su modelo, verificar que sea razonable (aparte de la heterocedasticidad) y guardar los residuos. Esos residuos se convierten en la variable Y de un nuevo modelo. A continuación lo he hecho para su proceso de generación de datos. (No veo dónde establece la semilla aleatoria, por lo que estos no serán literalmente los mismos datos, pero deberían ser similares, y puede reproducir los míos exactamente usando mi semilla).

set.seed(568)  # this makes the example exactly reproducible

n      = rep(1:100,2)
a      = 0
b      = 1
sigma2 = n^1.3
eps    = rnorm(n,mean=0,sd=sqrt(sigma2))
y      = a+b*n + eps
mod    = lm(y ~ n)
res    = residuals(mod)

windows()
  layout(matrix(1:2, nrow=2))
  plot(n,y)
  abline(coef(mod), col="red")
  plot(mod, which=3)

Tenga en cuenta que Rs ? Plot.lm le dará un gráfico (cf., aquí ) de la raíz cuadrada de los valores absolutos de los residuos, útilmente superpuestos con un ajuste bajo, que es justo lo que necesita. (Si tiene múltiples covariables, es posible que desee evaluar esto en relación con cada covariable por separado). Existe el más mínimo indicio de una curva, pero parece que una línea recta hace un buen trabajo al ajustar los datos. Entonces, ajustemos explícitamente ese modelo:

res.mod = lm(sqrt(abs(res))~fitted(mod))
summary(res.mod)
# Call:
# lm(formula = sqrt(abs(res)) ~ fitted(mod))
# 
# Residuals:
#     Min      1Q  Median      3Q     Max 
# -3.3912 -0.7640  0.0794  0.8764  3.2726 
# 
# Coefficients:
#             Estimate Std. Error t value Pr(>|t|)    
# (Intercept) 1.669571   0.181361   9.206  < 2e-16 ***
# fitted(mod) 0.023558   0.003157   7.461 2.64e-12 ***
# ---
# Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
# 
# Residual standard error: 1.285 on 198 degrees of freedom
# Multiple R-squared:  0.2195,  Adjusted R-squared:  0.2155 
# F-statistic: 55.67 on 1 and 198 DF,  p-value: 2.641e-12
windows()
  layout(matrix(1:4, nrow=2, ncol=2, byrow=TRUE))
  plot(res.mod, which=1)
  plot(res.mod, which=2)
  plot(res.mod, which=3)
  plot(res.mod, which=5)

No debemos preocuparnos de que la varianza residual parece estar aumentando también en la gráfica de ubicación de escala para este modelo, eso esencialmente tiene que suceder. Hay una vez más el menor indicio de una curva, por lo que podemos intentar ajustar un término al cuadrado y ver si eso ayuda (pero no es así):

res.mod2 = lm(sqrt(abs(res))~poly(fitted(mod), 2))
summary(res.mod2)
# output omitted
anova(res.mod, res.mod2)
# Analysis of Variance Table
# 
# Model 1: sqrt(abs(res)) ~ fitted(mod)
# Model 2: sqrt(abs(res)) ~ poly(fitted(mod), 2)
#   Res.Df    RSS Df Sum of Sq     F Pr(>F)
# 1    198 326.87                          
# 2    197 326.85  1  0.011564 0.007 0.9336

Si estamos satisfechos con esto, ahora podemos usar este proceso como un complemento para simular datos.

set.seed(4396)  # this makes the example exactly reproducible
x = n
expected.y = coef(mod)[1] + coef(mod)[2]*x
sim.errors = rnorm(length(x), mean=0,
                   sd=(coef(res.mod)[1] + coef(res.mod)[2]*expected.y)^2)
observed.y = expected.y + sim.errors

Tenga en cuenta que este proceso no está más garantizado para encontrar el verdadero proceso de generación de datos que cualquier otro método estadístico. Usó una función no lineal para generar las SD de error, y la aproximamos con una función lineal. Si realmente conoce el verdadero proceso de generación de datos a priori (como en este caso, porque simuló los datos originales), también podría usarlo. Puede decidir si la aproximación aquí es lo suficientemente buena para sus propósitos. Sin embargo, generalmente no conocemos el verdadero proceso de generación de datos y, según la maquinilla de afeitar de Occam, utilizamos la función más simple que se ajusta adecuadamente a los datos que hemos proporcionado la cantidad de información disponible. También puede probar splines o enfoques más elegantes si lo prefiere. Las distribuciones bivariadas se parecen razonablemente a mí,

Necesitas modelar la heterocedasticidad. Un enfoque es a través del paquete R (CRAN) dglm, modelo lineal generalizado de dispersión. Esta es una extensión de glm que, además de la habitual glm, se ajusta a una segunda glm para dispersarse de los residuos de la primera glm. No tengo experiencia con tales modelos, pero parecen prometedores ... Aquí hay un código:

n <- rep(1:100,2)
a <- 0
b <- 1
sigma2 <- n^1.3
eps <- rnorm(n,mean=0,sd=sqrt(sigma2))
y <- a+b*n + eps
mod <- lm(y ~ n)

library(dglm)  ### double glm's

mod2   <-  dglm(y ~ n, ~ n, gaussian,ykeep=TRUE,xkeep=TRUE,zkeep=TRUE)
### This uses log link for the dispersion part, should also try identity link ..

y2 <-  simulate(mod2)

plot(n, y2$sim_1)

mod3  <-  dglm(y ~ n, ~ n, gaussian, dlink="identity", ykeep=TRUE,xkeep=TRUE,zkeep=TRUE)  ### This do not work because it leads to negative weights!

El diagrama simulado se muestra a continuación:

El gráfico parece que la simulación ha utilizado la varianza estimada, pero no estoy seguro, ya que la función simulate () no tiene métodos para dglm's ...

(Otra posibilidad a considerar es usar el Rpaquete gamlss, que usa otro enfoque para modelar la varianza en función de las covariables).