2

在我追求模拟退火启发式来解决问题的过程中，我试图找到生成我当前提出的解决方案的邻居的最佳方法。

解决方案以整数位置向量 (p1,...,pN) 的形式出现，我将其理解为二进制链

0 0 0 0 1 0 ... 0 0 1 0 ... 0 1 0 0
       p1          pj        pN

有一些限制（对于所有 j，pj - p(j-1) > D，并且 p1 > D/2，长度 - pN > D/2）。

现在，我的想法是使用类似于 Levenshtein 距离的东西来创建新的解决方案，所以如果我有 [0,1,0,0,1,0] (D=3) 并且我想要一个距离更小的新状态或等于 1，那么我可以得到 [1,0,0,0,1,0]，例如，但不是 [1,0,0,1,0,0]。

我所做的（在 R 中）如下：

GenNewSeq <- function(seq, D, dist){
for(i in 1:dist){
    Diffs <- c((ceiling(D/2)+seq[1]),diff(seq),(ceiling(D/2)+seq[length(seq)]))
    position <- sample((2:length(seq))[Diffs > D], size=1)
    move <- sample(c(-1*as.integer(Diffs[position-1]>D),0,1*as.integer(Diffs[position]>D)), size = 1)
    seq[position-1] <- seq[position-1]+move
    }
seq
}

也许它有点晦涩，如果你愿意，我可以更好地解释它的作用。问题是，这是 1) 慢（我不知道如何避免for），2) 奇怪地没有按预期工作。总是只移动最后一个位置和/或稳定地向前和向后移动相同的元素往往太过分了，所以我的模拟退火结果有偏差。

我曾想过消除距离的限制并将其放在适应度函数中（类似于exp(D-(pj-p(j-1)))），所以我可以简单地用法线移动它们，或者让它们完全移动然后振荡......我开始认为它会成为最简单的方法。但是，我非常感谢您参考如何做一个有效且可靠的算法来满足我的要求，我不介意我是否必须在 C 中这样做。我已经检查过但我无法来解决我的疑惑。

非常感谢您的帮助。

4

1 回答 1

0

您的程序中的错误是这样的。当您position随机选择时，您是从长度至少为 D 的线段集合中随机选择一个线段。您最终要移动的元素是该线段的右侧端点。

而且，尽管您似乎在随机选择移动的方向，但实际上移动更有可能是向下而不是向上。这是因为Diffs[position-1]保证大于D（由于选择的方式position），但Diffs[position]不是。这意味着在某些情况下move将随机选择 from c(-1,0,1)，而在其他情况下将随机选择 from c(-1,0,0)。因此，随着时间的推移，向下移动将比向上移动更多。

您的算法可以通过在相邻段的长度至少为 D 的所有点中随机选择来修复，在这些点的移动方向上不会有任何偏差：

GenNewSeq2 <- function(seq, D, dist){
  for(i in 1:dist){
    Diffs <- c((ceiling(D/2)+seq[1]),diff(seq))
    bigGaps <- Diffs>D
    moveable <- bigGaps[-1] | head(bigGaps,-1)
    position <- sample(which(moveable),1)
    move <- sample(c(-1*(Diffs[position]>D),1*(Diffs[position+1]>D)), size = 1)
    seq[position] <- seq[position]+move
  }
  seq
}

也可以在没有 for 循环的情况下生成一个随机的新序列。这是一种可能的实现：

newseq<-function(seq,D,dist){
   diffs <- c((ceiling(D/2)+seq[1]),diff(seq))
   bigGaps<-diffs>D
   selected<-sample(which(bigGaps),min(length(bigGaps),dist))
   directions<-sample(c(-1,1),length(selected),T)
   down<-directions<0
   up<-directions>0
   selected[up]<-selected[up]-1
   move<-rep(0,length(seq))
   move[selected[up]]<-1
   move[selected[down]]<-move[selected[down]]-1

   move[length(seq)]<-0  ## the last element of seq stays fixed always
   seq+move
}

dist这种实现效率更高，并且在增长时几乎不会减慢速度。

> set.seed(123)
> seq<-sort(sample(1000,20))
> microbenchmark(newseq(seq,20,3),GenNewSeq2(seq,20,3))
Unit: microseconds
                   expr     min       lq  median      uq     max neval
     newseq(seq, 20, 3)  53.503  55.0965  56.026  56.761  68.804   100
 GenNewSeq2(seq, 20, 3) 183.091 188.0490 189.492 191.249 367.094   100
> microbenchmark(newseq(seq,20,6),GenNewSeq2(seq,20,6))
Unit: microseconds
                   expr     min       lq   median       uq     max neval
     newseq(seq, 20, 6)  54.027  56.4960  57.3865  58.2955  70.258   100
 GenNewSeq2(seq, 20, 6) 368.306 373.7745 377.5225 381.4565 559.037   100
>

我们还可以通过为三个函数中的每一个运行以下代码来验证这一点，GenNewSeq2并且newseq不要漂移到零，然后绘制seq随时间变化的平均值：

set.seed(12345)
seq<-sort(sample(1000,20))
x<-rep(0,20000)
for(i in 1:20000){
  x[i]<-mean(seq)
  seq<-GenNewSeq(seq,20,3)
}
plot(x,type='l')

在此处输入图像描述

于 2013-10-04T14:11:04.913 回答