Лабораторная работа № 5.
Вариант № 13.
Решение систем линейных алгебраических уравнений.
Метод Гаусса- Жордана. Метод простой итерации.
Задание:
-
Вручную решить систему линейных алгебраических уравнений методом Гаусса-Жордана с выбором главного элемента.
-
По блок-схеме составить программу на VBA решения системы линейных алгебраических уравнений методом Гаусса-Жордана с выбором главного элемента.
-
Произвести вычисления на ЭВМ в соответствии с вариантом задания.
-
Проверить правильность полученного решения путем подстановки найденных значений неизвестных в одно из уравнений системы.
-
Вручную решить систему линейных алгебраических уравнений итерационным методом с точностью 0.01 по методу итераций. Предварительно привести систему к виду, удобному для итераций (вид, в котором элементы главной диагонали по модулю превосходят сумму модулей недиагональных элементов строк).
-
Составить программу на VBA решения системы линейных алгебраических уравнений итерационным методом с точностью 0.001методом простой итерации. Предварительно привести систему к виду, удобному для итераций.
-
Произвести вычисления на ЭВМ в соответствии с вариантом задания. Полученные значения представить в виде графика: ось категорий – номер итерации; ось значений – значения переменных (вектор решений) на каждой итерации.
Ход работы:
1 задание : 8x1-3x2+2x3=14
2x1+7x2-3x3=45
x1-2x2+5x3=-19
2 задание:
Исходная система: Полученная система:
3.8x1+6.7x2-1.2x3=5.2 6.4x1+1.3x2-2.7x3= 3.8
6.4x1+1.3x2-2.7x3=3.8 3.8x1-6.7x2-1.2x3= 5.2
2.4x1-4.5x2-3.5x3=-0.6 -4.6x1+8.1x2 -14.4x3= 0.4
Программный код для чтения файла:
Const n = 3
Dim a(1 To n, 1 To n + 1) As Single, B(1 To n) As Single
Private Sub CommandButton1_Click()
Dim FName As Variant
FName = Application.GetOpenFilename("Текстовый документ(*.txt),*.txt")
If FName = False Then
MsgBox "файл не выбран"
Exit Sub
End If
Open FName For Input As #1
i = 1
Do
j = 1
Do
Input #1, a(i, j)
j = j + 1
Loop Until j > n + 1
i = i + 1
Loop Until i > n
Close #1
'вывод матрицы коэффициентов
With ListBox1
.List = a
End With
End Sub
Private Sub CommandButton2_Click()
Dim a1(1 To n, 1 To n + 1) As Single
Dim x(1 To n) As Single
Dim g(0 To n) As Byte
Dim st As String
k = 0
For S = 1 To n
m = 0
For i = 1 To n
For c = 1 To n
If i = g(c) Then GoTo 1
Next c
For j = 1 To n
If Abs(a(i, j)) > m Then
m = Abs(a(i, j))
k1 = i
k2 = j
End If
Next j
1: Next i
k = k + 1
g(k) = k1
For j = 1 To n + 1
a1(k1, j) = a(k1, j) / a(k1, k2)
Next j
For i = 1 To n
If i <> k1 Then
For j = 1 To n + 1
a1(i, j) = a(i, j) - a1(k1, j) * a(i, k2)
Next j
End If
Next i
For i = 1 To n
For j = 1 To n + 1
a(i, j) = a1(i, j)
a1(i, j) = 0
Next j
Next i
Next S
For i = 1 To n
For j = 1 To n
If a(i, j) = 1 Then
i1 = j
x(i1) = a(i, m)
st = st + "x(" + CStr(i1) + ")=" + CStr(x(i1)) + " "
End If
Next j
Next i
TextBox1.Text = st
End Sub
Private Sub CommandButton3_Click()
Dim FName As Variant
FName = Application.GetOpenFilename("Текстовый документ(*.txt),*.txt")
If FName = False Then
MsgBox "файл не выбран"
Exit Sub
End If
Open FName For Input As #1
i = 1
Do
j = 1
Do
Input #1, a(i, j)
j = j + 1
Loop Until j > n + 1
i = i + 1
Loop Until i > n
Close #1
'вывод матрицы коэффициентов
With ListBox2
.List = a
End With
End Sub
Private Sub CommandButton4_Click()
Dim y(1 To n) As Single
Dim x(1 To n) As Single
For i = 1 To n
B(i) = a(i, n + 1)
Next i
For i = 1 To n
S = 0
For j = 1 To n
If i <> j Then
S = S + Abs(a(i, j))
End If
Next j
If Abs(a(i, i)) < S Then
MsgBox "Не сходится"
Exit Sub
End If
Next i
For i = 1 To n
y(i) = B(i)
Next i
1: For i = 1 To n
x(i) = B(i)
For j = 1 To n
If i <> j Then
x(i) = x(i) - (a(i, j) * y(j))
End If
Next j
x(i) = x(i) / (a(i, i))
Next i
For i = 1 To n
If Abs(x(i) - y(i)) > eps Then
For k = 1 To n
y(k) = x(k)
Next k
GoTo 1
End If
Next i
For i = 1 To n
st = st + "x(" + CStr(i) + ")=" + CStr(x(i)) + " "
Next i
TextBox2.Text = st
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.ColumnCount = 4
.ColumnWidths = "30;30;30;30"
End With
With ListBox2
.ColumnCount = 4
.ColumnWidths = "30;30;30;30"
End With
End Sub
Лабораторная работа № 4.
Вариант № 13.
Решение нелинейного уравнения.
Задания:
-
Отделить корни нелинейного уравнения, выполнив табулирование функции y=f(x) на отрезке [a, b] с шагом H=1.
-
Вручную уточнить наибольший корень (если корней несколько): а) методом половинного деления с точностью 0,1; б) методом касательных с точностью 0,01.
-
Составить программу решения нелинейного уравнения на отрезке [a,b] с использованием метода сканирования для отделения корней с шагом H=1 и методов уточнения корней: половинного деления и касательных с точностью ɛ=0.0001.
Результаты уточнения корня методом половинного деления представить в виде таблицы:
|
a |
b |
x=(a+b)/2 |
F(a) |
F(b) |
F(x) |
|b-a| |
|
|
|
|
|
|
|
|
-
Для ввода исходных данных и результатов расчета использовать элементы управления.
-
Процедуры уточнения корней оформить в виде отдельных подпрограмм.
Ход работы:
Код программы:
Function f(x)
f = 3 ^ x - 2 * x - 5
End Function
Sub Pol_Del(ByVal a, ByVal b, c)
Const eps = 0.0001
Dim x As Single
Dim fa As Single, fs As Single
fa = f(a)
Do While Abs(b - a) > eps
x = (a + b) / 2
fx = f(x)
If f(x) = 0 Then
c = x
Else
If fa * fx < 0 Then
b = x
Else
a = x
fa = fx
End If
End If
Loop
c = (a + b) / 2
End Sub
Sub kasat(ByVal a, ByVal b, c)
Const eps = 0.0001
Const n = 100
Dim y1, y2, y3, w1, w2, x, x1 As Single
y1 = f(a)
y2 = f(b)
w1 = f2(a)
If y1 * w1 < 0 Then
x = b: y3 = y2
Else
x = a: y3 = y1
End If
For i = 1 To n
w2 = f1(x)
x1 = x - y3 / w2
If Abs(x1 - x) > eps Then
y3 = f(x)
Else
c = x
End If
Next i
If c = 0 Then
ListBox1.AddItem "item not found"
End If
End Sub
Function f1(x)
f1 = 3 ^ x * Log(3) - 2
End Function
Function f2(x)
f2 = 3 ^ x * Log(3) * Log(3)
End Function
Private Sub CommandButton1_Click()
Const h = 1 'шaг
Dim a As Single, b As Single, x As Single
Dim fn As Single, fs As Single, c As Single
a = Val(TextBox1.Text)
b = Val(TextBox2.Text)
x = a
fn = f(x)
Do While x < b
x = x + h
fs = f(x)
If fs = 0 Then
ListBox1.AddItem "Корень=" & x
Else
If fn * fs < 0 Then
ListBox1.AddItem "Отрезок[" & x - h & ", " & x & "]"
Call Pol_Del(x - h, x, c)
ListBox1.AddItem "Метод половинного деления"
ListBox1.AddItem "Корень=" & c
Call kasat(x - h, x, c)
ListBox1.AddItem "Метод касательных"
ListBox1.AddItem "Корень=" & c
End If
End If
fn = fs
Loop
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Полученные результаты:
Лабораторная работа № 3.
Вариант № 13.
Расширенный фильтр.
Задание:
Создать на отдельном листе список, содержащий не менее 30 записей в выбранной предметной области. Над созданным списком выполнить следующие действия:
-
Сортировку
-
Поиск информации с помощью автофильтра
-
Поиск информации с помощью расширенного фильтра
-
Подведение итогов
-
Анализ списка с помощью функции
-
Проверку вводимых значений
Таблица 1.
Поставки (Дата поставки, Поставщик, кол-во поставленной продукции, Способ перевозки, транспортные издержки на единицу товара, Стоимость перевозимого товара)
2. Сортировка по 4 и более полям.
Способ перевозки, Поставщик, Дата поставки, Транспортные издержки на единицу товара.
Сортировка в особом порядке – Поставщик.
3. Автофильтр.
Получить информацию о поставках от поставщика Поставщик способом перевозки Способ перевозки после даты Дата.
Критерии отбора:
4. Расширенный фильтр
Найти поставки способом перевозки Способ перевозки1 и Способ перевозки2 от поставщиков Поставщик1, Поставщик 2 и Поставщик3 со стоимостью перевозимого товара от Сумма1 до Сумма2 рублей.
-
Подведение промежуточных итогов.
Определить количество поставленной продукции каждым способом перевозки и среднюю стоимость транспортных расходов.
-
Функции для анализа списка.
Определить среднюю стоимость транспортных расходов для поставщика Поставщик.
Записываем формулу в ячейку H6: =ДСРЗНАЧ(Таблица13[#Все];Таблица13[[#Заголовки];[Транспортные издержки на единицу товара]];H1:H2)
-
Проверка вводимых значений.
Поле: Количество поставленной продукции.
Вид сообщения об ошибке: Останов
