Полный программный код проекта.
'программный код 1 формы
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Form2.Show()
End Sub
End Class
'программный код 2 формы
Public Class Form2
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TextBox3.Text = "1"
TextBox4.Text = "4"
TextBox5.Text = "0.01"
TextBox6.Text = "0"
TextBox7.Text = "6"
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Form1.Show()
Me.Hide()
End Sub
Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
vvod(TextBox3, c)
vvod(TextBox4, ee)
vvod(TextBox5, Eee)
vvod(TextBox6, o1)
vvod(TextBox7, o2)
Form4.Show()
End Sub
End Class
'программный код 3 формы
Public Class Form4
Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click
Form2.Show()
Me.Hide()
End Sub
Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click
Form5.Show()
End Sub
Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
Dim z As String = ""
gold(o1, o2, Eee, a2, k, z)
TextBox8.Text = z
vivod(a2, TextBox9)
vivod(k, TextBox10)
End Sub
End Class
'программный код 4 формы
Public Class Form5
Private Sub Form5_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
vivod(a2, TextBox12)
vivod(k, TextBox11)
End Sub
Private Sub Button11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button11.Click
End
End Sub
Private Sub Button10_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button10.Click
Form4.Show()
Me.Hide()
End Sub
Private Sub Button15_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button15.Click
Form6.Show()
End Sub
End Class
'программный код модуля
Option Strict On
Option Explicit On
Imports System.Math
Module Module1
Public Eee As Double 'точность
Public si1 As Double 'сигма1
Public si2 As Double 'сигма2
Public c As Double 'нижний предел интегрирования
Public ee As Double 'верхний предел интегрирования
Public Xx As Double 'абсцисса пересечения графиков функций
Public o1 As Double 'границы отрезка, содержащего максимум
Public o2 As Double 'границы отрезка, содержащего максимум
Public a2 As Double 'оптимальное значение а
Public k As Double 'максимальное значение функции
'процедура ввода
Sub vvod(ByVal t As TextBox, ByRef x As Double)
x = Val(t.Text)
End Sub
'процедура вывода
Sub vivod(ByVal x As Double, ByVal T As TextBox)
T.Text = CStr(x)
End Sub
'поиск абсциссы точки пересечения графиков функций
Function fu(ByVal x As Double, ByVal a As Double) As Double
Return (2 / ((2 * PI) ^ (1 / 2))) * (E ^ (-2 * ((x - 2) ^ 2)) - E ^ (-2 * ((x - a) ^ 2)))
End Function
'поиск абсциссы точки пересечения графиков функций
Sub reshenieUr(ByVal a As Double, ByRef Xx As Double)
Dim Cc, EEEe, f1, f2, f3 As Double
Dim n As Integer
Cc = c
EEEe = ee
n = 0
Do
n = n + 1
Xx = (Cc + EEEe) / 2
f1 = fu(Cc, a)
f2 = fu(Xx, a)
f3 = fu(EEEe, a)
If (f2 * f3 < 0) Then
Cc = Xx
Else
EEEe = Xx
End If
Loop Until Abs(EEEe - Cc) < Eee
End Sub
'вычисление значения интегралов
Function f1i(ByVal x As Double) As Double
Return (2 / ((2 * PI) ^ (1 / 2))) * (E ^ (-2 * ((x - 2) ^ 2)))
End Function
'вычисление значения интегралов
Function f2i(ByVal x As Double, ByVal a As Double) As Double
Return (2 / ((2 * PI) ^ (1 / 2))) * (E ^ (-2 * ((x - 2.1) ^ 2)))
End Function
'вычисление значения интегралов
Sub reshenie1i(ByVal d As Double, ByRef I1 As Double)
Dim n, i, ccc As Integer
Dim h, s1, c, x As Double
c = 1
n = 2
h = (d - c) / n
I1 = (f1i(c) + 4 * f1i((c + d) / 2) + f1i(d)) * h / 3
Do
n = n * 2
h = (d - c) / n
s1 = I1
ccc = 4
x = c
I1 = f1i(c) + f1i(d)
For i = 1 To n - 1
x = x + h
I1 = I1 + ccc * f1i(x)
ccc = 6 - ccc
Next
I1 = I1 * h / 3
Loop Until Abs(I1 - s1) / 15 < Eee
End Sub
'вычисление значения интегралов
Sub reshenie2i(ByVal d As Double, ByVal a As Double, ByRef I2 As Double)
Dim n, ccc, i As Integer
Dim h, s1, ee, x As Double
ee = 4
n = 2
h = (ee - d) / n
I2 = (f2i(d, a) + 4 * f2i((d + ee) / 2, a) + f2i(ee, a)) * h / 3
Do
n = n * 2
h = (ee - d) / n
s1 = I2
ccc = 4
x = c
I2 = f2i(d, a) + f2i(ee, a)
For i = 1 To n - 1
x = x + h
I2 = I2 + ccc * f2i(x, a)
ccc = 6 - ccc
Next
I2 = I2 * h / 3
Loop Until Abs(I2 - s1) / 15 < Eee
End Sub
'метод золотого сечения на отрезке [o1,o2]
'а2-оптимальное значение параметра
Sub gold(ByVal o1 As Double, ByVal o2 As Double, ByVal Eee As Double, _
ByRef a2 As Double, ByRef k As Double, ByRef z As String)
Dim k1, k2, x1, x2, f1, f2, Xx, d, I1, I2, IS11, IS21, IS12, IS22 As Double
k1 = (3 - Sqrt(5)) / 2
k2 = 1 - k1
x1 = o1 + k1 * (o2 - o1)
x2 = o1 + k2 * (o2 - o1)
reshenieUr(x1, Xx)
d = Xx
reshenie1i(d, I1)
IS11 = I1
reshenie2i(d, x1, I2)
IS21 = I2
f1 = -IS11 - IS21
reshenieUr(x2, Xx)
d = Xx
reshenie1i(d, I1)
IS12 = I1
reshenie2i(d, x2, I2)
IS22 = I2
f2 = IS12 + IS22
z = ""
Do Until (o2 - o1) < Eee
If (-f1) < (-f2) Then
o2 = x2 : x2 = x1
x1 = o1 + k1 * (o2 - o1)
f2 = f1
reshenieUr(x1, Xx)
d = Xx
reshenie1i(d, I1)
IS11 = I1
reshenie2i(d, x1, I2)
IS21 = I2
f1 = IS11 + IS21
Else
o1 = x1 : x1 = x2 : f1 = f2
x2 = o1 + k2 * (o2 - o1)
reshenieUr(x2, Xx)
d = Xx
reshenie1i(d, I1)
IS12 = I1
reshenie2i(d, x2, I2)
IS22 = I2
f2 = IS12 + IS22
End If
z = z + Format(o1, "0.00000") + Space(3) + Format(o2, "0.00000") + Space(3) + Format(x1, "0.00000") + Space(3)
z = z + Format(x2, "0.00000") + Space(5) + Format(f1, "0.00000") + Space(5) + Format(f2, "0.00000") + Space(4) + Format(o2 - o1, "0.00000") + vbNewLine
Loop
a2 = (o1 + o2) / 2
reshenieUr(a2, Xx)
d = Xx
reshenie1i(d, I1)
IS11 = I1
reshenie2i(d, a2, I2)
IS21 = I2
k = IS11 + IS21
End Sub
End Module