Модель пространства состояний для временных рядов населения – общие опасения и соответствие

Впервые постер, давний читатель. Я также совершенно новичок в байесовском анализе, поэтому, пожалуйста, будьте со мной осторожны.

Я пытаюсь подогнать модель к наблюдениям за взрослыми организмами, которые являются семивольтинными, то есть им требуется два года, чтобы достичь взрослой жизни, а затем они умирают вскоре после спаривания.

Поскольку меня беспокоит ошибка наблюдения, я пытаюсь подогнать байесовскую модель пространства состояний. Мои вопросы таковы:

  • Кажется ли это несколько разумным подходом? Мне особенно любопытно, не обидится ли кто-нибудь на использование отрицательного биномиального распределения ошибок в модели процесса или распределения Пуассона в модели наблюдения.

  • Когда я запускаю предоставленный код и смотрю на апостериорные оценки количества взрослых, оценки почти полностью совпадают с данными, что заставляет меня думать, что я делаю что-то очень неправильно. Однако оценки параметров аналогичны тем, которые я получаю, когда запускаю GLM без ошибки наблюдения.

      # Load Packages
library(R2jags)
library(rjags)

#Data
Counts <- c(156, 62, 62, 300, 415, 429, 366, 188, 142, 201, 375, 
  438, 508, 386, 105, 293, 167, 105, 146, 129, 153, 220, 
  162, 74, 94, 202, 217, 246, 120, 182)

Data <- c(list(TYr = length(Counts),
               N1 = Counts[1],
               N2 = Counts[2],
               Counts = Counts))

#State space Ricker model
mod<- function(){
  #Process model. 
  for (t in 3:TYr){ #data# TYr
    N[t] ~ dnegbin(p[t],size) 
    p[t]<- size/(size+lambda[t])
    log(lambda[t])<- log(N[t-2]) + a + b*N[t-2] 
  }
  
  #Observation model
  for (i in 1:TYr){ 
    Counts[i] ~ dpois(N[i]) #data# Counts
  }
  
  #Priors
  N[1] = (N1)  #data# N1
  N[2] = (N2)  #data# N2
  a~dnorm(0,0.001)
  b~dnorm(0,0.0001)
  size ~ dunif(0.001, 50)
  
  #Derived values, I'd like to be able to report the estimated carrying capacity, K
  K = -exp(a)/b
}

#Initial values. b has to start negative or I run into issues
Ricker_inits_1<-list(a = 0.1, b = -0.0001)
Ricker_inits_2<-list(a = 0.15, b = -0.001)
Ricker_inits_3<-list(a = 0.3, b = -0.01)
Total_Ricker_inits<-list(Ricker_inits_1,Ricker_inits_2,Ricker_inits_3)

#fit the model
jags_fit <- jags(data = Data,
                     inits = Total_Ricker_inits,
                     parameters.to.save = c('a','b',"K", 'size'),
                     model.file = mod,
                     n.chains=3,
                     n.burnin=3000,
                     n.iter = 20000,
                     n.thin = 1)

#get posterior estimates
samples <- jags.samples(jags_fit$model, 
                           c("N"), 
                           type = "mean", 
                           n.iter = 20000,
                           n.burnin = 1000,
                           n.thin = 1)

#crazy high goodness of fit makes me question everything 
#removing the first two points because these were explicit in the model
plot(Data$Counts[-c(1,2)]~summary(samples$N, FUN = mean)$stat[-c(1,2)])
abline(0,1)

#similar parameter estimates for a and b
require(MASS)
glm.nb(Counts[-c(1,2)]~offset(log(Counts[-c(29,30)]))+Counts[-c(29,30)])

0 ответов

Другие вопросы по тегам