optimize has weird behavior when I change the interval

问题

I have a problem with optimize() in R.

When I only change the interval in optimize(), surprisingly, the optimal parameter value will vary a lot. I found posts with similar problems before, but there is no answer for them.

I got really different values from different intervals:

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 

I really need help on this problem, thank you guys if you could help or give me any information!!

edit: here is a picture of the objective function:

My code is as below:

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])
}

回答1:

This optimization problem is essentially going to be impossible for any optimizer (such as optimize()) that assumes the objective function is smooth and has a single minimum. You didn't give a reproducible example, but here's an example of an objective function that's just about as ugly as yours:

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

There are many stochastic global optimizing algorithms -- you can search the CRAN Optimization Task View for "global" to find more -- but they will all be much slower, and require a great deal more tuning of optimization control parameters, to get reliable results for any particular problem. In this case, the "SANN" (simulated annealing) method from optim() works reasonably well with the default options -- it gets the right answer 20 out of 25 times. You could adjust the control parameters (e.g. increase maxit: see ?optim) and perhaps do better.

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

Alternatively, for a 1D problem brute-force grid search is always an option ...

来源：https://stackoverflow.com/questions/23809480/optimize-has-weird-behavior-when-i-change-the-interval