从已知的解决方案中生成星型和棒式解决方案的算法？

Question

在我尝试使用模拟退火启发式来解决问题时，我试图找到生成当前建议解决方案的邻居的最佳方法。

解决方案以整数位置向量（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中进行。我已经检查了this但是我无法解决我的疑虑。

非常感谢你的帮助。

Answer 1

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

而且，虽然看起来好像是在随机选择移动方向，但实际上移动更可能是向下而不是向上移动。这是因为Diffs[position-1]保证大于D（由于选择position的方式），但Diffs[position]不是。move。这意味着在某些情况下c(-1,0,1)将从c(-1,0,0)随机选择，而在其他情况下，它将从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 } 随机选择。因此，随着时间的推移，向下移动将发生的不仅仅是向上移动。

您的算法可以通过在所有相邻线段的长度至少为D的点之间随机选择来固定，即移动方向上没有任何偏差：

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
}

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

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') 的平均值：

{{1}}