در این تمرین با یکی از callback های سیپلکس اشنا می شویم که برای حل مدل های برنامه ریزی عدد صحیح مورد استفاده قرار می گیرد. Callback برای تغییر در فرایند شاخه و کرانه استاندارد مورد استفاده می شود.
1. در این تمرین به جای ساخت مدل، از مدل ساخته شود توسط نرم افزارهای بهینه سازی همچون Gams و Lingo استفاده می شود. با استفاده از این برنامه ها می توان مدل های بهینه سازی را تولید کرد و سپس با خروجی mps به عنوان ورودی cplex استفاده کرد. مسیر پیش فرض بسته به محل نصب برنامه سیپلکس می تواند متفاوت باشد.
Dim cplex As New Cplex()
Dim filename As String = "C://ILOG/CPLEX101/examples/data/noswot.mps"
icounter = 0
If filename.IndexOf("noswot") < 0 Then
System.Console.WriteLine("Error: noswot model is required.")
Return
End If
cplex.ImportModel(filename)
Dim matrixEnum As IEnumerator = cplex.GetLPMatrixEnumerator()
matrixEnum.MoveNext()
2. برای ذخیره ماتریس ضرایب محدودیت ها در ماتریس lp از دستور زیر استفاده می شود.
Dim lp As ILPMatrix = CType(matrixEnum.Current, ILPMatrix)
3. دستور .use برای تغییر در فرایند شاخه و کرانه سیپلکس مورد استفاده قرار می گیرد و با اضافه کردن برش، تغییر شاخه کردن و غیره می توان عملکرد حل مدل با استفاده از سپلکس را بهبود داد.
در این تمرین تعداد برش به صورت پیش فرض تعریف می شود که در صورت این که در هر گره برقرار نباشد به گروه اضافه میشود.
cplex.Use(New Callback(MakeCuts(cplex, lp)))
cplex.SetParam(cplex.IntParam.MIPInterval, 1000)
If cplex.Solve() Then
System.Console.WriteLine(("Solution status = " + cplex.GetStatus().ToString))
System.Console.WriteLine(("Solution value = " + cplex.ObjValue.ToString))
End If
cplex.End()
System.Console.WriteLine(("Concert exception caught: " + e.ToString))
MessageBox.Show("It is done!")
4. در کد فوق، تابع makecuts استفاده می شود که در آن برش های پیش فرض تعریف می شود. برای تولید این برش ها باید مدل و ماتریس ضرایب به عنوان ورودی گرفته شود. این تابع به صورت زیر تعریف می شود.
Public Shared Function MakeCuts(ByVal m As IModeler, ByVal lp As ILPMatrix) As IRange()
Dim x11 As INumVar = Nothing
Dim x12 As INumVar = Nothing
Dim x13 As INumVar = Nothing
Dim x14 As INumVar = Nothing
Dim x15 As INumVar = Nothing
Dim x21 As INumVar = Nothing
Dim x22 As INumVar = Nothing
Dim x23 As INumVar = Nothing
Dim x24 As INumVar = Nothing
Dim x25 As INumVar = Nothing
Dim x31 As INumVar = Nothing
Dim x32 As INumVar = Nothing
Dim x33 As INumVar = Nothing
Dim x34 As INumVar = Nothing
Dim x35 As INumVar = Nothing
Dim x41 As INumVar = Nothing
Dim x42 As INumVar = Nothing
Dim x43 As INumVar = Nothing
Dim x44 As INumVar = Nothing
Dim x45 As INumVar = Nothing
Dim x51 As INumVar = Nothing
Dim x52 As INumVar = Nothing
Dim x53 As INumVar = Nothing
Dim x54 As INumVar = Nothing
Dim x55 As INumVar = Nothing
Dim w11 As INumVar = Nothing
Dim w12 As INumVar = Nothing
Dim w13 As INumVar = Nothing
Dim w14 As INumVar = Nothing
Dim w15 As INumVar = Nothing
Dim w21 As INumVar = Nothing
Dim w22 As INumVar = Nothing
Dim w23 As INumVar = Nothing
Dim w24 As INumVar = Nothing
Dim w25 As INumVar = Nothing
Dim w31 As INumVar = Nothing
Dim w32 As INumVar = Nothing
Dim w33 As INumVar = Nothing
Dim w34 As INumVar = Nothing
Dim w35 As INumVar = Nothing
Dim w41 As INumVar = Nothing
Dim w42 As INumVar = Nothing
Dim w43 As INumVar = Nothing
Dim w44 As INumVar = Nothing
Dim w45 As INumVar = Nothing
Dim w51 As INumVar = Nothing
Dim w52 As INumVar = Nothing
Dim w53 As INumVar = Nothing
Dim w54 As INumVar = Nothing
Dim w55 As INumVar = Nothing
Dim vars As INumVar() = lp.NumVars
Dim num As Integer = lp.Ncols
Dim i As Integer
For i = 0 To num - 1
If vars(i).Name.Equals("X11") Then
x11 = vars(i)
ElseIf vars(i).Name.Equals("X12") Then
x12 = vars(i)
ElseIf vars(i).Name.Equals("X13") Then
x13 = vars(i)
ElseIf vars(i).Name.Equals("X14") Then
x14 = vars(i)
ElseIf vars(i).Name.Equals("X15") Then
x15 = vars(i)
ElseIf vars(i).Name.Equals("X21") Then
x21 = vars(i)
ElseIf vars(i).Name.Equals("X22") Then
x22 = vars(i)
ElseIf vars(i).Name.Equals("X23") Then
x23 = vars(i)
ElseIf vars(i).Name.Equals("X24") Then
x24 = vars(i)
ElseIf vars(i).Name.Equals("X25") Then
x25 = vars(i)
ElseIf vars(i).Name.Equals("X31") Then
x31 = vars(i)
ElseIf vars(i).Name.Equals("X32") Then
x32 = vars(i)
ElseIf vars(i).Name.Equals("X33") Then
x33 = vars(i)
ElseIf vars(i).Name.Equals("X34") Then
x34 = vars(i)
ElseIf vars(i).Name.Equals("X35") Then
x35 = vars(i)
ElseIf vars(i).Name.Equals("X41") Then
x41 = vars(i)
ElseIf vars(i).Name.Equals("X42") Then
x42 = vars(i)
ElseIf vars(i).Name.Equals("X43") Then
x43 = vars(i)
ElseIf vars(i).Name.Equals("X44") Then
x44 = vars(i)
ElseIf vars(i).Name.Equals("X45") Then
x45 = vars(i)
ElseIf vars(i).Name.Equals("X51") Then
x51 = vars(i)
ElseIf vars(i).Name.Equals("X52") Then
x52 = vars(i)
ElseIf vars(i).Name.Equals("X53") Then
x53 = vars(i)
ElseIf vars(i).Name.Equals("X54") Then
x54 = vars(i)
ElseIf vars(i).Name.Equals("X55") Then
x55 = vars(i)
ElseIf vars(i).Name.Equals("W11") Then
w11 = vars(i)
ElseIf vars(i).Name.Equals("W12") Then
w12 = vars(i)
ElseIf vars(i).Name.Equals("W13") Then
w13 = vars(i)
ElseIf vars(i).Name.Equals("W14") Then
w14 = vars(i)
ElseIf vars(i).Name.Equals("W15") Then
w15 = vars(i)
ElseIf vars(i).Name.Equals("W21") Then
w21 = vars(i)
ElseIf vars(i).Name.Equals("W22") Then
w22 = vars(i)
ElseIf vars(i).Name.Equals("W23") Then
w23 = vars(i)
ElseIf vars(i).Name.Equals("W24") Then
w24 = vars(i)
ElseIf vars(i).Name.Equals("W25") Then
w25 = vars(i)
ElseIf vars(i).Name.Equals("W31") Then
w31 = vars(i)
ElseIf vars(i).Name.Equals("W32") Then
w32 = vars(i)
ElseIf vars(i).Name.Equals("W33") Then
w33 = vars(i)
ElseIf vars(i).Name.Equals("W34") Then
w34 = vars(i)
ElseIf vars(i).Name.Equals("W35") Then
w35 = vars(i)
ElseIf vars(i).Name.Equals("W41") Then
w41 = vars(i)
ElseIf vars(i).Name.Equals("W42") Then
w42 = vars(i)
ElseIf vars(i).Name.Equals("W43") Then
w43 = vars(i)
ElseIf vars(i).Name.Equals("W44") Then
w44 = vars(i)
ElseIf vars(i).Name.Equals("W45") Then
w45 = vars(i)
ElseIf vars(i).Name.Equals("W51") Then
w51 = vars(i)
ElseIf vars(i).Name.Equals("W52") Then
w52 = vars(i)
ElseIf vars(i).Name.Equals("W53") Then
w53 = vars(i)
ElseIf vars(i).Name.Equals("W54") Then
w54 = vars(i)
ElseIf vars(i).Name.Equals("W55") Then
w55 = vars(i)
End If
Next i
Dim cut(7) As IRange
cut(0) = m.Le(m.Diff(x21, x22), 0.0)
cut(1) = m.Le(m.Diff(x22, x23), 0.0)
cut(2) = m.Le(m.Diff(x23, x24), 0.0)
cut(3) = m.Le(m.Sum(m.Sum(m.Prod(2.08, x11), m.Prod(2.98, x21), m.Prod(3.47, x31), _
m.Prod(2.24, x41), m.Prod(2.08, x51)), _
m.Sum(m.Prod(0.25, w11), m.Prod(0.25, w21), m.Prod(0.25, w31), _
m.Prod(0.25, w41), m.Prod(0.25, w51))), 20.25)
cut(4) = m.Le(m.Sum(m.Sum(m.Prod(2.08, x12), m.Prod(2.98, x22), m.Prod(3.47, x32), _
m.Prod(2.24, x42), m.Prod(2.08, x52)), _
m.Sum(m.Prod(0.25, w12), m.Prod(0.25, w22), m.Prod(0.25, w32), _
m.Prod(0.25, w42), m.Prod(0.25, w52))), 20.25)
cut(5) = m.Le(m.Sum(m.Sum(m.Prod(2.08, x13), m.Prod(2.98, x23), m.Prod(3.47, x33), _
m.Prod(2.24, x43), m.Prod(2.08, x53)), _
m.Sum(m.Prod(0.25, w13), m.Prod(0.25, w23), m.Prod(0.25, w33), _
m.Prod(0.25, w43), m.Prod(0.25, w53))), 20.25)
cut(6) = m.Le(m.Sum(m.Sum(m.Prod(2.08, x14), m.Prod(2.98, x24), m.Prod(3.47, x34), _
m.Prod(2.24, x44), m.Prod(2.08, x54)), _
m.Sum(m.Prod(0.25, w14), m.Prod(0.25, w24), m.Prod(0.25, w34), _
m.Prod(0.25, w44), m.Prod(0.25, w54))), 20.25)
cut(7) = m.Le(m.Sum(m.Sum(m.Prod(2.08, x15), m.Prod(2.98, x25), m.Prod(3.47, x35), _
m.Prod(2.24, x45), m.Prod(2.08, x55)), _
m.Sum(m.Prod(0.25, w15), m.Prod(0.25, w25), m.Prod(0.25, w35), _
m.Prod(0.25, w45), m.Prod(0.25, w55))), 16.25)
Return cut
End Function 'MakeCuts
4. برای فعال سازی callback باید این کلاس را به نحوه تغییر داد که در صورت برقرار نشدن جواب گره فعلی، برش به ان گره اضافه شود. برای این منظور باید کد های زیر اضافه شود.
Public Class Callback
Inherits Cplex.CutCallback
Friend eps As Double = 0.000001
Friend cut() As IRange
Friend Sub New(ByVal cuts() As IRange)
cut = cuts
End Sub 'New
5. این بخش از کد زمانی که کرسر cursor بر روی یک گره از درخت شاخه و کرانه می رود اجرا می شود. در کد زیر، برای تمامی برش های پیش فرض این شرط که آیا برقرار است یا نه کنترل می شود. اگر برش برقرار نباشد به گره اضافه می شود. این اضافه شدن با دستور add انجام می شود.
Public Overrides Sub Main()
Dim num As Integer = cut.Length
Dim i As Integer
For i = 0 To num - 1
Dim thecut As IRange = cut(i)
If Not (thecut Is Nothing) Then
Dim val As Double = GetValue(thecut.Expr)
If thecut.LB > val + eps OrElse val - eps > thecut.UB Then
Add(thecut)
cut(i) = Nothing
End If
End If
Next i
icounter += 1
End Sub 'Main
End Class 'Callback
6. اکنون برنامه تکمیل است و می توانید اجرا کنید.
7. در صورتی که می خواهید تغییرات را ذخیره کنید به لینک زیر مراجعه کنید.
