LPR解决了如何定义约束条件

LPR解决了如何定义约束条件,r,constraints,lpsolve,R,Constraints,Lpsolve,我想把旅行推销员问题编码成R。我打算先从3个城市开始,然后再扩展到更多的城市。下面的距离矩阵给出了3个城市之间的距离。目标(如果有人不知道)是销售人员将从一个城市出发,并将访问另外两个城市,这样他就必须旅行最少的距离 在下面的例子中,他应该从纽约或洛杉矶出发,然后前往芝加哥,然后前往剩下的城市。我需要帮助来定义约束矩阵 我的决策变量与距离矩阵的维数相同。它将是一个1,0矩阵,其中1表示从等于行名称的城市到等于列名称的城市的行程。例如,如果一个推销员从纽约旅行到芝加哥,第1行的第2个元素将是1。我

我想把旅行推销员问题编码成R。我打算先从3个城市开始,然后再扩展到更多的城市。下面的距离矩阵给出了3个城市之间的距离。目标(如果有人不知道)是销售人员将从一个城市出发,并将访问另外两个城市,这样他就必须旅行最少的距离

在下面的例子中,他应该从纽约或洛杉矶出发,然后前往芝加哥,然后前往剩下的城市。我需要帮助来定义约束矩阵

我的决策变量与距离矩阵的维数相同。它将是一个1,0矩阵,其中1表示从等于行名称的城市到等于列名称的城市的行程。例如,如果一个推销员从纽约旅行到芝加哥,第1行的第2个元素将是1。我的列名和行名是纽约、芝加哥和洛杉矶

通过查看问题的解决方案,我得出结论,我的约束条件是:

行总数必须小于1,因为他不能两次从同一个城市离开

列总和必须小于1,因为他不能两次进入同一个城市

矩阵元素的总和必须为2,因为销售人员将访问2个城市并从2个城市离开

我需要帮助来定义约束矩阵。我应该如何将决策变量绑定到约束中

 ny=c(999,9,20)
 chicago=c(9,999,11)
 LA=c(20,11,999)
 distances=cbind(ny,chicago,LA)


 dv=matrix(c("a11","a12","a13","a21","a22","a23","a31","a32","a33"),nrow=3,ncol=3)

 c_=c(distances[1,],distances[2,],distances[3,])
 signs = c((rep('<=', 7)))
 b=c(1,1,1,1,1,1,2)
 res = lpSolve::lp('min', c_, A_, signs, b,  all.bin = TRUE)
ny=c(999,9,20)
芝加哥=c(9999,11)
LA=c(20,11999)
距离=cbind(纽约、芝加哥、洛杉矶)
dv=矩阵(c(“a11”、“a12”、“a13”、“a21”、“a22”、“a23”、“a31”、“a32”、“a33”),nrow=3,ncol=3)
c=c(距离[1,],距离[2,],距离[3,])

