Код программы

Форма 1:

Option Strict On

Option Explicit On

Imports System.Math

Public Class Form1

Sub vvod(ByRef a As Single, ByRef b As Single, ByRef c As Single, ByRef d As Single, ByRef h As Single, ByRef m As Single, ByRef n As Single, ByRef Eps As Single, ByRef t As Single) 'Процедура ввода исходных данных

a = CSng(TextBox1.Text): b = CSng(TextBox2.Text)

c = CSng(TextBox3.Text): d = CSng(TextBox4.Text)

h = CSng(TextBox5.Text): m = CSng(TextBox6.Text)

n = CSng(TextBox7.Text): Eps = CSng(TextBox8.Text)

t = CSng(TextBox9.Text)

End Sub

Sub vivod(ByVal z As Single, ByRef T As TextBox) 'Вывод в ТекстБокс числа типа Single

T.Text = CStr(z)

End Sub

Function P(ByVal x As Single) As Single 'Искомая функция, на которой требуется найти минимум

P = CSng(2 * x ^ 2 - Exp(x))

End Function

Sub vivodresultZolSech(ByVal n As Integer, ByVal a As Single, ByVal b As Single, ByVal x1 As Single, ByVal x2 As Single, ByVal F1 As Single, ByVal F2 As Single, ByVal z As Single) 'Процедура для вывода промежуточных результатов одномерной оптимизации

Form2.ListBox1.Items.Add(n)

Form2.ListBox2.Items.Add(Format(a, " 0.00000"))

Form2.ListBox3.Items.Add(Format(b, " 0.00000"))

Form2.ListBox4.Items.Add(Format(x1, " 0.00000"))

Form2.ListBox5.Items.Add(Format(x2, " 0.00000"))

Form2.ListBox6.Items.Add(Format(F1, " 0.00000"))

Form2.ListBox7.Items.Add(Format(F2, " 0.00000"))

Form2.ListBox8.Items.Add(Format(z, " 0.00000"))

End Sub

Sub ZolSech(ByVal a As Single, ByVal b As Single, ByVal Eps As Single, ByRef xt As Single, ByRef ft As Single)

Dim k1, k2, x1, x2, F1, F2 As Single 'k1, k2 - коэффициенты золотого сечения, x1, x2, F1, F2 - абсциссы и значения функции в них соотвественно

Dim n As Integer 'Счетчик итераций

k1 = CSng((3 - Sqrt(5)) / 2): k2 = CSng((Sqrt(5) - 1) / 2)

x1 = a + k1 * (b - a): x2 = a + k2 * (b - a) 'Находим начальные приближения к минимуму

F1 = P(x1): F2 = P(x2) 'Находим значения функции в этих точках

Do Until b - a < Eps 'Выполняем цикл, пока не будет достигнута необходимая нам точность

n = n + 1

If F1 < F2 Then

b = x2: x2 = x1

x1 = a + k1 * (b - a)

F2 = F1: F1 = P(x1)

Else

a = x1: x1 = x2

x2 = a + k2 * (b - a)

F1 = F2: F2 = P(x2)

End If

vivodresultZolSech(n, a, b, x1, x2, F1, F2, b - a)

Loop

xt = (a + b) / 2 'Окончательный результат поиска минимума, берется середина полученного отрезка

ft = P(xt) 'Окончательное значение функции в точке минимума

End Sub

Function f(ByVal x As Single, ByVal y As Single, ByVal k As Single) As Single 'Подынтегральная функция

f = CSng((Sin(x) * y) / ((x ^ 2) * (x + k)) ^ (1 / 3))

End Function

Sub Runge(ByVal a As Single, ByVal b As Single, ByVal Eps As Single, ByRef S As Single, ByVal y As Single, ByVal k As Single) 'Процедура, реализующая точность метода по правилу Рунге. Так как в подынтегральной функции три неизвестных переменных (x, y и k), то ко входным параметрам добавим так же y и k.

Dim h, S1 As Single

Dim n As Integer 'Количество отрезков разбиения

n = 2

h = (b - a) / n 'Шаг интегрирования

S = Simp(a, b, n, h, y, k)

Do

n = 2 * n: h = h / 2 'Увеличиваем количество отрезков разбиения в два раза и дробим шаг интегнрирования

S1 = S

S = Simp(a, b, n, h, y, k)

Loop Until Abs(S - S1) / 15 < Eps 'Выполняем дробление шага до тех пор, пока не будет достигнута необходимая точность

End Sub

Function Simp(ByVal a As Single, ByVal b As Single, ByVal n As Integer, ByVal h As Single, ByVal y As Single, ByVal k As Single) As Single 'Функция, реализующая нахождение определенного интеграла методом Симпсона. Так как в подынтегральной функции три неизвестных переменных (x, y и k), то ко входным параметрам добавим так же y и k

Dim c, S As Single

S = f(a, y, k) + f(b, y, k)

c = 4

For i = 1 To n - 1

S = S + c * f(a + i * h, y, k)

c = 6 - c

Next

Return S * h / 3

End Function

Sub TablZnach(ByVal a As Single, ByVal b As Single, ByVal c As Single, ByVal d As Single, ByVal h As Single, ByVal m As Single, ByVal n As Single, ByVal Eps As Single, ByVal k As Single, ByRef z() As Single, ByRef g() As Single) 'Процедура для получения таблицы значений f(y)

