DevioLabавтоматичне керування капіталом
ПРАЦЮЄ 24/7
КРИПТОВАЛЮТИ · АКЦІЇ · 10 БІРЖ

Портфель, який керується автоматично

DevioLab підбирає стратегії, відстежує ринки та автоматизує купівлю і продаж активів. Кількість доступних криптовалют, акцій і торгових можливостей зростає щодня.

10підключених біржCrypto + Stocksв одному портфелі24/7автоматичний контроль

Курсова робота: Теорія графів

Інформація про навчальний заклад

ВУЗ:
Національний університет Львівська політехніка
Інститут:
Інститут прикладної математики та фундаментальних наук
Факультет:
Прикладна математика
Кафедра:
Кафедра прикладної математики

Інформація про роботу

Рік:
2008
Тип роботи:
Курсова робота
Предмет:
Теорія графів
Група:
ПМ-32
Коротко про документ

Про що ця робота

У роботі розглядається задача пошуку найкоротшого шляху для заданого графа. Наведено програмну реалізацію мовою Visual Basic для обчислення відстаней та побудови маршруту.

У роботі розглядаються

  • Теорія графів
  • Найкоротший шлях
  • Матриця суміжності
  • Алгоритми на графах
  • Програмування
  • Дискретна математика

Зміст і розділи

  1. Завдання
  2. Код програми
  3. Опис глобальних змінних
  4. Відображення графа
  5. Матриця відстаней
  6. Перенумерація вершин
Для кого:Студенти технічних та математичних спеціальностей, викладачі дискретної математики.
Викладачі:Не вказано

Ключові поняття

графвершинадугаматриця суміжностіматриця відстанейнайкоротший шляхалгоритмпрограмаіндексребро

Частина тексту файла (без зображень, графіків і формул):

