Подякувати Студентському архіву довільною сумою
Admin
26.02.2023 12:38
Дякуємо, що користуєтесь нашим архівом!
Теорія графів.
Інформація про навчальний заклад
ВУЗ:
Національний університет Львівська політехніка
Інститут:
Інститут прикладної математики та фундаментальних наук
Факультет:
Не вказано
Кафедра:
Кафедра прикладної математики
Інформація про роботу
Рік:
2008
Тип роботи:
Лабораторна робота
Предмет:
Дискретна математика
Група:
ПМ-32
Частина тексту файла (без зображень, графіків і формул):
Міністерство освіти і науки України
Національний Університет „Львівська політехніка”
Інститут прикладної математики і фундаментальних наук
Кафедра прикладної математики
Курсова робота
Тема: Теорія графів
Виконав:
студент групи ПМ – 32
Львів 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.
Ділись своїми роботами та отримуй миттєві бонуси!
0%
Оголошення від адміністратора