Разработка обучающей программы
Текст исходной программы
В данном разделе приведен листинг исходной программы для изучения метода оптимизации функции нескольких переменных с использованием симплекс-метода.
Dim Proba As Boolean
Private Sub Pause()
' Создаём цикл, который работает до тех пор,
' пока мы не нажмём кнопку "Далее"
Do
DoEvents
If Proba = True Then
Exit Do
End If
Loop
Proba = False
End Sub
Private Sub cmdNext_Click()
' Остановка цикла
Proba = True
End Sub
Private Sub visib()
cmdRun.Visible = True
cmdRefresh.Visible = False
cmdNext.Visible = False
Proba = True
End Sub
Private Sub cmdRefresh_Click()
lblComment1 = ""
lblComment2 = ""
lblComment3 = ""
txtFunction = ""
txtMM = ""
txtX1 = ""
txtX2 = ""
End Sub
Private Sub cmdRun_Click()
cmdRun.Visible = False
cmdRefresh.Visible = True
cmdNext.Visible = True
Proba = False
'Проверяем на наличие данных
If txtFunction = "" Then
MsgBox "Введите функцию!"
Call visib
Exit Sub
ElseIf txtMM = "" Then
MsgBox "Введите масштабный множитель!"
Call visib
Exit Sub
ElseIf txtX1 = "" Then
MsgBox "Введите X1"
Call visib
Exit Sub
ElseIf txtX2 = "" Then
MsgBox "Введите X2"
Call visib
Exit Sub
End If
'Вводим исходные данные
Dim Otklick As Variant
Dim MM As Variant
Dim X01 As Variant
Dim X02 As Variant
Dim Prirash1 As Variant
Dim Prirash2 As Variant
Dim X11 As Variant
Dim X12 As Variant
Dim X21 As Variant
Dim X22 As Variant
lblComment1 = "Определение приращений p1 и p2"
lblComment2 = "p1 = ((N+1)^0,5 + N - 1) / (N * 2^0,5)) * M; p2 = ((N+1)^0,5 - 1) / (N * 2^0,5)) * M, где N - размерность задачи, M - масштабный множитель."
MM = Val(txtMM.Text)
X01 = Val(txtX1.Text)
X02 = Val(txtX2.Text)
Prirash1 = ((Sqr(3) + 1) / (2 * Sqr(2))) * MM
Prirash2 = ((Sqr(3) - 1) / (2 * Sqr(2))) * MM
lblComment3 = "p1 = ((2+1)^0,5 + 2 - 1) / (2 * 2^0,5)) * " & MM & "= " & Prirash1 & "; p2 = ((2+1)^0,5 - 1) / (2 * 2^0,5)) * " & MM & "= " & Prirash2
Call Pause
lblComment1 = "Вычисляем координаты двух остальных вершин симплекса"
lblComment2 = "Х1,1 = Х0,1 + р2; Х1,2 = Х0,2 + р1; Х2,1 = Х0,1 + р1; Х2,2 = Х0,2 + р2"
X11 = X01 + Prirash2
X12 = X01 + Prirash1
X21 = X01 + Prirash1
X22 = X01 + Prirash2
lblComment3 = "X1,1 = " & X01 & " + " & Prirash2 & " = " & X11 & "; X1,2 = " & X02 & " + " & Prirash1 & " = " & X12 & "; X2,1 = " & X01 & " + " & Prirash1 & " = " & X21 & "; x2,2 = " & X02 & " + " & Prirash2 & " = " & X22
Call Pause
lblComment1 = "Вычисляем значения функции в каждой из вершин симплекса"
'создаём лист XL
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
' Make Excel visible through the Application object.
ExcelSheet.Application.Visible = False
' Place some text in the first cell of the sheet.
'заносим начальные значения и считаем их в ХL-e
ExcelSheet.Application.range("X1").Value = X01
ExcelSheet.Application.range("X2").Value = X02
ExcelSheet.Application.range("A3").Value = "=" & txtFunction
Dim ZnachFunctionX0 As Variant
ZnachFunctionX0 = ExcelSheet.Application.range("A3").Value
ExcelSheet.Application.range("X1").Value = X11
ExcelSheet.Application.range("X2").Value = X12
Dim ZnachFunctionX1 As Variant
ZnachFunctionX1 = ExcelSheet.Application.range("A3").Value
ExcelSheet.Application.range("X1").Value = X21
ExcelSheet.Application.range("X2").Value = X22
Dim ZnachFunctionX2 As Variant
ZnachFunctionX2 = ExcelSheet.Application.range("A3").Value
lblComment2 = "f(X0,1; X0,2) = f(" & X01 & "; " & X02 & ") = " & ZnachFunctionX0 & "; f(X1,1; X1,2)=f(" & X11 & "; " & X12 & ") = " & ZnachFunctionX1 & "; f(X2,1; X2,2)=f(" & X21 & "; " & X22 & ") = " & ZnachFunctionX2
lblComment3 = ""
Call Pause
lblComment1 = "Отражение точки"
Dim X31 As Variant
Dim X32 As Variant
Dim ZnachFunctionX3 As Variant
Dim i As Integer
i = 3
Dim j As Integer
j = 0
Dim k As Integer
k = 1
Dim z As Integer
z = 2
Dim X01Copy As Variant
Dim X02Copy As Variant
Dim X11Copy As Variant
Dim X12Copy As Variant
Dim X21Copy As Variant
Dim X22Copy As Variant
Do
If ZnachFunctionX0 > ZnachFunctionX1 And ZnachFunctionX0 > ZnachFunctionX2 Then
If i = j + 1 Then
lblComment1 = "Остановка поиска"
lblComment2 = "f(X" & j & ",1; Х" & j & ",2)>f(X" & k & ",1; Х" & k & ",2) и f(X" & j & ",1; Х" & j & ",2)>f(X" & z & ",1; Х" & z & ",2);" & ZnachFunctionX0 & ">" & ZnachFunctionX1 & " и " & ZnachFunctionX0 & " > " & ZnachFunctionX2 & ", следовательно необходимо отразить точку с коодинатами (Х" & j & ",1; Х" & j & ",2), (" & X01 & "; " & X02 & ") относительно центра тяжести двух остальных вершин симплекса"
X01Copy = X01
X02Copy = X02
X01 = X11 + X21 - X01
X02 = X12 + X22 - X02
lblComment3 = "Х" & i & "1 = Х" & k & "1 + Х" & z & "1 - Х" & j & "1 = " & X11 & " + " & X21 & " - " & X01Copy & " = " & X01 & ";Х" & i & "2 = Х" & k & "2 + Х" & z & "2 - Х" & j & "2 = " & X12 & " + " & X22 & " - " & X02Copy & " = " & X02 & ". Поиск останавливается, т. к. эта вершина симплекса встречалась на предыдущей итерации."
Call Pause
ExcelSheet.Application.range("X1").Value = X01
ExcelSheet.Application.range("X2").Value = X02
ZnachFunctionX0 = ExcelSheet.Application.range("A3").Value
lblComment2 = "Оптимум находится внутри симплекса с вершинами (Х" & j & "1, X" & j & "2); (Х" & k & "1), X" & k & "2); (X" & z & "1, X" & z & "2); (" & X01 & "; " & X02 & "); (" & X11 & "; " & X12 & "); (" & X21 & "; " & X22 & ")."
lblComment3 = "f(Х" & j & "1, X" & j & "2) = " & ZnachFunctionX0 & "; f(Х" & k & "1, X" & k & "2) = " & ZnachFunctionX1 & "; f(X" & z & "1, X" & z & "2) =" & ZnachFunctionX2 & "."
Exit Do
End If
lblComment2 = "f(X" & j & ",1; Х" & j & ",2)>f(X" & k & ",1; Х" & k & ",2) и f(X" & j & ",1; Х" & j & ",2)>f(X" & z & ",1; Х" & z & ",2);" & ZnachFunctionX0 & ">" & ZnachFunctionX1 & " и " & ZnachFunctionX0 & " > " & ZnachFunctionX2 & ", следовательно необходимо отразить точку с коодинатами (Х" & j & ",1; Х" & j & ",2), (" & X01 & "; " & X02 & ") относительно центра тяжести двух остальных вершин симплекса"
X01Copy = X01
X02Copy = X02
X01 = X11 + X21 - X01
X02 = X12 + X22 - X02
lblComment3 = "Х" & i & "1 = Х" & k & "1 + Х" & z & "1 - Х" & j & "1 = " & X11 & " + " & X21 & " - " & X01Copy & " = " & X01 & ";Х" & i & "2 = Х" & k & "2 + Х" & z & "2 - Х" & j & "2 = " & X12 & " + " & X22 & " - " & X02Copy & " = " & X02
ExcelSheet.Application.range("X1").Value = X01
ExcelSheet.Application.range("X2").Value = X02
ZnachFunctionX0 = ExcelSheet.Application.range("A3").Value
j = i
GoTo 10
ElseIf ZnachFunctionX1 > ZnachFunctionX0 And ZnachFunctionX1 > ZnachFunctionX2 Then
If i = k + 1 Then
lblComment1 = "Остановка поиска"
lblComment2 = "f(X" & k & ",1; Х" & k & ",2)>f(X" & j & ",1; Х" & j & ",2) и f(X" & k & ",1; Х" & k & ",2)>f(X" & z & ",1; Х" & z & ",2);" & ZnachFunctionX1 & ">" & ZnachFunctionX0 & " и " & ZnachFunctionX1 & " > " & ZnachFunctionX2 & ", следовательно необходимо отразить точку с коодинатами (Х" & k & ",1; Х" & k & ",2), (" & X11 & "; " & X12 & ") относительно центра тяжести двух остальных вершин симплекса"
X11Copy = X11
X12Copy = X12
X11 = X01 + X21 - X11
X12 = X02 + X22 - X12
lblComment3 = "Х" & i & "1 = Х" & j & "1 + Х" & z & "1 - Х" & k & "1 = " & X01 & " + " & X21 & " - " & X11Copy & " = " & X11 & ";Х" & i & "2 = Х" & j & "2 + Х" & z & "2 - Х" & k & "2 = " & X02 & " + " & X22 & " - " & X12Copy & " = " & X12 & ". Поиск останавливается, т. к. эта вершина симплекса встречалась на предыдущей итерации."
Call Pause
ExcelSheet.Application.range("X1").Value = X11
ExcelSheet.Application.range("X2").Value = X12
ZnachFunctionX1 = ExcelSheet.Application.range("A3").Value
lblComment2 = "Оптимум находится внутри симплекса с вершинами (Х" & j & "1, X" & j & "2); (Х" & k & "1), X" & k & "2); (X" & z & "1, X" & z & "2); (" & X01 & "; " & X02 & "); (" & X11 & "; " & X12 & "); (" & X21 & "; " & X22 & ")."
lblComment3 = "f(Х" & j & "1, X" & j & "2) = " & ZnachFunctionX0 & "; f(Х" & k & "1, X" & k & "2) = " & ZnachFunctionX1 & "; f(X" & z & "1, X" & z & "2) =" & ZnachFunctionX2 & "."
Exit Do
End If
lblComment2 = "f(X" & k & ",1; Х" & k & ",2)>f(X" & j & ",1; Х" & j & ",2) и f(X" & k & ",1; Х" & k & ",2)>f(X" & z & ",1; Х" & z & ",2);" & ZnachFunctionX1 & ">" & ZnachFunctionX0 & " и " & ZnachFunctionX1 & " > " & ZnachFunctionX2 & ", следовательно необходимо отразить точку с коодинатами (Х" & k & ",1; Х" & k & ",2), (" & X11 & "; " & X12 & ") относительно центра тяжести двух остальных вершин симплекса"
X11Copy = X11
X12Copy = X12
X11 = X01 + X21 - X11
X12 = X02 + X22 - X12
lblComment3 = "Х" & i & "1 = Х" & j & "1 + Х" & z & "1 - Х" & k & "1 = " & X01 & " + " & X21 & " - " & X11 & " = " & X11 & ";Х" & i & "2 = Х" & j & "2 + Х" & z & "2 - Х" & k & "2 = " & X02 & " + " & X22 & " - " & X12 & " = " & X12
ExcelSheet.Application.range("X1").Value = X11
ExcelSheet.Application.range("X2").Value = X12
ZnachFunctionX1 = ExcelSheet.Application.range("A3").Value
If i = k + 1 Then
Exit Do
End If
k = i
GoTo 10
ElseIf ZnachFunctionX2 > ZnachFunctionX0 And ZnachFunctionX2 > ZnachFunctionX1 Then
If i = z + 1 Then
lblComment1 = "Остановка поиска"
lblComment2 = "f(X" & z & ",1; Х" & z & ",2)>f(X" & k & ",1; Х" & k & ",2) и f(X" & z & ",1; Х" & z & ",2)>f(X" & j & ",1; Х" & j & ",2);" & ZnachFunctionX2 & ">" & ZnachFunctionX1 & " и " & ZnachFunctionX2 & " > " & ZnachFunctionX0 & ", следовательно необходимо отразить точку с коодинатами (Х" & z & ",1; Х" & z & ",2), (" & X21 & "; " & X22 & ") относительно центра тяжести двух остальных вершин симплекса"
X21Copy = X21
X22Copy = X22
X21 = X11 + X01 - X21
X22 = X12 + X02 - X22
lblComment3 = "Х" & i & "1 = Х" & k & "1 + Х" & j & "1 - Х" & z & "1 = " & X11 & " + " & X01 & " - " & X21Copy & " = " & X21 & ";Х" & i & "2 = Х" & k & "2 + Х" & j & "2 - Х" & z & "2 = " & X12 & " + " & X02 & " - " & X22Copy & " = " & X22 & ". Поиск останавливается, т. к. эта вершина симплекса встречалась на предыдущей итерации."
Call Pause
ExcelSheet.Application.range("X1").Value = X21
ExcelSheet.Application.range("X2").Value = X22
ZnachFunctionX2 = ExcelSheet.Application.range("A3").Value
lblComment2 = "Оптимум находится внутри симплекса с вершинами (Х" & j & "1, X" & j & "2); (Х" & k & "1, X" & k & "2); (X" & z & "1, X" & z & "2); (" & X01 & "; " & X02 & "); (" & X11 & "; " & X12 & "); (" & X21 & "; " & X22 & ")."
lblComment3 = "f(Х" & j & "1, X" & j & "2) = " & ZnachFunctionX0 & "; f(Х" & k & "1, X" & k & "2) = " & ZnachFunctionX1 & "; f(X" & z & "1, X" & z & "2) =" & ZnachFunctionX2 & "."
Exit Do
End If
lblComment2 = "f(X" & z & ",1; Х" & z & ",2)>f(X" & j & ",1; Х" & j & ",2) и f(X" & z & ",1; Х" & z & ",2)>f(X" & k & ",1; Х" & k & ",2);" & ZnachFunctionX2 & ">" & ZnachFunctionX0 & " и " & ZnachFunctionX2 & " > " & ZnachFunctionX1 & ", следовательно необходимо отразить точку с коодинатами (Х" & z & ",1; Х" & z & ",2), (" & X21 & "; " & X22 & ") относительно центра тяжести двух остальных вершин симплекса"
X21Copy = X21
X22Copy = X22
X21 = X01 + X11 - X21
X22 = X02 + X12 - X22
lblComment3 = "Х" & i & "1 = Х" & j & "1 + Х" & k & "1 - Х" & z & "1 = " & X01 & " + " & X11 & " - " & X21 & " = " & X21 & ";Х" & i & "2 = Х" & j & "2 + Х" & k & "2 - Х" & z & "2 = " & X02 & " + " & X12 & " - " & X22 & " = " & X22
ExcelSheet.Application.range("X1").Value = X21
ExcelSheet.Application.range("X2").Value = X22
ZnachFunctionX2 = ExcelSheet.Application.range("A3").Value
z = i
10 End If
i = i + 1
Call Pause
Loop
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Command3_Click()
MsgBox "Вводить следует унимадальную функцию аналогично вводу формул в ячейки MS Exel."
End Sub
Private Sub Command4_Click()
MsgBox "Конечный результат вычислений."
End Sub
Private Sub Command5_Click()
MsgBox "Начльная точка (Х0) выбирается интуитивно."
End Sub
Private Sub Command6_Click()
MsgBox "Начальная точка выбирается интуитивно"
End Sub
Private Sub Command7_Click()
MsgBox "Величина масштабного множителя выбирается исследователем, исходя из характеристик решаемой задачи"
End Sub