Dim i As Integer = 0 'i - Индекс массива, в котором будет записана таблица значений функции f(y)

Dim S As Single 'Значение определенного интеграла

For y = c To d + h Step h 'Запускаем цикл от левого конца отрезка c до правого конца отрезка d с шагом h

ReDim Preserve z(i): ReDim Preserve g(i) 'Переобъявляем массивы, чтобы их размерности увеличивались с каждым новым кругом цикла на 1

Runge(a, b, Eps, S, y, k) 'Вычисляем с заданной точностью значение определенного интеграла

Form2.ListBox9.Items.Add(Format(y, " 0.00")) 'Выводим значения y и f(y)

Form2.ListBox10.Items.Add(Format(S, " 0.0000000"))

z(i) = S 'Присваиваем очередному элементу массива значение f(y)

g(i) = y 'Присваиваем очередному элементу массива значение y

i = i + 1 'Увеличиваем индекс массива на 1

Next

End Sub

Sub uzlynumer(ByVal t As Single, ByRef g() As Single, ByRef z() As Single) 'Сортировка узлов методом пузырьков, от ближнего к t узла до дальнего

Dim tmp As Single 'Переменная, необходимая для обмена элементов местами

For i = 0 To UBound(g) - 1

For j = i + 1 To UBound(g)

If Abs(g(i) - t) > Abs(g(j) - t) Then

tmp = g(j)

g(j) = g(i)

g(i) = tmp

tmp = z(j)

z(j) = z(i)

z(i) = tmp

End If

Next

Next

End Sub

Function LX(ByVal k As Integer, ByVal g() As Single, ByVal z() As Single, ByVal t As Single) As Single 'Вычисление многочлена Лагранжа k-ого порядка в точке xl

Dim L, l1 As Single

L = 0

For i = 0 To k

l1 = 1

For j = 0 To k

If i < > j Then

l1 = (t - g(j)) / (g(i) - g(j)) * l1 'Вычисление множителей

End If

Next

L = L + l1 * z(i) 'Вычисление слагаемых

Next

LX = L 'Значение полинома в точке xl

End Function

Sub Lagranzh(ByVal t As Single, ByVal g() As Single, ByVal z() As Single, ByVal Eps As Single, ByRef interp As Single) 'Алгоритм интерполяции

Dim k As Integer = 0

Dim L(UBound(g)), tmp, E1 As Single

L(k) = LX(k, g, z, t) 'Вызов функции, которая вычисляет полином Лагранжа и присваивание результата элементу массива L(k)

Do

tmp = L(k)

k = k + 1

interp = LX(k, g, z, t)

Form2.ListBox11.Items.Add(k)

Form2.ListBox12.Items.Add(Format(interp, " 0.00000000"))

L(k) = interp

E1 = Abs(L(k) - tmp) 'Оценка точности вычисления

Loop Until E1 < Eps And k > 1

End Sub

Sub InterpolirovanieUzlov(ByVal c As Single, ByVal d As Single, ByVal h As Single, ByVal g() As Single, ByVal z() As Single, ByVal Eps As Single) 'Процедура, которая проинтерполирует значения узлов для того, чтобы сверить результаты интерполяции и таблицу узлов

Dim interp As Single

For i = c To d + h Step h

uzlynumer(i, g, z)

Lagranzh(i, g, z, Eps, interp)

Form2.ListBox13.Items.Add(Format(i, " 0.00"))

Form2.ListBox14.Items.Add(Format(interp, " 0.0000000"))

Next

Form2.ListBox11.Items.Clear()

Form2.ListBox12.Items.Clear()

End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

End

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

Form2.Show()

Me.Hide()

End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Dim a, b, c, d, h, m, n, Eps, t, k, fk, interp As Single 't - значение абсциссы, для которого нужно произвести интерполяцию; k - абсцисса минимума заданной функции; fk - значение функции в точке k

Dim z(0), g(0) As Single 'Массив z(), в котором будет записана таблица значений функции f(y); g() - массив, в котором будут записаны значения y.

vvod(a, b, c, d, h, m, n, Eps, t)

ZolSech(m, n, Eps, k, fk)

vivod(k, Form2.TextBox1): vivod(fk, Form2.TextBox2)

TablZnach(a, b, c, d, h, m, n, Eps, k, z, g)

InterpolirovanieUzlov(c, d, h, g, z, Eps) 'Процедура, которая проинтерполирует значения узлов для того, чтобы сверить результаты интерполяции и таблицу узлов

uzlynumer(t, g, z)

Lagranzh(t, g, z, 0.01, interp) 'Выполнение интерполирования методом Лагранжа с предварительной перенумерацией узлов и точностью 10^(-2)

vivod(interp, Form2.TextBox4)

Form2.Label14.Text = " t = " + CStr(t)

End Sub

End Class

Форма 2:

Public Class Form2

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Form1.Show()

Me.Hide()

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

End

End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

ListBox1.Items.Clear(): ListBox2.Items.Clear()

ListBox3.Items.Clear(): ListBox4.Items.Clear()

ListBox5.Items.Clear(): ListBox6.Items.Clear()

ListBox7.Items.Clear(): ListBox11.Items.Clear(): ListBox12.Items.Clear()

TextBox1.Text = " ": TextBox2.Text = " ": TextBox4.Text = " "

End Sub

End Class