Chơng trình gồm có 3 Form (giao diện) chính:
Form 1. Là giao diện chính của chơng trình có giao diện nh h×nh díi ®©y.
Hình 1. Giao diện chính của chơng trình.
Trong Form 1 bao gồm 2 menu là Bài toán quy hoạch và Hệ thèng.
Trong menu Bài toán quy hoạch có Form giới thiệu về thuật toán Monte Carlo, giao diện nh hình dới đây.
Form 2. Giao diện giới thiệu thuật toán Monte Carlo.
Hỡnh 2. Giao diện giới thiệu thuật toán Monte Carlo.
Trong menu Hệ thống có Form giới thiệu về tác giả, giao diện nh sau:
Form 3. Giao diện giới thiệu về tác giả.
Hình 3. Giao diện giới thiệu về tác giả.
Form 1. Đoạn code sau đây thể hiện Chơng trình Monte Carlo nh sau:
Private Sub optMonterCarlo_Click()
Me.cmdThucHien.ToolTipText = "Thực hiện thuật toán Monter- Carlo theo toạ độ "
Me.cmdAbout.ToolTipText = "Giới thiệu về thuật toán Monter- Carlo theo toạ độ"
Me.txtC3X.Enabled = True Me.txtC3Y.Enabled = True Me.txta4.Enabled = True Me.txtb4.Enabled = True
Me.txtc4.Enabled = True Me.txta5.Enabled = True Me.txtb5.Enabled = True Me.txtc5.Enabled = True Me.txtax.Enabled = True Me.txtbx.Enabled = True Me.txtay.Enabled = True Me.txtby.Enabled = True End Sub
Đoạn code dới đây thể hiện Hàm Nhập hàm mục tiêu Function RefreshHMT() As String
Dim sStr As String sStr = ""
If (C3X < 0) Then sStr = sStr + " - "
If (C3X <> -1) Then sStr = sStr + Trim(Str(Abs(C3X))) sStr = sStr + "x^3"
ElseIf (C3X > 0) Then
If (C3X <> 1) Then sStr = sStr + Trim(Str(C3X)) sStr = sStr + "x^3"
End If
If (C2X < 0) Then sStr = sStr + " - "
If (C2X <> -1) Then sStr = sStr + Trim(Str(Abs(C2X))) sStr = sStr + "x^2"
ElseIf (C2X > 0) Then
If (Trim(sStr) <> "") Then sStr = sStr + "+"
If (C2X <> 1) Then sStr = sStr + Trim(Str(C2X)) sStr = sStr + "x^2"
End If
If (C1X < 0) Then sStr = sStr + " - "
If (C1X <> -1) Then sStr = sStr + Trim(Str(Abs(C1X))) sStr = sStr + "x"
ElseIf (C1X > 0) Then
If (Trim(sStr) <> "") Then sStr = sStr + "+"
If (C1X <> 1) Then sStr = sStr + Trim(Str(C1X)) sStr = sStr + "x"
End If
If (C3Y < 0) Then sStr = sStr + " - "
If (C3Y <> -1) Then sStr = sStr + Trim(Str(Abs(C3Y))) sStr = sStr + "y^3"
ElseIf (C3Y > 0) Then
If (Trim(sStr) <> "") Then sStr = sStr + " + "
If (C3Y <> 1) Then sStr = sStr + Trim(Str(C3Y)) sStr = sStr + "y^3"
End If
If (C2Y < 0) Then sStr = sStr + " - "
If (C2Y <> -1) Then sStr = sStr + Trim(Str(Abs(C2Y))) sStr = sStr + "y^2"
ElseIf (C2Y > 0) Then
If (Trim(sStr) <> "") Then sStr = sStr + "+"
If (C2Y <> 1) Then sStr = sStr + Trim(Str(C2Y)) sStr = sStr + "y^2"
End If
If (C1Y < 0) Then
sStr = sStr + " - "
If (C1Y <> -1) Then sStr = sStr + Trim(Str(Abs(C1Y))) sStr = sStr + "y"
ElseIf (C1Y > 0) Then
If (Trim(sStr) <> "") Then sStr = sStr + "+"
If (C1Y <> 1) Then sStr = sStr + Trim(Str(C1Y)) sStr = sStr + "y"
End If
If (C0 < 0) Then sStr = sStr + " - "
If (C0 <> -1) Then sStr = sStr + Trim(Str(Abs(C0))) ElseIf (C0 > 0) Then
If (Trim(sStr) <> "") Then sStr = sStr + "+"
If (C0 <> 1) Then sStr = sStr + Trim(Str(C0)) End If
If Trim(sStr) = "" Then sStr = "0"
RefreshHMT = sStr End Function
Đoạn code sau đây thể hiện Hàm nhập Điều kiện
Function RefreshDK(a, b, c As Double) As String // NhËp ®iÒu kiện a,b,c
Dim sStr As String sStr = ""
If (a < 0) Then
sStr = sStr + " - "
If (a <> -1) Then sStr = sStr + Trim(Str(Abs(a))) sStr = sStr + "x"
ElseIf (a > 0) Then
If (a <> 1) Then sStr = sStr + Trim(Str(a))
sStr = sStr + "x"
End If
If (b < 0) Then sStr = sStr + " - "
If (b <> -1) Then sStr = sStr + Trim(Str(Abs(b))) sStr = sStr + "y"
ElseIf (b > 0) Then
If (Trim(sStr) <> "") Then sStr = sStr + "+"
If (b <> 1) Then sStr = sStr + Trim(Str(b)) sStr = sStr + "y"
End If
If (Trim(sStr) = "") Then sStr = "0"
sStr = sStr + " <= "
If (c < 0) Then sStr = sStr + " - "
sStr = sStr + Trim(Str(Abs(c))) Else
sStr = sStr + Trim(Str(c)) End If
sStr = "(" + sStr + ")"
RefreshDK = sStr End Function
Đoạn code sau đây thể hiện Hàm Kiểm tra phơng án Function KiemTraPA(x, y As Double) As Boolean
Dim kt As Boolean kt = True
If (x < 0) Then kt = False If (y < 0) Then kt = False
If (a1 * x + b1 * y > c1) Then kt = False
If (a2 * x + b2 * y > c2) Then kt = False If (a3 * x + b3 * y > c3) Then kt = False If (a4 * x + b4 * y > c4) Then kt = False If (a5 * x + b5 * y > c5) Then kt = False KiemTraPA = kt
End Function
Đoạn code sau đây thể hiện Hàm tính hàm mục tiêu Function TinhHam(x, y As Double) As Double
TinhHam = C0 + C1X * x + C2X * x * x + C3X * x * x * x + C1Y * y + C2Y * y * y + C3Y * y * y * y
End Function
Đoạn code thể hiện Hàm Done // Hàm thực hiện chương trình Private Sub cmdThucHien_Click()
Call MonterCarlo End Sub
Đoạn code sau đây thể hiện Hàm SaveFile // Hàm Lu tập File
Private Sub cmdSaveFile_Click() On Error GoTo Loi
With dlgFile
.Filter = "All file (*.qhl)|*.qhl"
.DialogTitle = "Nhập tệp để lu dữ liệu bài toán..."
.ShowSave End With
Open dlgFile.FileName For Output As #1
Print #1, Str(C3X) + " " + Str(C2X) + " " + Str(C1X) Print #1, Str(C3Y) + " " + Str(C2Y) + " " + Str(C1Y) Print #1, Str(C0)
Print #1, Str(a1) + " " + Str(b1) + " " + Str(c1)
Print #1, Str(a2) + " " + Str(b2) + " " + Str(c2) Print #1, Str(a3) + " " + Str(b3) + " " + Str(c3) Print #1, Str(a4) + " " + Str(b4) + " " + Str(c4) Print #1, Str(a5) + " " + Str(b5) + " " + Str(c5) Close #1
Loi:
End Sub
Đoạn code sau đây thể hiện Hàm LoadFile // Hàm chọn tệp để lấy dữ liệu
Private Sub cmdLoadFile_Click() On Error GoTo Loi
With dlgFile
.Filter = "All file (*.qhl)|*.qhl"
.DialogTitle = "Chọn tệp để lấy dữ liệu bài toán..."
.ShowOpen End With
'Mo tep de doc du lieu
Open dlgFile.FileName For Input As #2 Input #2, C3X, C2X, C1X
Me.txtC3X.Text = C3X Me.txtC2X.Text = C2X Me.txtC1X.Text = C1X Input #2, C3Y, C2Y, C1Y Me.txtC3Y.Text = C3Y Me.txtC2Y.Text = C2Y Me.txtC1Y.Text = C1Y Input #2, C0
Me.txtC0.Text = C0 Input #2, a1, b1, c1
Me.txta1.Text = a1 Me.txtb1.Text = b1 Me.txtc1.Text = c1 Input #2, a2, b2, c2 Me.txta2.Text = a2 Me.txtb2.Text = b2 Me.txtc2.Text = c2 Input #2, a3, b3, c3 Me.txta3.Text = a3 Me.txtb3.Text = b3 Me.txtc3.Text = c3 Input #2, a4, b4, c4 Me.txta4.Text = a4 Me.txtb4.Text = b4 Me.txtc4.Text = c4 Input #2, a5, b5, c5 Me.txta5.Text = a5 Me.txtb5.Text = b5 Me.txtc5.Text = c5 Close #2
Loi:
End Sub
Đoạn code khi thoát chơng trình thì nhấp chuột vào nút Close // Khi muốn thoát chơng trình
Private Sub cmdClose_Click() End
End Sub
Đoạn code thể hiện khi muốn Refresh lại // Hàm làm sạch dữ liệu bài toán
Private Sub cmdRefresh_Click() Call RefreshTexts(Me)
End Sub
Đoạn code thể hiện Hàm nhập điều kiện khác Private Sub txtax_Change() // Hàm nhập ax On Error GoTo Thoat
ax = Val(Me.txtax.Text) Thoat:
End Sub
Private Sub txtbx_Change() // Hàm nhập bx On Error GoTo Thoat
bx = Val(Me.txtbx.Text) Thoat:
End Sub
Private Sub txtay_Change() // Hàm nhập ay On Error GoTo Thoat
ay = Val(Me.txtay.Text) Thoat:
End Sub
Private Sub txtby_Change()//Hàm nhập by On Error GoTo Thoat
by = Val(Me.txtby.Text) Thoat:
End Sub
Private Sub txtx0_Change()// Hàm nhập x0 On Error GoTo Thoat
x(0) = Val(Me.txtx0.Text) Thoat:
End Sub
Private Sub txty0_Change()// Hàm nhập y0 On Error GoTo Thoat
y(0) = Val(Me.txty0.Text) Thoat:
End Sub
Form 2. Đoạn code sau đây thể hiện Thuật toán Monte Carlo theo toạ độ
Private Sub MonterCarlo()
Dim C0, C1X, C2X, C3X, C1Y, C2Y, C3Y As Double Dim a1, b1, c1 As Double
Dim a2, b2, c2 As Double Dim a3, b3, c3 As Double Dim a4, b4, c4 As Double Dim a5, b5, c5 As Double
Dim ax, bx, ay, by, a, b, c As Double Dim x(100) As Double
Dim y(100) As Double Dim x0, y0 As Double Dim n As Long
Dim i, j As Long
Dim e, f As Double Dim sStr As String
SoLanChon = 1000000 Me.lstKetQua.Clear i = 0
j = 0
Do While (i < n) j = j + 1
f = TinhHam(x(i), y(i))
Randomize // Hàm tạo cấp số ngẫu nhiên e = Int((100000 * Rnd) + 1) / 100000 x(i + 1) = ax + e * (bx - ax)
Randomize
e = Int((100000 * Rnd) + 1) / 100000 y(i + 1) = ay + e * (by - ay)
If (KiemTraPA(x(i + 1), y(i + 1))) Then If f > TinhHam(x(i + 1), y(i + 1)) Then
If (Len(Trim(Str(i))) = 1) Then
sStr = Trim(Str(i)) + ". x = " + Trim(Format(x(i),
"##0.####0")) + ", y = " + Trim(Format(y(i), "##0.####0")) + ", f (x,y) = " + Trim(Format(TinhHam(x(i), y(i)),
"###,##0.####0")) Else
sStr = Trim(Str(i)) + ". x = " + Trim(Format(x(i),
"##0.####0")) + ", y = " + Trim(Format(y(i), "##0.####0")) + ", f (x,y) = " + Trim(Format(TinhHam(x(i), y(i)),
"###,##0.####0")) End If
Me.lstKetQua.AddItem (sStr) i = i + 1
End If End If
If j >= SoLanChon Then
MsgBox "Không tìm đợc nghiệm"
Me.lbKetQua.Caption = "Không có nghiệm!"
Me.txtSoLanChon.Text = Str(j) GoTo Thoat
End If
Loop
Me.txtSoLanChon.Text = Str(j)
sStr = "x = " + Trim(Format(x(i), "##0.####0")) + ", y = "
+ Trim(Format(y(i), "##0.####0")) + ", f (x,y) = " + Trim(Format(TinhHam(x(i), y(i)), "###,##0.####0")) If Len(Trim(Str(i))) = 1 Then
Me.lstKetQua.AddItem (Trim(Str(i)) + ". " + sStr) Else
Me.lstKetQua.AddItem (Trim(Str(i)) + ". " + sStr) End If
Me.lbKetQua.Caption = sStr Thoat:
End Sub
Chú ý. Cách tìm giá trị x0, y0, giá trị cận trên và cận dới của x, cận trên và cận dới của y nh sau:
* Dựa vào điều kiện đã cho của bài toán, dùng phơng pháp
đồ thị chúng ta
sẽ tìm đợc tập phơng án của bài toán là một đa giác lồi. Sau
đó ta tìm đợc một hình chữ nhật bao quanh tập phơng án, các đỉnh của tập phơng án nằm trên các cạnh hình chữ nhật.
Từ hình chữ nhật đó ta xác định đợc cận dới, cận trên của x;
cận dới, cận trên của y.
* Tìm giá trị x0, y0:
+ Nếu lấy x0, y0 ngoài tập phơng án thì phải quay lại bớc 0 theo nh thuật toán theo toạ độ đã trình bày ở trên (ch-
ơng 1).
+ Lấy x0, y0 là một trong các đỉnh của hình chữ
nhật. Hoặc là một điểm bất kỳ trong tập phơng án, kiểm tra xem bộ giá trị (x0, y0)có thuộc tập phơng án không, nếu có thì
số phơng án tìm đợc tăng lên 1, khi đó xét hàm mục tiêu f(x,y), nếu f(x1,y1) < f(x0 , y0) nghiệm sau luôn tốt hơn nghiệm trớc, lặp lại quá trình nh trên đến khi nghiệm của bài toán có thể chấp nhận đợc là dừng.
Ví dụ. Giải bài toán quy hoạch lồi sau đây bằng thuật toán Monte Carlo theo tọa độ Min {f = x2 – 5x – 2y + 100}
Với điều kiện
≥
≤ +
≤ +
−
≤
−
. 0 ,
5 2 2
2 2
y x
y x
y x
y x
Giải. Từ điều kiện bài toán đã cho, ta xác định tập ph-
ơng án là 1 đa giác OABCD, từ đó ta xây dựng đợc hình chữ nhật (màu đỏ) bao quanh tập phơng án.
Toạ độ điểm O(0,0); A(0,2); B(1,4); C(4,1); D(2,0) Tọa độ ban đầu (x0, y0) = (4,1)
CËn díi x = 0 Cận trên x = 4
CËn díi y = 0 5 Cận trên y = 4 4 B
Sau 550637 lần chọn số ngẫu nhiên ta tìm đợc
bộ giá trị x=(x0,x1,…,x7) A Từ x0= 4, y0=1 ta tìm đợc f(x0,y0) = 94 C
Từ x1=1,73992, y1= 0,68796 ta tìm đợc O 2 D 4
f(x1, y1) = 92,95180 < f(x0, y0) = 94. Từ đó suy ra
(x1, y1) tốt hơn (x0, y0), gán (x0, y0) := (x1,y1);
gán f(x0, y0) := f(x1, y1), rồi trở lại bớc 1 (theo thuật toán)
Tiếp tục làm nh trên ta tìm đợc nghiệm xấp xỉ là (x7, y7) = (1,5; 3,5) và f(x7, y7) = 87,7577.
Giá trị hàm mục tiêu fmin = 87,75.
Nếu sồ lần thử mà lớn hơn số lần chọn = 1000000 thì không tìm đợc nghiệm bài toán.