Разработка обучающей программы

Текст исходной программы

В данном разделе приведен листинг исходной программы для изучения метода оптимизации функции нескольких переменных с использованием симплекс-метода.

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