符号=c((代表(“您的解决方案存在一些问题。首先,您考虑的约束条件不能保证所有城市都会被访问——例如,路径可以从纽约到洛杉矶,然后再返回。这可以很容易地解决,例如,要求每行和每列的总和正好为一,而不是最多为1(虽然在这种情况下,你会发现一个旅行推销员旅行,而不仅仅是一条小路)

更大的问题是,即使我们解决了这个问题,您的约束也不能保证所选顶点实际上在图形中形成一个循环,而不是多个较小的循环。我认为您对问题的表示不能解决这个问题


这是一个使用LP的旅行推销员的实现。解空间的大小为n^3,其中n是距离矩阵中的行数。这表示nxn矩阵的n个连续副本,每个副本表示在时间
t
1所遍历的边。您可以使用
gaoptim
包来解permu静态/实值问题-它是纯R,所以速度不那么快:

欧洲巡回赛问题(见optim)
eurodistmat=as.matrix(eurodist)
#适应度函数(我们将执行最大化,因此将其反转)
距离=功能(sq)
{
sq=c(sq,sq[1])

sq2也请在你的代码中对你的主要步骤进行注释。现在我必须逐行找出它在做什么…在某些情况下,我不理解你在做特定步骤背后的直觉。我正在研究你的解决方案,我需要一些时间来更好地理解它…但同时我有一个快速的问题:我看起来你不是在使用优化包,比如lpsolve来获得解决方案……那么你是如何得到解决方案的?你的解决方案是可伸缩的吗?假设我有1000个城市……是的,它使用lpsolve包——
lp
的调用是从
tspsolve
函数底部开始的三行。不,是解决方案on是不可伸缩的。它开始在大约15个城市花费很长时间。对于旅行推销员来说,没有可伸缩的解决方案,因为这是一个NP完全问题。我添加了一些评论。希望这有帮助。QQ,在下面的调用中:res
tspsolve<-function(x){
   diag(x)<-1e10
   ## define some basic constants
   nx<-nrow(x)
   lx<-length(x)
   objective<-matrix(x,lx,nx)
   rowNum<-rep(row(x),nx)
   colNum<-rep(col(x),nx)
   stepNum<-rep(1:nx,each=lx)

   ## these constraints ensure that at most one edge is traversed each step
   onePerStep.con<-do.call(cbind,lapply(1:nx,function(i) 1*(stepNum==i)))
   onePerRow.rhs<-rep(1,nx)

   ## these constraints ensure that each vertex is visited exactly once
   onceEach.con<-do.call(cbind,lapply(1:nx,function(i) 1*(rowNum==i)))
   onceEach.rhs<-rep(1,nx)

   ## these constraints ensure that the start point of the i'th edge
   ## is equal to the endpoint of the (i-1)'st edge
   edge.con<-c()
   for(s in 1:nx){
     s1<-(s %% nx)+1    
     stepMask<-(stepNum == s)*1
     nextStepMask<- -(stepNum== s1)
     for(i in 1:nx){        
       edge.con<-cbind(edge.con,stepMask * (colNum==i) + nextStepMask*(rowNum==i))
     }
   }
   edge.rhs<-rep(0,ncol(edge.con))

   ## now bind all the constraints together, along with right-hand sides, and signs
   constraints<-cbind(onePerStep.con,onceEach.con,edge.con)
   rhs<-c(onePerRow.rhs,onceEach.rhs,edge.rhs)
   signs<-rep("==",length(rhs))
   list(constraints,rhs)

   ## call the lp solver
   res<-lp("min",objective,constraints,signs,rhs,transpose=F,all.bin=T)

   ## print the output of lp
   print(res)

   ## return the results as a sequence of vertices, and the score = total cycle length
   list(cycle=colNum[res$solution==1],score=res$objval)
}
set.seed(123)
x<-matrix(runif(16),c(4,4))
x
##           [,1]      [,2]      [,3]      [,4]
## [1,] 0.2875775 0.9404673 0.5514350 0.6775706
## [2,] 0.7883051 0.0455565 0.4566147 0.5726334
## [3,] 0.4089769 0.5281055 0.9568333 0.1029247
## [4,] 0.8830174 0.8924190 0.4533342 0.8998250
tspsolve(x)
## Success: the objective function is 2.335084 
## $cycle
## [1] 1 3 4 2
## 
## $score
## [1] 2.335084
tspscore<-function(x,solution){
    sum(sapply(1:nrow(x), function(i) x[solution[i],solution[(i%%nrow(x))+1]])) 
}

tspbrute<-function(x,trials){
  score<-Inf
  cycle<-c()
  nx<-nrow(x)
  for(i in 1:trials){
    temp<-sample(nx)
    tempscore<-tspscore(x,temp)
    if(tempscore<score){
      score<-tempscore
      cycle<-temp
    }
  }
  list(cycle=cycle,score=score)
}

tspbrute(x,100)
## $cycle
## [1] 3 4 2 1
## 
## $score
## [1] 2.335084
> set.seed(123)
> x<-matrix(runif(100),10,10)
> tspsolve(x)
Success: the objective function is 1.296656 
$cycle
 [1]  1 10  3  9  5  4  8  2  7  6

$score
[1] 1.296656

> tspbrute(x,1000)
$cycle
 [1]  1  5  4  8 10  9  2  7  6  3

$score
[1] 2.104487
timetsp<-function(x,seed=123){
    set.seed(seed)
    m<-matrix(runif(x*x),x,x)   
    gc()
    system.time(tspsolve(m))[3]
}

sapply(6:16,timetsp)
## elapsed elapsed elapsed elapsed elapsed elapsed elapsed elapsed elapsed elapsed 
## 0.011   0.010   0.018   0.153   0.058   0.252   0.984   0.404   1.984  20.003 
## elapsed 
## 5.565
 eurodistmat = as.matrix(eurodist)

 # Fitness function (we'll perform a maximization, so invert it)
 distance = function(sq)
 {
   sq = c(sq, sq[1])
   sq2 <- embed(sq, 2)
   1/sum(eurodistmat[cbind(sq2[,2], sq2[,1])])
 }

 loc = -cmdscale(eurodist, add = TRUE)$points
 x = loc[, 1]
 y = loc[, 2]
 n = nrow(eurodistmat)

 set.seed(1)

 # solving code
 require(gaoptim)
 ga2 = GAPerm(distance, n, popSize = 100, mutRate = 0.3)
 ga2$evolve(200)
 best = ga2$bestIndividual()
 # solving code

 # just transform and plot the results
 best = c(best, best[1])
 best.dist = 1/max(ga2$bestFit())
 res = loc[best, ]
 i = 1:n

 plot(x, y, type = 'n', axes = FALSE, ylab = '', xlab = '')
 title ('Euro tour: TSP with 21 cities')
 mtext(paste('Best distance found:', best.dist))
 arrows(res[i, 1], res[i, 2], res[i + 1, 1], res[i + 1, 2], col = 'red', angle = 10)
 text(x, y, labels(eurodist), cex = 0.8, col = 'gray20')