Предлагаю Вашему вниманию реализацию алгоритма Дейкстры (Дийкстры) в Excel. Позволяет найти кратчайший (или самый дешёвый) путь между множеством точек.
На ту же тему на форуме есть задача Коммивояжера, однако в отличие от неё - здесь НЕ требуется обойти все возможные точки.
Эта реализация вдохновлена алгоритмом с форума по Au3, но в отличие от частного решения, там представленного, я дополнил реализацию возможностью автоматического расширения на разное число точек (узлов).
Исходные данные должны быть представлены в виде квадратной матрицы. По столбцу слева указаны объекты, откуда происходит переход. По строке сверху - точки, куда идёт переход. На пересечении - стоимость перехода. При этом в разные стороны между одними и теми же точками сумма может отличаться. Если сумма перехода равна нолю - считается, что переход невозможен.
Код программы:
Option Explicit Option Base 1
Sub Rio_Dij() Dim StartX AsLong Dim FinishX AsLong Dim BasE, NamS Dim nCost, nBack, nBack_tmp Dim i AsLong Dim j AsLong Dim k AsLong Dim l AsLong Dim SumX AsDouble Dim MinX AsDouble Dim MinID Dim Result() AsString Dim RowA AsLong Dim RowB AsLong
RowA = Cells(5, 1).End(xlDown).Row - 4
RowB = RowA + 1
Range(Cells(4, RowA + 3), Cells(4, RowA + 3).End(xlToRight).End(xlDown)).Clear
MinX = 999999999999999#
BasE = Range("B5").Resize(RowA, RowA)
NamS = Range("A5").Resize(RowA, 1) For i = 1To RowA If Range("B2").Value = NamS(i, 1) Then StartX = i If Range("E2").Value = NamS(i, 1) Then FinishX = i Next i ReDim nCost(RowA) ReDim nBack(RowA) ReDim nBack_tmp(RowA) For i = 1ToUBound(NamS, 1)
nCost(i) = MinX
nBack(i) = RowB
nBack_tmp(i) = RowB Next i
nCost(StartX) = 0
nBack(StartX) = 0 DoWhile nBack(FinishX) = RowB For i = 1To RowA If nBack(i) < RowB Then For j = 1To RowA If BasE(i, j) > 0Then
SumX = nCost(i) + BasE(i, j) If nCost(j) > SumX Then
nCost(j) = SumX
nBack_tmp(j) = i EndIf EndIf Next j EndIf Next i
MinX = 999999999999999# For i = 1To RowA If nBack(i) <> nBack_tmp(i) Then If nCost(i) < MinX Then
MinX = nCost(i)
MinID = i EndIf EndIf Next i
nBack(MinID) = nBack_tmp(MinID) Loop
i = FinishX
j = 0 Do
j = j + 1 ReDim Preserve Result(4, j)
Result(1, j) = NamS(nBack(i), 1) 'Откуда
Result(2, j) = NamS(i, 1) 'Куда
Result(3, j) = BasE(nBack(i), i) 'Сколько стоило
Result(4, j) = nCost(i) 'Стоимость накопительно
i = nBack(i) LoopWhile i <> StartX
Range("A4").Offset(0, RowA + 2).Resize(1, 5).Value = Array("Шаг", "Откуда", "Куда", "Сумма", "Накопительно") For k = j To1Step -1
Cells(5 + (j - k), RowA + 3).Value = j - k + 1 For l = 1To4
Cells(5 + (j - k), RowA + 3 + l).Value = Result(l, k) Next l Next k EndSub
Всем привет и хорошего настроения!
Предлагаю Вашему вниманию реализацию алгоритма Дейкстры (Дийкстры) в Excel. Позволяет найти кратчайший (или самый дешёвый) путь между множеством точек.
На ту же тему на форуме есть задача Коммивояжера, однако в отличие от неё - здесь НЕ требуется обойти все возможные точки.
Эта реализация вдохновлена алгоритмом с форума по Au3, но в отличие от частного решения, там представленного, я дополнил реализацию возможностью автоматического расширения на разное число точек (узлов).
Исходные данные должны быть представлены в виде квадратной матрицы. По столбцу слева указаны объекты, откуда происходит переход. По строке сверху - точки, куда идёт переход. На пересечении - стоимость перехода. При этом в разные стороны между одними и теми же точками сумма может отличаться. Если сумма перехода равна нолю - считается, что переход невозможен.
Код программы:
Option Explicit Option Base 1
Sub Rio_Dij() Dim StartX AsLong Dim FinishX AsLong Dim BasE, NamS Dim nCost, nBack, nBack_tmp Dim i AsLong Dim j AsLong Dim k AsLong Dim l AsLong Dim SumX AsDouble Dim MinX AsDouble Dim MinID Dim Result() AsString Dim RowA AsLong Dim RowB AsLong
RowA = Cells(5, 1).End(xlDown).Row - 4
RowB = RowA + 1
Range(Cells(4, RowA + 3), Cells(4, RowA + 3).End(xlToRight).End(xlDown)).Clear
MinX = 999999999999999#
BasE = Range("B5").Resize(RowA, RowA)
NamS = Range("A5").Resize(RowA, 1) For i = 1To RowA If Range("B2").Value = NamS(i, 1) Then StartX = i If Range("E2").Value = NamS(i, 1) Then FinishX = i Next i ReDim nCost(RowA) ReDim nBack(RowA) ReDim nBack_tmp(RowA) For i = 1ToUBound(NamS, 1)
nCost(i) = MinX
nBack(i) = RowB
nBack_tmp(i) = RowB Next i
nCost(StartX) = 0
nBack(StartX) = 0 DoWhile nBack(FinishX) = RowB For i = 1To RowA If nBack(i) < RowB Then For j = 1To RowA If BasE(i, j) > 0Then
SumX = nCost(i) + BasE(i, j) If nCost(j) > SumX Then
nCost(j) = SumX
nBack_tmp(j) = i EndIf EndIf Next j EndIf Next i
MinX = 999999999999999# For i = 1To RowA If nBack(i) <> nBack_tmp(i) Then If nCost(i) < MinX Then
MinX = nCost(i)
MinID = i EndIf EndIf Next i
nBack(MinID) = nBack_tmp(MinID) Loop
i = FinishX
j = 0 Do
j = j + 1 ReDim Preserve Result(4, j)
Result(1, j) = NamS(nBack(i), 1) 'Откуда
Result(2, j) = NamS(i, 1) 'Куда
Result(3, j) = BasE(nBack(i), i) 'Сколько стоило
Result(4, j) = nCost(i) 'Стоимость накопительно
i = nBack(i) LoopWhile i <> StartX
Range("A4").Offset(0, RowA + 2).Resize(1, 5).Value = Array("Шаг", "Откуда", "Куда", "Сумма", "Накопительно") For k = j To1Step -1
Cells(5 + (j - k), RowA + 3).Value = j - k + 1 For l = 1To4
Cells(5 + (j - k), RowA + 3 + l).Value = Result(l, k) Next l Next k EndSub
А почему нет? Например (в приложении к физике реальности) - скажем, это кусок пути из одного города (4) в другой (7) пролегает по реке с бешеным течением, и указана стоимость затрат в каждом направлении...
А почему нет? Например (в приложении к физике реальности) - скажем, это кусок пути из одного города (4) в другой (7) пролегает по реке с бешеным течением, и указана стоимость затрат в каждом направлении...AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Пятница, 24.07.2015, 19:48
Выкладываю более наглядный пример по мотивам MMO RPG LineAge2. Матрицу стоимости и названия городов взял ЗДЕСЬ. Позволяет найти самый дешёвый по стоимости путь между выбранными городами. Код как и в первом посте, изменены только исходные данные.
Выкладываю более наглядный пример по мотивам MMO RPG LineAge2. Матрицу стоимости и названия городов взял ЗДЕСЬ. Позволяет найти самый дешёвый по стоимости путь между выбранными городами. Код как и в первом посте, изменены только исходные данные.Rioran
Делал поиск кратчайшего пути в лабиринте используя алгоритм Дейкстры по разреженному графу. Исходная тема: http://www.sql.ru/forum....2%f0%e0 По исходному лабиринту построен граф. При указании начальной и конечной точки строится кратчайший путь "на лету"
Делал поиск кратчайшего пути в лабиринте используя алгоритм Дейкстры по разреженному графу. Исходная тема: http://www.sql.ru/forum....2%f0%e0 По исходному лабиринту построен граф. При указании начальной и конечной точки строится кратчайший путь "на лету"MCH