复数反函数预测值的置信区间

Question

我试图在某些预测值附近获得95％的置信区间，但我无法实现这一目标。

基本上，我估计了这样的增长曲线：

set.seed(123)
dat=data.frame(size=rnorm(50,10,3),age=rnorm(50,5,2))
S <- function(t,ts,C,K) ((C*K)/(2*pi))*sin(2*pi*(t-ts))
sommers <- function(t,Linf,K,t0,ts,C)
  Linf*(1-exp(-K*(t-t0)-S(t,ts,C,K)+S(t0,ts,C,K)))
model <- nls(size~sommers(age,Linf,K,t0,ts,C),data=dat,
             start=list(Linf=10,K=4.7,t0=2.2,C=0.9,ts=0.1))

我有独立的尺寸测量值，我想预测它的年龄。因此，函数的逆，这不是很简单，我计算如下：

model.out=coef(model)
S.out <- function(t) 
  ((model.out[[4]]*model.out[[2]])/(2*pi))*sin(2*pi*(t-model.out[[5]]))
sommers.out <- function(t) 
  model.out[[1]]*(1-exp(-model.out[[2]]*(t-model.out[[3]])-S.out(t)+S.out(model.out[[3]])))
inverse = function (f, lower = -100, upper = 100) {
  function (y) uniroot((function (x) f(x) - y), lower = lower, upper = upper)[1]
}
sommers.inverse = inverse(sommers.out, 0, 25)
x= sommers.inverse(10)  #this works with my complete dataset, but not with this fake one

虽然这很好，但我需要知道这个估计值（x）附近的置信区间（95％）。对于线性模型，例如＆＃34;预测（...置信=）＆＃34;。我还可以以某种方式引导函数以获得与参数相关的分位数（没有找到方法），然后使用它们的极值来计算可预测的最大值和最小值。但这并不是真正做到这一点的好方法......

非常感谢任何帮助。

回答后编辑：

所以这有效（在Ben Bolker的书中解释，见答案）：

vmat = mvrnorm(1000, mu = coef(mfit), Sigma = vcov(mfit)) 
dist = numeric(1000) 
for (i in 1:1000) {dist[i] = sommers_inverse(9.938,vmat[i,])} 
quantile(dist, c(0.025, 0.975))

关于我给出的相当糟糕的假数据，这当然相当可怕。但是对于真实的数据（我有重新创建的问题），这没关系！

Answer 1

除非我弄错了，否则你将不得不使用常规（参数）自举或称为“人口预测间隔”的方法（例如，参见chapter 7 of Bolker 2008的第5节），这假定您的参数的采样分布是多元正态的。但是，我认为你可能会有更大的问题，除非我在某种程度上搞砸了你的模型以适应它......

生成数据（ note ，随机数据实际上可能不适合测试您的模型 - 见下文......）

set.seed(123)
dat <- data.frame(size=rnorm(50,10,3),age=rnorm(50,5,2))
S <- function(t,ts,C,K) ((C*K)/(2*pi))*sin(2*pi*(t-ts))
sommers <- function(t,Linf,K,t0,ts,C)
    Linf*(1-exp(-K*(t-t0)-S(t,ts,C,K)+S(t0,ts,C,K)))

绘制数据和初始曲线估计值：

plot(size~age,data=dat,ylim=c(0,16))
agevec <- seq(0,10,length=1001)
lines(agevec,sommers(agevec,Linf=10,K=4.7,t0=2.2,ts=0.1,C=0.9))

我遇到nls时出现问题，因此我使用minpack.lm::nls.lm，这稍微强一些。 （此处还有其他选项，例如计算导数并提供渐变函数，或使用AD模型生成器或模板模型生成器，或使用nls2包。）

对于nls.lm，我们需要一个返回残差的函数：

sommers_fn <- function(par,dat) {
   with(c(as.list(par),dat),size-sommers(age,Linf,K,t0,ts,C))
}
library(minpack.lm)
mfit <- nls.lm(fn=sommers_fn,
           par=list(Linf=10,K=4.7,t0=2.2,C=0.9,ts=0.1),
       dat=dat)
coef(mfit)
##        Linf           K          t0           C          ts 
##  10.6540185   0.3466328   2.1675244 136.7164179   0.3627371 

这是我们的问题：

plot(size~age,data=dat,ylim=c(0,16))
lines(agevec,sommers(agevec,Linf=10,K=4.7,t0=2.2,ts=0.1,C=0.9))
with(as.list(coef(mfit)), {
     lines(agevec,sommers(agevec,Linf,K,t0,ts,C),col=2)
     abline(v=t0,lty=2)
     abline(h=c(0,Linf),lty=2)
})

通过这种拟合，反函数的结果将极不稳定，因为反函数是多对一的，反函数的数量敏感地取决于参数值......

sommers_pred <- function(x,pars) {
    with(as.list(pars),sommers(x,Linf,K,t0,ts,C))
}
sommers_pred(6,coef(mfit))  ## s(6)=9.93

sommers_inverse <- function (y, pars, lower = -100, upper = 100) {
    uniroot(function(x) sommers_pred(x,pars) -y, c(lower, upper))$root
}
sommers_inverse(9.938, coef(mfit))  ## 0.28

如果我仔细选择我的间隔非常，我可以找回正确答案......

sommers_inverse(9.938, coef(mfit), 5.5, 6.2)

也许你的模型会更好地表现出更真实的数据。我希望如此......