Міністерство освіти і науки України Національний Університет „Львівська політехніка” Інститут прикладної математики і фундаментальних наук Кафедра прикладної математики Курсова робота Тема: Теорія графів Львів 2008 Завдання: Знайти найкоротший шлях для графа, заданого списком, де вага кожної дуги l(u) = l(xi, xj) = ((i+j)/2+2) – ціла частина. Код програми: ‘Опис глобальних змінних Dim arrX(0 To 25, 1 To 2), arrY(0 To 25, 1 To 2) As Single Dim MatrSumizh(0 To 25, 0 To 25) As Byte Dim Max As Long Dim MatrVidst(0 To 25, 0 To 25) As Integer Dim Index(0 To 25) As Long Option Explicit Private Sub Command1_Click() ‘Відображення графа Picture1.Scale (-50, 50)-(50, -50) Picture1.DrawWidth = 5 Dim x As Byte For x = 0 To 25 Picture1.PSet (40 * Cos(6.28 / 26 * x), 40 * Sin(6.28 / 26 * x)) arrX(x, 1) = 40 * Cos(6.28 / 26 * x) arrX(x, 2) = 40 * Sin(6.28 / 26 * x) Picture1.CurrentX = 45 * Cos(6.28 / 26 * x) Picture1.CurrentY = 45 * Sin(6.28 / 26 * x) Picture1.Print "X " & x arrY(x, 1) = Picture1.CurrentX arrY(x, 2) = Picture1.CurrentY Next x ‘Відображення шляхів Dim i, j As Byte Picture1.DrawWidth = 1 For i = 0 To 25 For j = 0 To 25 If MatrSumizh(i, j) = 1 Then Picture1.Line (arrX(i, 1), arrX(i, 2))-(arrX(j, 1), arrX(j, 2)) End If Next j Next i End Sub Private Sub Command2_Click() Command2.Enabled = False ‘Перевірка правильності введення вершин Dim vntr If (CByte(Text1.Text) < 0 Or CByte(Text1.Text) > 25 Or CByte(Text2.Text) < 0 Or _ CByte(Text2.Text) > 25 Or CByte(Text1.Text) = CByte(Text2.Text)) Then vntr = MsgBox("Введіть правильно вершини", vbCritical, "Помилка") Exit Sub End If Dim i, j As Byte For i = 0 To 25 For j = 0 To 25 MatrSumizh(i, j) = 0 Next j Next i MatrSumizh(1, 4) = 1: MatrSumizh(4, 1) = 1: MatrSumizh(1, 5) = 1: MatrSumizh(5, 1) = 1 MatrSumizh(2, 13) = 1: MatrSumizh(13, 2) = 1: MatrSumizh(2, 14) = 1: MatrSumizh(14, 2) = 1 MatrSumizh(3, 21) = 1: MatrSumizh(21, 3) = 1: MatrSumizh(3, 25) = 1: MatrSumizh(25, 3) = 1 MatrSumizh(4, 10) = 1: MatrSumizh(10, 4) = 1: MatrSumizh(4, 11) = 1: MatrSumizh(11, 4) = 1 MatrSumizh(4, 12) = 1: MatrSumizh(12, 4) = 1: MatrSumizh(5, 12) = 1: MatrSumizh(12, 5) = 1 MatrSumizh(5, 19) = 1: MatrSumizh(19, 5) = 1: MatrSumizh(5, 20) = 1: MatrSumizh(20, 5) = 1 MatrSumizh(6, 4) = 1: MatrSumizh(4, 6) = 1: MatrSumizh(6, 5) = 1: MatrSumizh(5, 6) = 1 MatrSumizh(7, 13) = 1: MatrSumizh(13, 7) = 1: MatrSumizh(7, 14) = 1: MatrSumizh(14, 7) = 1 MatrSumizh(8, 16) = 1: MatrSumizh(16, 8) = 1: MatrSumizh(8, 18) = 1: MatrSumizh(18, 8) = 1 MatrSumizh(18, 9) = 1: MatrSumizh(9, 18) = 1: MatrSumizh(10, 14) = 1: MatrSumizh(14, 10) = 1 MatrSumizh(11, 16) = 1: MatrSumizh(16, 11) = 1: MatrSumizh(11, 22) = 1: MatrSumizh(22, 11) = 1 MatrSumizh(11, 17) = 1: MatrSumizh(17, 11) = 1: MatrSumizh(11, 18) = 1: MatrSumizh(18, 11) = 1 MatrSumizh(12, 8) = 1: MatrSumizh(8, 12) = 1: MatrSumizh(12, 9) = 1: MatrSumizh(9, 12) = 1 MatrSumizh(9, 13) = 1: MatrSumizh(13, 9) = 1: MatrSumizh(15, 25) = 1: MatrSumizh(25, 15) = 1 MatrSumizh(16, 22) = 1: MatrSumizh(22, 16) = 1: MatrSumizh(23, 17) = 1: MatrSumizh(17, 23) = 1 MatrSumizh(15, 17) = 1: MatrSumizh(17, 15) = 1: MatrSumizh(17, 21) = 1: MatrSumizh(21, 17) = 1 MatrSumizh(18, 23) = 1: MatrSumizh(23, 18) = 1: MatrSumizh(18, 24) = 1: MatrSumizh(24, 18) = 1 MatrSumizh(19, 11) = 1: MatrSumizh(11, 19) = 1: MatrSumizh(19, 17) = 1: MatrSumizh(17, 19) = 1 MatrSumizh(19, 24) = 1: MatrSumizh(24, 19) = 1: MatrSumizh(20, 24) = 1: MatrSumizh(24, 20) = 1 MatrSumizh(20, 21) = 1: MatrSumizh(21, 20) = 1: MatrSumizh(20, 9) = 1: MatrSumizh(9, 20) = 1 MatrSumizh(0, 1) = 1: MatrSumizh(1, 0) = 1: MatrSumizh(0, 11) = 1: MatrSumizh(11, 0) = 1 MatrSumizh(0, 13) = 1: MatrSumizh(13, 0) = 1: MatrSumizh(0, 20) = 1: MatrSumizh(20, 0) = 1 ‘Матриця відстаней For i = 0 To 25 For j = 0 To 25 If MatrSumizh(i, j) = 1 Then MatrVidst(i, j) = Int((i + j) / 2 + 2) End If Max = Max + MatrVidst(i, j) Next j Next i ‘Масив індексів For i = 0 To 25 If i = CByte(Text1.Text) Then Index(i) = 0 Else: Index(i) = Max End If Next i 'Перенумерація вершин Dim Trudyaga(0 To 25) As Integer Dim n, m As Byte n = CByte(Text1.Text) m = CByte(Text2.Text) ‘Заміна n-ого стовпчика на перший For i = 0 To 25 Trudyaga(i) = MatrSumizh(i, 0) MatrSumizh(i, 0) = MatrSumizh(i, n) MatrSumizh(i, n) = Trudyaga(i) Next i ‘Заміна n-ого рядка на перший For i = 0 To 25 Trudyaga(i) = MatrSumizh(0, i) MatrSumizh(0, i) = MatrSumizh(n, i) MatrSumizh(n, i) = Trudyaga(i) Next i ‘Заміна m-ого стовпчик на останній For i = 0 To 25 Trudyaga(i) = MatrSumizh(i, 25) MatrSumizh(i, 25) = MatrSumizh(i, m) MatrSumizh(i, m) = Trudyaga(i) Next i ‘Заміна m-ого рядка на останній For i = 0 To 25 Trudyaga(i) = MatrSumizh(25, i) MatrSumizh(25, i) = MatrSumizh(m, i) MatrSumizh(m, i) = Trudyaga(i) Next i ‘Заміна n-ого стовпчика на перший For i = 0 To 25 Trudyaga(i) = MatrVidst(i, 0) MatrVidst(i, 0) = MatrVidst(i, n) MatrVidst(i, n) = Trudyaga(i) Next i ‘Заміна n-ого рядка на перший For i = 0 To 25 Trudyaga(i) = MatrVidst(0, i) MatrVidst(0, i) = MatrVidst(n, i) MatrVidst(n, i) = Trudyaga(i) Next i ‘Заміна m-ого стовпчик на останній For i = 0 To 25 Trudyaga(i) = MatrVidst(i, 25) MatrVidst(i, 25) = MatrVidst(i, m) MatrVidst(i, m) = Trudyaga(i) Next i ‘Заміна m-ого рядка на останній For i = 0 To 25 Trudyaga(i) = MatrVidst(25, i) MatrVidst(25, i) = MatrVidst(m, i) MatrVidst(m, i) = Trudyaga(i) Next i ‘Зміна індексів Dim s As Long s = Index(0) Index(0) = Index(n) Index(n) = s s = Index(25) Index(25) = Index(m) Index(m) = s ‘Зміна індексів вершин, суміжних з Х0 For i = 0 To 25 If MatrSumizh(0, i) = 1 Then Index(i) = MatrVidst(0, i) End If Next i ‘Переіндексація решти вершин Dim PR As Byte PR = 1 Do While PR = 1 PR = 0 For i = 0 To 25 For j = 0 To 25 If (MatrSumizh(i, j) = 1 And i <> 0 And j <> 0) Then If (Index(j) > Index(i) + MatrVidst(i, j)) Then PR = 1 Index(j) = Index(i) + MatrVidst(i, j) End If End If Next j Next i Loop Text4.Text = Index(25) ‘Знаходження шляху Dim a, h, w As Byte Dim q As Integer a = 100 w = 1 i = 25 Do While a > 0 For q = 0 To 25 If MatrSumizh(i, q) = 1 Then If Index(i) = Index(q) + MatrVidst(i, q) Then a = q w = w + 1 i = q q = -1 End If End If Next q Loop ReDim arr(1 To w) As String arr(1) = "X" + CStr(m) h = 1 a = 100 i = 25 Picture1.Cls Picture1.DrawWidth = 1 Do While a > 0 For q = 0 To 25 If MatrSumizh(i, q) = 1 Then If Index(i) = Index(q) + MatrVidst(i, q) Then a = q h = h + 1 If q = 0 Then 'Picture1.Print "X" & n arr(h) = "X" + CStr(n) & "-" If h = 2 Then Picture1.Line (arrX(m, 1), arrX(m, 2))-(arrX(n, 1), arrX(n, 2)) Else: Picture1.Line -(arrX(n, 1), arrX(n, 2)) End If Else If q = n Then 'Picture1.Print "X" & 0 arr(h) = "X" + CStr(0) + "-" If h = 2 Then Picture1.Line (arrX(m, 1), arrX(m, 2))-(arrX(0, 1), arrX(0, 2)) Else: Picture1.Line -(arrX(0, 1), arrX(0, 2)) End If Else: arr(h) = "X" + CStr(q) + "-" If h = 2 Then Picture1.Line (arrX(m, 1), arrX(m, 2))-(arrX(q, 1), arrX(q, 2)) Else: Picture1.Line -(arrX(q, 1), arrX(q, 2)) End If End If End If i = q q = -1 End If End If Next q Loop ‘Побудова вершин Dim x As Byte Picture1.DrawWidth = 5 For x = 0 To 25 Picture1.PSet (40 * Cos(6.28 / 26 * x), 40 * Sin(6.28 / 26 * x)) arrX(x, 1) = 40 * Cos(6.28 / 26 * x) arrX(x, 2) = 40 * Sin(6.28 / 26 * x) Picture1.CurrentX = 45 * Cos(6.28 / 26 * x) Picture1.CurrentY = 45 * Sin(6.28 / 26 * x) Picture1.Print "X " & x arrY(x, 1) = Picture1.CurrentX arrY(x, 2) = Picture1.CurrentY Next x For h = 0 To w - 1 Text3.Text = Text3.Text + arr(w - h) Next h ' 'Cls 'Picture1.Cls End Sub Private Sub Command3_Click() Cls Picture1.Cls Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Command2.Enabled = False Command1.Enabled = True End Sub Private Sub Form_Load() Max = 1 Command2.Enabled = False ‘Початкові розміри форми Form1.Width = 12500 Form1.Height = 10500 Picture1.Width = 9500 Picture1.Height = 9500 Picture1.Scale (-50, 50)-(50, -50) Dim x As Byte For x = 0 To 25 arrX(x, 1) = 40 * Cos(6.28 / 26 * x) arrX(x, 2) = 40 * Sin(6.28 / 26 * x) Next x ‘Матриця суміжності Dim i, j As Byte For i = 0 To 25 For j = 0 To 25 MatrSumizh(i, j) = 0 Next j Next i MatrSumizh(1, 4) = 1: MatrSumizh(4, 1) = 1: MatrSumizh(1, 5) = 1: MatrSumizh(5, 1) = 1 MatrSumizh(2, 13) = 1: MatrSumizh(13, 2) = 1: MatrSumizh(2, 14) = 1: MatrSumizh(14, 2) = 1 MatrSumizh(3, 21) = 1: MatrSumizh(21, 3) = 1: MatrSumizh(3, 25) = 1: MatrSumizh(25, 3) = 1 MatrSumizh(4, 10) = 1: MatrSumizh(10, 4) = 1: MatrSumizh(4, 11) = 1: MatrSumizh(11, 4) = 1 MatrSumizh(4, 12) = 1: MatrSumizh(12, 4) = 1: MatrSumizh(5, 12) = 1: MatrSumizh(12, 5) = 1 MatrSumizh(5, 19) = 1: MatrSumizh(19, 5) = 1: MatrSumizh(5, 20) = 1: MatrSumizh(20, 5) = 1 MatrSumizh(6, 4) = 1: MatrSumizh(4, 6) = 1: MatrSumizh(6, 5) = 1: MatrSumizh(5, 6) = 1 MatrSumizh(7, 13) = 1: MatrSumizh(13, 7) = 1: MatrSumizh(7, 14) = 1: MatrSumizh(14, 7) = 1 MatrSumizh(8, 16) = 1: MatrSumizh(16, 8) = 1: MatrSumizh(8, 18) = 1: MatrSumizh(18, 8) = 1 MatrSumizh(18, 9) = 1: MatrSumizh(9, 18) = 1: MatrSumizh(10, 14) = 1: MatrSumizh(14, 10) = 1 MatrSumizh(11, 16) = 1: MatrSumizh(16, 11) = 1: MatrSumizh(11, 22) = 1: MatrSumizh(22, 11) = 1 MatrSumizh(11, 17) = 1: MatrSumizh(17, 11) = 1: MatrSumizh(11, 18) = 1: MatrSumizh(18, 11) = 1 MatrSumizh(12, 8) = 1: MatrSumizh(8, 12) = 1: MatrSumizh(12, 9) = 1: MatrSumizh(9, 12) = 1 MatrSumizh(9, 13) = 1: MatrSumizh(13, 9) = 1: MatrSumizh(15, 25) = 1: MatrSumizh(25, 15) = 1 MatrSumizh(16, 22) = 1: MatrSumizh(22, 16) = 1: MatrSumizh(23, 17) = 1: MatrSumizh(17, 23) = 1 MatrSumizh(15, 17) = 1: MatrSumizh(17, 15) = 1: MatrSumizh(17, 21) = 1: MatrSumizh(21, 17) = 1 MatrSumizh(18, 23) = 1: MatrSumizh(23, 18) = 1: MatrSumizh(18, 24) = 1: MatrSumizh(24, 18) = 1 MatrSumizh(19, 11) = 1: MatrSumizh(11, 19) = 1: MatrSumizh(19, 17) = 1: MatrSumizh(17, 19) = 1 MatrSumizh(19, 24) = 1: MatrSumizh(24, 19) = 1: MatrSumizh(20, 24) = 1: MatrSumizh(24, 20) = 1 MatrSumizh(20, 21) = 1: MatrSumizh(21, 20) = 1: MatrSumizh(20, 9) = 1: MatrSumizh(9, 20) = 1 MatrSumizh(0, 1) = 1: MatrSumizh(1, 0) = 1: MatrSumizh(0, 11) = 1: MatrSumizh(11, 0) = 1 MatrSumizh(0, 13) = 1: MatrSumizh(13, 0) = 1: MatrSumizh(0, 20) = 1: MatrSumizh(20, 0) = 1 ‘Матриця відстаней For i = 0 To 25 For j = 0 To 25 If MatrSumizh(i, j) = 1 Then MatrVidst(i, j) = Int((i + j) / 2 + 2) End If Max = Max + MatrVidst(i, j) Next j Next i End Sub Private Sub Text2_Change() Command1.Enabled = False If (IsNumeric(Text1.Text) And IsNumeric(Text2.Text)) Then Command2.Enabled = True End If End Sub Private Sub Text1_Change() Command1.Enabled = False If (IsNumeric(Text1.Text) And IsNumeric(Text2.Text)) Then Command2.Enabled = True End If End Sub Приклад. Знайти найкоротший шлях від вершини Х2 до вершини Х6.
Допоможи студентському архіву

Ми допомогли тобі — допоможи наступному студенту

Файл ще не обрано

Оголошення від адміністратора

Антиботан аватар за замовчуванням

Подякувати Студентському архіву довільною сумою

Admin

26.02.2023 12:38

Дякуємо, що користуєтесь нашим архівом!