如何优化R中的整数参数(和其他不连续参数空间)?

如何优化R中的整数参数(和其他不连续参数空间)?,r,optimization,integer,R,Optimization,Integer,如果参数空间仅为整数(或不连续),如何进行优化 在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("[^[:digi

如果参数空间仅为整数(或不连续),如何进行优化

在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)
fr以下是一些想法

1。惩罚优化。 你可以对目标函数的参数进行取整 并为非整数添加惩罚。 但这会产生很多局部极值, 因此,您可能更喜欢更稳健的优化例程, e、 差分进化或粒子群优化

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

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
#未修改的函数
整数规划(IP)有自己的规则和算法。使用连续解算器没有多大意义。R没有专门的整数规划解算器,但您可以尝试:

  • 如果你的函数是线性的,使用一个混合整数规划 解算器,如R中的“lpSolve”或R中的“Rglpk”

  • 否则,您可以使用模拟退火方法“SANN”尝试optim 方法,文件中说明:

“它只使用函数值,但速度相对较慢…如果函数
生成一个新的候选点,也可以使用“SANN”方法
要解决组合优化问题,请注意“SANN”
方法主要取决于控制参数的设置。”

下面是一个在
[-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

funR中提供了新的包,允许在优化程序中使用不连续的输入参数(例如整数)。其中之一是

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

# 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

rgenoud使用stats::optim()进行优化。因此,用户可以将任何选项传递给rgenoud,它通常会传递给optim()

教科书质量答案!美丽的情节说明了这个问题!谢谢!我认为对于不连续和/或整数函数会有一种特定的方法。您可能是回答这个附带问题的最佳人选:有没有一种方法可以在不简单探索整个参数空间的情况下,为每个参数(例如1:1000)优化给定的向量参数空间?这可能比搜索一个受惩罚的连续有界空间更有效,即使我们必须搜索整个空间(与可比较的连续空间相比仍然是一个小空间)。如果搜索空间不太大,可以使用穷举搜索(网格搜索)。否则,您可以通过选择一个邻域函数并使用一些局部算法来搜索一个大的离散空间:局部搜索、阈值接受、模拟退火(@HansWerner's answer)。阈值接受类似于模拟退火,但更具确定性:它收敛更快,但频率更低,并且对邻域选择更敏感。您应该使用实际函数进行测试:模拟退火通常要慢得多,但对整数的限制应该会加快速度。事实上,LSopt和TAopt都不记得它们在哪里,这意味着它们往往会在我的函数中循环。是这些算法的一个变体,可以记住哪些点已经被探索过。有一个
tabuSearch
包,但不幸的是它仅限于二进制搜索空间。但是,您可以修改
LSopt
TAopt
的邻域函数,以便它记住最后的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
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