tsp_vb.vb


tsp_vb.vb


“使用懒惰约束在随机生成的一组点上解狗万app足彩决旅行推销员问题。”基本的MIP模型只包括“2度”约束,要求每个节点恰好有“两条关联边”。此模型的解决方案可能包含子漫游——不访问每个节点的漫游。惰性约束回调'会添加新的约束来切断它们。导入Gurobi类tsp_vb继承GRBCallback Private var As GRBVar(,) Public Sub New(xvars As GRBVar(,)) vars = xvars结束Sub ' Subtour消除回调。当找到一个可行解时,如果遍历不访问每个节点,则“找到最小的子遍历,并添加子遍历消除约束”。If where = GRB.Callback.MIPSOL Then '找到一个整数可行的解决方案-它是否访问每个节点?Dim n As Integer = vars. getlength (0) Dim tour As Integer() = findsubtour(GetSolution(vars))如果tour。Length < n Then ' Add subtour elimination constraint Dim expr As GRBLinExpr = 0 For i As Integer = 0 To tour。长度- 1 For j As Integer = i + 1 To tour。长度- 1 expr. addterm (1.0, vars(tour(i), tour(j)))长度- 1)End If End If Catch e As GRBException控制台。WriteLine("错误代码:" & e.ErrorCode & "。 " & e.Message) Console.WriteLine(e.StackTrace) End Try End Sub ' Given an integer-feasible solution 'sol', returns the smallest ' sub-tour (as a list of node indices). Protected Shared Function findsubtour(sol As Double(,)) As Integer() Dim n As Integer = sol.GetLength(0) Dim seen As Boolean() = New Boolean(n - 1) {} Dim tour As Integer() = New Integer(n - 1) {} Dim bestind As Integer, bestlen As Integer Dim i As Integer, node As Integer, len As Integer, start As Integer For i = 0 To n - 1 seen(i) = False Next start = 0 bestlen = n+1 bestind = -1 node = 0 While start < n For node = 0 To n - 1 if Not seen(node) Exit For End if Next if node = n Exit While End if For len = 0 To n - 1 tour(start+len) = node seen(node) = true For i = 0 To n - 1 if sol(node, i) > 0.5 AndAlso Not seen(i) node = i Exit For End If Next If i = n len = len + 1 If len < bestlen bestlen = len bestind = start End If start = start + len Exit For End If Next End While For i = 0 To bestlen - 1 tour(i) = tour(bestind+i) Next System.Array.Resize(tour, bestlen) Return tour End Function ' Euclidean distance between points 'i' and 'j' Protected Shared Function distance(x As Double(), y As Double(), _ i As Integer, j As Integer) As Double Dim dx As Double = x(i) - x(j) Dim dy As Double = y(i) - y(j) Return Math.Sqrt(dx * dx + dy * dy) End Function Public Shared Sub Main(args As String()) If args.Length < 1 Then Console.WriteLine("Usage: tsp_vb nnodes") Return End If Dim n As Integer = Convert.ToInt32(args(0)) Try Dim env As New GRBEnv() Dim model As New GRBModel(env) ' Must set LazyConstraints parameter when using lazy constraints model.Parameters.LazyConstraints = 1 Dim x As Double() = New Double(n - 1) {} Dim y As Double() = New Double(n - 1) {} Dim r As New Random() For i As Integer = 0 To n - 1 x(i) = r.NextDouble() y(i) = r.NextDouble() Next ' Create variables Dim vars As GRBVar(,) = New GRBVar(n - 1, n - 1) {} For i As Integer = 0 To n - 1 For j As Integer = 0 To i vars(i, j) = model.AddVar(0.0, 1.0, distance(x, y, i, j), _ GRB.BINARY, "x" & i & "_" & j) vars(j, i) = vars(i, j) Next Next ' Degree-2 constraints For i As Integer = 0 To n - 1 Dim expr As GRBLinExpr = 0 For j As Integer = 0 To n - 1 expr.AddTerm(1.0, vars(i, j)) Next model.AddConstr(expr = 2.0, "deg2_" & i) Next ' Forbid edge from node back to itself For i As Integer = 0 To n - 1 vars(i, i).UB = 0.0 Next model.SetCallback(New tsp_vb(vars)) model.Optimize() If model.SolCount > 0 Then Dim tour As Integer() = findsubtour(model.Get(GRB.DoubleAttr.X, vars)) Console.Write("Tour: ") For i As Integer = 0 To tour.Length - 1 Console.Write(tour(i) & " ") Next Console.WriteLine() End If ' Dispose of model and environment model.Dispose() env.Dispose() Catch e As GRBException Console.WriteLine("Error code: " & e.ErrorCode & ". " & e.Message) Console.WriteLine(e.StackTrace) End Try End Sub End Class