如何优化R中的整数参数（和其他不连续的参数空间）？ [英] How to optimize for integer parameters (and other discontinuous parameter space) in R?

问题描述

如果参数空间只是整数（或者是不连续的），如何优化？

How does one optimize if the parameter space is only integers (or is otherwise discontinuous)?

在optim（）中使用整数检查似乎不起作用反正会非常低效。

Using an integer check in optim() does not seem to work and would be very inefficient anyways.

fr <- function(x) {   ## Rosenbrock Banana function
  x1 <- x[1]
  x2 <- x[2]
  value<-100 * (x2 - x1 * x1)^2 + (1 - x1)^2

  check.integer <- function(N){
    !length(grep("[^[:digit:]]", as.character(N)))
  }

  if(!all(check.integer(abs(x1)), check.integer(abs(x2)))){
   value<-NA 
  }
  return(value)

}
optim(c(-2,1), fr)

推荐答案

以下是一些想法。

1。惩罚优化。
您可以对目标函数
的参数进行舍入，并为非整数添加惩罚。
但是这会产生很多局部极值，
所以你可能更喜欢更强大的优化例程，例如差分进化或粒子群优化。

1. Penalized optimization. You could round the arguments of the objective function and add a penalty for non-integers. But this creates a lot of local extrema, so you may prefer a more robust optimization routine, e.g., differential evolution or particle swarm optimization.

fr <- function(x) {
  x1 <- round( x[1] )
  x2 <- round( x[2] )
  value <- 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
  penalty <- (x1 - x[1])^2 + (x2 - x[2])^2
  value + 1e3 * penalty
}

# Plot the function
x <- seq(-3,3,length=200)
z <- outer(x,x, Vectorize( function(u,v) fr(c(u,v)) ))
persp(x,x,z,
  theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA,
  ltheta = 120, shade = 0.75, ticktype = "detailed")

library(RColorBrewer)
image(x,x,z, 
  las=1, useRaster=TRUE,
  col=brewer.pal(11,"RdYlBu"),
  xlab="x", ylab="y"
)

# Minimize
library(DEoptim)
library(NMOF)
library(pso)
DEoptim(fr, c(-3,-3), c(3,3))$optim$bestmem
psoptim(c(-2,1), fr, lower=c(-3,-3), upper=c(3,3))
DEopt(fr, list(min=c(-3,-3), max=c(3,3)))$xbest
PSopt(fr, list(min=c(-3,-3), max=c(3,3)))$xbest

2。详尽搜索。
如果搜索空间很小，您也可以使用网格搜索。

2. Exhaustive search. If the search space is small, you can also use a grid search.

library(NMOF)
gridSearch(fr, list(seq(-3,3), seq(-3,3)))$minlevels

3。本地搜索，具有用户指定的邻域。
如果不调整目标函数，您可以使用某种形式的本地搜索，
，您可以在其中指定要检查的点。
这应该快得多，但对邻域函数的选择非常敏感。

3. Local search, with user-specified neighbourhoods. Without tweaking the objective function, you could use some form of local search, in which you can specify which points to examine. This should be much faster, but is extremely sensitive to the choice of the neighbourhood function.

# Unmodified function
f <- function(x) 
  100 * (x[2] - x[1] * x[1])^2 + (1 - x[1])^2

# Neighbour function
# Beware: in this example, with a smaller neighbourhood, it does not converge.
neighbour <- function(x,...)
  x + sample(seq(-3,3), length(x), replace=TRUE)

# Local search (will get stuck in local extrema)
library(NMOF)
LSopt(f, list(x0=c(-2,1), neighbour=neighbour))$xbest
# Threshold Accepting
TAopt(f, list(x0=c(-2,1), neighbour=neighbour))$xbest

4。禁忌搜索。
为了避免一次又一次地探索相同的点，你可以使用
禁忌搜索，
ie，记住最后的k点以避免再次访问它们。

4. Tabu search. To avoid exploring the same points again and again, you can use tabu search, i.e., remember the last k points to avoid visiting them again.

get_neighbour_function <- function(memory_size = 100, df=4, scale=1){
  # Static variables
  already_visited <- NULL
  i <- 1
  # Define the neighbourhood
  values <- seq(-10,10)
  probabilities <- dt(values/scale, df=df)
  probabilities <- probabilities / sum(probabilities)
  # The function itself
  function(x,...) {
    if( is.null(already_visited) ) {
      already_visited <<- matrix( x, nr=length(x), nc=memory_size )
    }
    # Do not reuse the function for problems of a different size
    stopifnot( nrow(already_visited) == length(x) )
    candidate <- x
    for(k in seq_len(memory_size)) {
      candidate <- x + sample( values, p=probabilities, length(x), replace=TRUE )
      if( ! any(apply(already_visited == candidate, 2, all)) )
        break
    }
    if( k == memory_size ) {
      cat("Are you sure the neighbourhood is large enough?\n")
    } 
    if( k > 1 ) {
      cat("Rejected", k - 1, "candidates\n")
    }
    if( k != memory_size ) {
      already_visited[,i] <<- candidate
      i <<- (i %% memory_size) + 1
    }
    candidate
  }
}

在以下示例中，不起作用：
我们只移动到最近的局部最小值。
在更高的维度上，事情变得更糟：
邻域太大，以至于我们从未达到已经访问过的点的缓存
。

In the following example, it does not really work: we only move to the nearest local minimum. And in higher dimensions, things get even worse: the neighbourhood is so large that we never hit the cache of already visited points.

f <- function(x) {
  result <- prod( 2 + ((x-10)/1000)^2 - cos( (x-10) / 2 ) )  
  cat(result, " (", paste(x,collapse=","), ")\n", sep="")
  result
}
plot( seq(0,1e3), Vectorize(f)( seq(0,1e3) ) )

LSopt(f, list(x0=c(0,0), neighbour=get_neighbour_function()))$xbest
TAopt(f, list(x0=c(0,0), neighbour=get_neighbour_function()))$xbest
optim(c(0,0), f, gr=get_neighbour_function(), method="SANN")$par

差分进化更好：我们只得到一个本地最小值，
但它比最接近的一个好。

Differential evolution works better: we only get a local minimum, but it is better than the nearest one.

g <- function(x) 
  f(x) + 1000 * sum( (x-round(x))^2 )
DEoptim(g, c(0,0), c(1000,1000))$optim$bestmem

禁忌搜索通常用于纯粹的组合问题
（例如，当搜索空间是一组树或图时）
并且似乎不是整数问题的好主意。

Tabu search is often used for purely combinatorial problems (e.g., when the search space is a set of trees or graphs) and does not seem to be a great idea for integer problems.

这篇关于如何优化R中的整数参数（和其他不连续的参数空间）？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！