当我更改间隔时优化有奇怪的行为

Question

我对 R 中的 optimize() 有疑问。

当我只改变optimize()中的区间时，出乎意料的是，最优参数值会有很大的变化。我之前发现过类似问题的帖子，但没有答案。

我从不同的时间间隔得到了非常不同的值：

c(-1,1): -0.819 

c(-1,2): -0.729 
c(0.3,0.99):0.818 
c(0.2,0.99):0.803 
c(0.1,0.99):0.23 
c(0,0.99):0.243 

我真的需要这个问题的帮助，如果你能帮助或给我任何信息，谢谢你们！

编辑：这是目标函数的图片：

我的代码如下：

dis<-data[,5]
vel<-data[,3]
condition<-data[,2]
nrow<-nrow(data)
number<-500
status<-0
counter<-rep(0,nrow)
firstvel<-rep(0,nrow)
secondvel<-rep(0,nrow)
j=1
n=1
l=0
secondpoint<-rep(0,nrow)
f<-function(a,b,p){ 
  for (i in 5:p){
    diss<-dis[1:(i-1)] 
    stddis<-sd(diss)    
    lowerdis<- a*stddis
    upperdis<- b*stddis
    if (status==0&&dis[i]>=upperdis){
      status<-1
      firstvel[j]<-vel[i]
      j=j+1    
    }
    else if (status==1&&condition[i]<=condition[i-1]&&dis[i]<lowerdis){
      status<-0
      secondvel[n]<-vel[i]
      n=n+1
    }
  }
  secondvel<- subset(secondvel, secondvel>0)
  firstvel<- subset(firstvel, firstvel>0)
  if (j==n&&j>1){
    for (k in 1:(j-1)){
      unit<-number/firstvel[k]
      number<-unit*secondvel[k]
    }
  }   else if(j>1) {
    for (k in 1:(j-2)){
      unit<-number/firstvel[k]
      number<-unit*secondvel[k]
    }
    unit<-number/firstvel[k+1]
    number<-unit*vel[p]
  }
  return(-number)
}
for (point in 300:nrow){
  diss<-dis[1:(point-1)]
  stddis<-sd(diss)
  upperdis<- stddis
  if (status==0&&dis[point]>=upperdis){
    status<-1
    firstvel[j]<-vel[point]
    j=j+1
    last<-optimize(f,c(0.2,0.99),b=1.0,p=point)
    secondpoint[n]<-last$minimum      ## This is the optimal value I need, which changes a lot 
    lowerdis<- secondpoint[n]*stddis
  }
  else if (status==1&&condition[point]<=condition[point-1]&&dis[point]<lowerdis){
    status=0
    secondvel[n]<-vel[point]
    n=n+1
  }
}
secondvel<-subset(secondvel,secondvel>0)
firstvel<-subset(firstvel,firstvel>0)
secondpoint<-as.numeric(secondpoint[1:(j-1)])
diff<-rep(0,(j-1))
if (j==n&&j>1){
  for (k in 1:(j-1)){
    unit<-number/firstvel[k]
    number<-unit*secondvel[k]
    diff[k]<-unit*(secondvel[k]-firstvel[k])
  }
}  else if(j>1) {
  for (k in 1:(j-2)){
    unit<-number/firstvel[k]
    number<-unit*secondvel[k]
    diff[k]<-unit*(secondvel[k]-firstvel[k])
  }
  unit<-number/firstvel[k+1]
  number<-unit*vel[nrow]
  diff[k+1]<-unit*(vel[nrow]-firstvel[k+1])
}

Answer 1

对于任何假设目标函数是平滑且具有单个最小值的优化器（例如optimize()）来说，这个优化问题基本上是不可能的。你没有给出一个可重复的例子，但这里有一个目标函数的例子，它和你的一样丑：

set.seed(101)
r <- runif(11)
f <- function(x) r[pmin(11,pmax(1,floor(x)+1))]

有很多随机全局优化算法——你可以在CRAN Optimization Task View搜索“global”来找到更多——但是它们都会慢得多，并且需要更多地调整优化控制参数，才能获得任何特定问题的可靠结果。在这种情况下，optim() 中的"SANN"（模拟退火）方法与默认选项配合得相当好——它在 25 次中得到了 20 次正确答案。您可以调整控制参数（例如增加maxit：参见?optim），也许会做得更好。

pvals <- replicate(25,optim(f,par=5,method="SANN")$par)

curve(f,from=-1,to=11)
points(pvals,f(pvals),col=2)
sum(pvals>1 & pvals<2) ## 20

另外，对于一维问题，蛮力网格搜索始终是一种选择...