36

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

在 optim() 中使用整数检查似乎不起作用，而且无论如何效率都非常低。

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)
4

3 回答 3

55

这里有一些想法。

1. 惩罚优化。 您可以对目标函数的参数进行四舍五入，并对非整数添加惩罚。但这会产生很多局部极值，因此您可能更喜欢更稳健的优化程序，例如微分进化或粒子群优化。

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. 详尽的搜索。 如果搜索空间很小，也可以使用网格搜索。

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

3. 本地搜索，具有用户指定的社区。 在不调整目标函数的情况下，您可以使用某种形式的局部搜索，您可以在其中指定要检查的点。这应该快得多，但对邻域函数的选择极为敏感。

# 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.禁忌搜索。 为了避免一次又一次地探索相同的点，您可以使用 禁忌搜索，即记住最后的k点以避免再次访问它们。

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

在下面的例子中，它并没有真正起作用：我们只移动到最近的局部最小值。而在更高维度上，情况会变得更糟：邻域如此之大，以至于我们从未访问过已访问点的缓存。

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

差分进化效果更好：我们只得到一个局部最小值，但它比最近的要好。

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

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

于 2012-06-19T23:50:16.850 回答
14

整数规划 (IP) 有自己的规则和算法。使用连续求解器没有多大意义。R 没有专门的整数规划求解器，但您可以尝试：

  • 如果您的函数是线性的，请使用混合整数规划求解器之一，例如将lp_solve作为 R 中的“lpSolve”或将GLPK作为 R 中的“Rglpk”。

  • 否则，您可以尝试使用“SANN”方法进行优化，这是一种模拟退火方法，文档中说：

"It uses only function values but is relatively slow... If a function to generate a new candidate point is given, method 'SANN' can also be used to solve combinatorial optimization problems... Note that the 'SANN' method depends critically on the settings of the control parameters."

这是一个带有平移球体函数的示例[-10,10]x[-10,10]：

fun <- function(x) sum((x-c(3.2, 6.7))^2)
nextfun <- function(x) sample(-10:10, 2, replace=TRUE)

optim(fn=fun, par=c(-10,-10), gr=nextfun, method="SANN", 
      control=list(maxit=1000,fnscale=1,trace=10))

# sann objective function values
# initial       value 458.000000
# iter      999 value 0.000000
# final         value 0.000000
# sann stopped after 999 iterations
# $par
# [1] 3 7
# $value
# [1] 0.13

但是，如果没有其他帮助，您应该应用更智能的“梯度”，即随机采样，或者在您的整数域中进行完整搜索。当然，在更高的维度上，将需要一种专门的方法。

于 2012-06-20T07:30:08.837 回答
9

R 中提供了新的包，允许在优化程序中使用不连续的输入参数（例如整数）。其中之一是rgenoud

使用选项“data.type.int=TRUE”并通过设置正确的边界，该函数将仅使用整数来最小化或最大化给定函数。

在 rgenoud 下面使用 stats::optim() 进行优化。因此，用户能够将任何选项传递给 rgenoud，它通常会传递给 optim()

于 2014-05-18T09:38:09.443 回答