在 R 中的模拟退火算法中添加约束答案

【问题标题】：Adding constrains in simulated annealing algorithm in R在 R 中的模拟退火算法中添加约束
【发布时间】：2019-06-09 15:10:51
【问题描述】：

我有一个模拟退火算法的脚本，想限制搜索，在本例中为超立方体。

simulated_annealing <- function(func, s0, niter = 1, epsilon = 0.01) {
#   ##s=state, f=funcion, b=best, c=current, n=neighbour

  s_b <- s_c <- s_n <- s0
   f_b <- f_c <- f_n <- func(s_n)

   for (k in 1:niter) {     
     Temperatura <- (1 - epsilon)^k 
     s_n <- rnorm(2, s_c, 1)
     f_n <- func(s_n)
     if (f_n < f_c || runif(1, 0, 1) < exp(-(f_n - f_c) / Temperatura)) {
       s_c <- s_n
       f_c <- f_n
     }
     if (f_n < f_b) {
       s_b <- s_n
       f_b <- f_n         
     }
   return(list(iteraciones = niter, Mejor_valor = f_b, Mejor_estado = s_b))
 }}

你可以这样使用它：

sol <- simulated_annealing(rastr, niter = 100, epsilon = 0.91, s0 = c(0, 2))

我想对搜索空间添加限制，使其仅在超立方体 x_i=[-5.12,5.12] 中移动，但我不知道如何开始。我尝试使用 while 但它停止了该功能。

请，谢谢

【问题讨论】：

能发一个完整的函数吗？要么你的函数中有更多内容，要么你忘记了最后的大括号}。另外，您能否举例说明您想要的用法和期望的结果？可重复的数据会很好。并告诉我们您想要“限制”什么。
完成。您可以与任何功能一起使用，它只是搜索 optima。我在 Rastrigin 中测试它，通常受限于提到的超立方体，但我吸进 R 并且不知道如何添加这样的限制。

标签： r optimization simulated-annealing

【解决方案1】：

我设法找到了一个解决方案，尽管有点不酷。完成的脚本如下：

      simulated_annealing <- function(func, s0, niter = 1000, epsilon = 0.1) {
x_upper = 5.12
x_lower = -5.12
  # Inicializamos
  ## s simboliza estado
  ## f simboliza valor de la funcion
  ## b simboliza el mejor obtenido hasta ahora
  ## c simboliza el presente
  ## n simboliza vecino
  s_b <- s_c <- s_n <- s0
  f_b <- f_c <- f_n <- func(s_n)
  message("Iteracion\tMejor\tActual\tVecino\tTemperatura")
  message(sprintf("%i\t%.4f\t%.4f\t%.4f\t%.4f", 0L, f_b, f_c, f_n, 1000))

  for (k in 1:niter) {
    Temperatura <- (1 - epsilon)^k #Exponencial
    # Contemplamos un vecino aleatorio
    s_n <- rnorm(2, s_c, 1)
    f_n <- func(s_n)
while (f_n > x_upper | f_n < x_lower) {
  s_c <- s_c[! s_c %in% c(s_n)] ##THIS IS THE ADDED LINE
  s_n <- rnorm(2, s_c, 1)
  f_n <- func(s_n)
}
#     # Actualizamos el estado actual
    if (f_n < f_c || runif(1, 0, 1) < exp(-(f_n - f_c) / Temperatura)) {
      s_c <- s_n
      f_c <- f_n
    }
#     # Actualizamos el estado al mejor conseguido
    if (f_n < f_b) {
      s_b <- s_n
      f_b <- f_n
    }
    if (k %% 1000==0) {
    message(sprintf("%i\t%.4f\t%.4f\t%.4f\t%.4f", k, f_b, f_c, f_n, Temperatura))}
  }
  return(list(iteraciones = niter, Mejor_valor = f_b, Mejor_estado = s_b))
}

【讨论】：