边际似然估计中的数值问题

Question

我尝试使用迭代过程来估计模型选择的贝叶斯设置中的边际似然。如果您对这些细节感兴趣，请参阅this或this文章。我已经在很长一段时间内与数字问题作斗争了，所以我想我也可以在这里试一试并试试我的运气。我试图使下面的内容尽可能简短，可重复和一般。

设置

目标是运行表单

的迭代过程

估算我模型的边际似然 y （这个迭代过程会快速收敛到 y 的某个值）。您在公式中看到的所有其他变量都是已计算的标量或参数似然，因此它们是固定值。每次迭代中唯一更改的术语是 y 的值。所以基本上我有长度为L的向量 p_l 和 q_l 以及长度为M的向量 p_m 和 q_m 。到目前为止一切都很好。

问题

遗憾的是，上面公式中使用的似然值不是对数似然（我计算并存储在向量中），而是实际可能性。这是我所遇到的数字问题的根源。您可能知道指数大的负对数似然的取幂的老问题。我的对数可能性是如此负面，exp（对数似然）几乎总是为0.有一些类似的问题已经在线答案，但这些解决方案都不适合我。

我尝试了什么

我认为可能有希望的是利用exp（log（x））= x并扩展分数的事实，这样你就可以重写上面的公式

其中 C 是您选择的常量。对于遵循相同想法的证明，请参阅this paper的附录。如果可以找到合适的 C 值，使得总和中的术语可以管理，则问题就解决了。但是，在我的情况下 p_l ， q_l ， p_m 和 q_m 在数量上有很大差异，所以没有无论 C 的值是什么，我试图减去或添加，我最终会再次出现下溢或溢出。因此，现在我实际上并不知道如何从这里开始。我感谢任何评论和提示。

代码和数据

您可以找到一些示例数据（即具有对数似然的向量）here。迭代过程的代码是

L <- 1000
M <- 5000
y <- numeric(length=100)
eval_downer <- numeric(length=L)
eval_upper <- numeric(length=M)
y[1] <- 0.5

for(t in 2:100){ 

  for(m in 1:M){
    up.m <- q_m[m]
    down.m <- (L * q_m[m]) + (M * p_m[m] / y[t-1])
    eval_downer[m]  <- up.m / down.m 
  }

  for(l in 1:L){
    up.l <- p_l[l]
    down.l <- (L * q_l[l]) + (M * p_l[l] / y[t-1])
    eval_upper[l]  <- up.l / down.l
  }

  upper <- mean(eval_upper)
  downer <- mean(eval_downer)

  y[t]  <-   upper / downer

  print(t)
}

谢谢！

Answer 1

我认为最好在日志中工作。 我将与

合作

log( (M * p_m[m] / y[t-1]) 

等。 您有表格的总和

t = exp( a)/(exp(b) + exp(c)) = 1 / (exp(b-a) + exp(c-a))

log的t是

lt = (a-M) -  log1p( 1 + exp(m-M))

其中

m = min(b,c), M = max(b,c)

请注意，m-M不是正数;如果非常负的exp（m-M）可能会下溢到0，但是我们将其添加到1就可以了。

然后我们有形式的总和

s = Sum{ exp(l[i])}

同样，它的log ls是

ls = L + log( Sum{ 1 + exp(l[i]-L)})

其中L是（a）l []的最大值。我们现在可以评估exps而不用担心溢出。