在R中使用optim

Question

我正在尝试使用R中的optim函数来优化模型中的三个参数，但无法弄清楚如何使用“优化”函数来搜索一系列值。 我尝试使用for循环来做这个，这是我尝试中最成功的但是由于某种原因似乎停在355的值，理想情况下我想尝试更高的组合。 除此之外，我尝试编写多次调用optim的函数，尝试向量化并尝试将列表值放入optim中的“par”参数中，但是所有这些尝试都产生了错误消息

"unable to evaluate at initial parameters".

很长时间没有人知道我如何使用optim函数搜索参数的一系列值，因为“优化”函数将会????

任何帮助或指示都会非常感激!!!

我的代码如下： 它是相应比例的三个最大似然函数，然后是三次尝试使用optim！

rm(list=ls())

load('Dat.RData')

mean(dat)
var(dat)


loglike<-function(par,dat,scale)
{ ptp<-dat[1:length(dat)-1]
  ptp1<-dat[2:length(dat)]

  r<-par['r']
  k<-par['k']
  sigma<-par['sigma']

  if(scale=='log')
  {
    return(sum(dnorm(log(ptp1)-log(ptp)*exp(r-(ptp/k)),mean=0,sd=sigma,log=T)))
  }

  if (scale=='sqrt')
  {
    return(sum(dnorm(sqrt(ptp1)-sqrt(ptp)*exp(r-(ptp/k)),mean=0,sd=sigma,log=T)))
  }

  if (scale=='linear')
  {
    return(sum(dnorm(ptp1-ptp*exp(r-(ptp/k)),mean=0,sd=sigma,log=T)))
  }
}

sqrts<-c()
for(i in 1:4000){
  sqrts[i]<-optim(par=c(r=i,k=i,sigma=i),fn=loglike,dat=dat,scale='sqrt',method='Nelder-Mead',control=list(fnscale=-1))

}

logs<-c()
for(i in 1:4000){
  logs[i]<-optim(par=c(r=i,k=i,sigma=i),fn=loglike,dat=dat,scale='log',method='Nelder-Mead',control=list(fnscale=-1))

}

lins<-c()
for(i in 1:4000){
  lins[i]<-optim(par=c(r=i,k=i,sigma=i),fn=loglike,dat=dat,scale='linear',method='Nelder-Mead',control=list(fnscale=-1))

}

非常感谢!!

Answer 1

错误unable to evaluate at initial parameters到期是因为你在某些方面无法评估你的函数。（很多这里）。请注意：

• 您使用sqrt，因此您的数据必须为正，否则您需要删除否定观察结果。 dat <- dat[dat>0]
• 日志功能dat <- dat[dat > 1]
的问题相同
• 在此处进行回收log(ptp1)-log(ptp)因为您通过n-1向量减去n的向量。我会将ppt1替换为c(1,ppt1)
• 对于linear函数，由于你使用了一个很大的r来指数函数（例如参见exp（365）），它会发散。

我认为，R很棒，因为您可以轻松绘制数据并查看您的功能会发生什么。例如，我在这里使用wireframe来绘制你的一个函数的三维曲面。

dat <- seq(1,100)
ptp <- head(dat,-1)
ptp1 <- c(tail(dat,-2),1)

g <- expand.grid( k = seq(0.1,2,length.out=100),     ## k between [0.1,2]
                  sigma = seq(0.1,1,length.out=100), ## sigma [0.1,1]
                  r= c(0.1,0.5,0.8,1))               ## some r points forgrouping

z <- rep(0,nrow(g))
for(i in seq_along(z))
  z[i] <- sum(dnorm(log(ptp1)-log(ptp)*exp(g[i,'r']-(ptp/g[i,'k'])),
                 mean=0,
                 sd=g[i,'sigma'],
                 log=T))
g$z <- z
any(is.infinite(g$z))     ## you can test if you have infinite value       
FALSE

wireframe(z ~ k * sigma, data = g, groups = r,
          scales = list(arrows = FALSE),
          drape = TRUE, colorkey = TRUE)