Anzeige
Archiv - Navigation
1560to1564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dijkstra-Algorithmus VBA

Dijkstra-Algorithmus VBA
12.06.2017 22:34:06
Chris
Hallo zusammen,
ich habe ein Anliegen und hoffe, dass sich hier schon mal jemand mit dem kürzesten-Wege-Problem und dessen Implementierung auseinandergesetzt hat.
Ich brauche eine Implementierung des Dijkstra-Algorithmus, der mir für meinen Input den kürzesten Weg von jedem Knoten zu jedem anderen Knoten erzeugt und die genaue Route ausgibt.
Meine Daten umfassen 324 Knoten und deren Nachbarschaftsbeziehungen (siehe Anhang). Es gibt somit 324x323 mögliche Kombinationen, für die ich den genauen Weg brauche. Ich bin leider selber nicht sehr fit im Programmieren und hoffe deshalb, dass jemand von euch mir dabei helfen kann.
Schon mal vielen Dank im voraus und liebe Grüße
Chris
https://www.herber.de/bbs/user/114230.xlsx

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Hausaufgaben? owT
12.06.2017 22:55:19
RPP63
Hier steht erst mal nüscht, nothing, niente!
AW: Hausaufgaben? owT
12.06.2017 23:21:46
Chris
Nein, keine Hausaufgaben. Aus dem Alter bin ich seit geraumer Zeit heraus..
Ich benötige die kürzesten Wege als Datengrundlage, um darüber eine Optimierung laufen zu lassen. Ist Teil einer Visualisierungsaufgabe im Zuge meiner Arbeit.
Die Optimierung läuft dann über ein anderes Programm und ist recht simpel.
AW: Hausaufgaben? owT
13.06.2017 07:52:55
Max2
Hallo,
wer fähig ist Google zu bemühen, kommt oft zu Ergebnissen...
Seite bzw. Code unten ist das zweite Suchergebniss auf Google von: Dijkstra VBA
https://rosettacode.org/wiki/User:Klever
Dijkstra Code dieser Seite:
NICHT MEIN CODE!

'Dijkstra globals
Const MaxGraph As Integer = 100 'max. number of nodes in graph
Const Infinity = 1E+308
Dim E(1 To MaxGraph, 1 To MaxGraph) As Double  'the edge costs (Infinity if no edge)
Dim A(1 To MaxGraph) As Double                 'the distances calculated
Dim P(1 To MaxGraph) As Integer                'the previous/path array
Dim Q(1 To MaxGraph) As Boolean                'the queue
Public Sub Dijkstra(n, start)
'simple implementation of Dijkstra's algorithm
'n = number of nodes in graph
'start = index of start node
'init distances A
For j = 1 To n
A(j) = Infinity
Next j
A(start) = 0
'init P (path) to "no paths" and Q = set of all nodes
For j = 1 To n
Q(j) = True
P(j) = 0
Next j
Do While True 'loop will exit! (see below)
'find node u in Q with smallest distance to start
dist = Infinity
For i = 1 To n
If Q(i) Then
If A(i)  Infinity Then
'check if path to neighbor j via u is shorter than current estimated distance to j
alt = A(u) + E(u, j)
If alt  0
path = Format$(u) & " " & path
u = P(u)
Loop
GetPath = Format$(source) & " " & path
End If
End Function
Public Sub DijkstraTest()
'main function to solve Dijkstra's algorithm and return shortest path between
'a node and every other node in a digraph
' define problem:
' number of nodes
n = 5
' reset connection/cost per edge
For i = 1 To n
For j = 1 To n
E(i, j) = Infinity
Next j
P(i) = 0
Next i
' fill in the edge costs
E(1, 2) = 10
E(1, 3) = 50
E(1, 4) = 65
E(2, 3) = 30
E(2, 5) = 4
E(3, 4) = 20
E(3, 5) = 44
E(4, 2) = 70
E(4, 5) = 23
E(5, 1) = 6
'Solve it for every node
For v = 1 To n
Dijkstra n, v
'Print solution
Debug.Print "From", "To", "Cost", "Path"
For j = 1 To n
If v  j Then Debug.Print v, j, IIf(A(j) = Infinity, "---", A(j)), GetPath(v, j)
Next j
Debug.Print
Next v
End Sub

Anzeige
RND: Das meinst du wohl nicht im Ernst...
13.06.2017 10:23:34
EtoPHG
Fennek,
Das sind simple normal, verteilte Zufallszahlen.
Excel-Formeln : ZUFALLSZAHL() und ZUFALLSBEREICH(Untere_Zahl;Obere_Zahl)
VBA Anweisung: Randomize [Zahl] und VBA Funktion: RND(Zahl)
Für ganzzahlige Zufallszahlen, siehe Hilfe zur RND-Funktion.
Gruess Hansueli
Anzeige
AW: RND: Das meinst du wohl nicht im Ernst...
13.06.2017 10:43:34
Fennek
Hallo Hansueli,
die rnd() in xl kannte ich, die Frage war eigentlich, ob bessere Zufallszahlengeneratoren auf diesem Weg möglich sind.
mfg
Man muss das rad nicht neu erfinden
13.06.2017 10:51:59
Max2
Hallo,
wie im Betreff schon... aber hier der ParkMiller in VBA:

Const m As Long = 2147483647
Const a As Long = 48271
Const q As Long = 44488
Const r As Long = 3399
Private r_seed As Long
Private Function gen() As Long
Dim hi As Long
Dim lo As Long
Dim t As Long
hi = r_seed / q
lo = r_seed - q * hi
t = a * lo - r * hi
If t > 0 Then
r_seed = t
Else
r_seed = t + m
End If
gen = r_seed
End Function
Public Sub ParkMiller()
Dim arr() As Long
Dim i As Long
ReDim arr(10899999)
r_seed = 12345678
For i = 0 To UBound(arr)
arr(i) = gen
Next i
Erase arr
End Sub
Eine vorhandene Funktion nach zu bauen macht keinen Sinn, man wird sie
meist eh nicht besser hinbekommen und VBA wird Interpretiert und ist nicht Compiled.
Das ganze läuft also ziemlich langsam.
Anzeige
Definiere BESSERE Zufallszahlen! (owT)
13.06.2017 11:08:34
EtoPHG

AW: z.B. Gleichverteilt
13.06.2017 13:45:35
Fennek
Hallo Hansueli,
ein kleiner Vergleichstest mit dem Code von Max ("ParkMiller") und der xl "=Zufallszahl()" ergab bei einer Ziehung von 100.000 Zahlen (erstaunlicherweiseweise) keinen Unterschied in der Anzahl von Gruppen (Automatik der Pivot-Tabelle)
Auch bei mehrfacher Neu-Berechnung blieb die Anzahl in den Gruppern gleich.
mfg
(Also: keine gute Idee)
AW: Hausaufgaben? owT
13.06.2017 10:02:59
stoibech
Allerbesten Dank Max!
Das funktioniert hervorragend. Eine Kleinigkeit wäre jedoch noch gut.. könnt ihr mir helfen, die Daten in ein Tabellenblatt zu schreiben?
VG
Chris
Mehr Geduld...
13.06.2017 13:48:34
Max2
Hallo,
es kommt nicht immer alle 5 Minuten eine Antwort...
hier wie man es in ein Blatt schreibt:
Kopiere alles in den Code eines Tabellenblattes
Der Fettmarkierte Teil, schreibt die Werte in die Tabelle
Und Nochmals... NICHT MEIN CODE!
'Dijkstra globals
Const MaxGraph As Integer = 100 'max. number of nodes in graph
Const Infinity = 1E+308
Dim E(1 To MaxGraph, 1 To MaxGraph) As Double  'the edge costs (Infinity if no edge)
Dim A(1 To MaxGraph) As Double                 'the distances calculated
Dim P(1 To MaxGraph) As Integer                'the previous/path array
Dim Q(1 To MaxGraph) As Boolean                'the queue
Public Sub Dijkstra(n, start)
'simple implementation of Dijkstra's algorithm
'n = number of nodes in graph
'start = index of start node
'init distances A
For j = 1 To n
A(j) = Infinity
Next j
A(start) = 0
'init P (path) to "no paths" and Q = set of all nodes
For j = 1 To n
Q(j) = True
P(j) = 0
Next j
Do While True 'loop will exit! (see below)
'find node u in Q with smallest distance to start
dist = Infinity
For i = 1 To n
If Q(i) Then
If A(i)  Infinity Then
'check if path to neighbor j via u is shorter than current estimated distance to j
alt = A(u) + E(u, j)
If alt  0
path = Format$(u) & " " & path
u = P(u)
Loop
GetPath = Format$(source) & " " & path
End If
End Function
Public Sub DijkstraTest()
'main function to solve Dijkstra's algorithm and return shortest path between
'a node and every other node in a digraph
' define problem:
' number of nodes
n = 5
' reset connection/cost per edge
For i = 1 To n
For j = 1 To n
E(i, j) = Infinity
Next j
P(i) = 0
Next i
' fill in the edge costs
E(1, 2) = 10
E(1, 3) = 50
E(1, 4) = 65
E(2, 3) = 30
E(2, 5) = 4
E(3, 4) = 20
E(3, 5) = 44
E(4, 2) = 70
E(4, 5) = 23
E(5, 1) = 6
'Solve it for every node
For v = 1 To n
Dijkstra n, v
Debug.Print "From", "To", "Cost", "Path"
For j = 1 To n
If v  j Then
        Cells(1, 1).Value = "From": Cells(1, 2).Value = "To"
Cells(1, 3).Value = "Cost": Cells(1, 4).Value = "Path"
Cells(j + 1, 1).Value = v
Cells(j + 1, 2).Value = j
Cells(j + 1, 3).Value = IIf(A(j) = Infinity, "---", A(j))
Cells(j + 1, 4).Value = GetPath(v, j)
End If
Next j
Next v
End Sub

Anzeige
AW: Mehr Geduld...
13.06.2017 14:08:52
stoibech
Hallo Max,
ich versuch mich zu bessern :)
Danke dir schon mal für die Antwort. Ich hab ejedoch anstatt 5 Knoten insgesamt 324. Und wenn ich den Code so übernehme, wird mir nur die Lösung vom Knoten Nr. 324 zu allen anderen Knoten ausgegeben.
Siehe Anhang:
https://www.herber.de/bbs/user/114251.xlsm.
AW: Mehr Geduld...
13.06.2017 14:33:50
Max2
Hallo,
hier deine Datei mit neuem Excel Sheet: https://www.herber.de/bbs/user/114252.xlsm
Starte einfach den Code der im Tabellenblatt "test" steht.
Beachte bitte, dass der Vorgang je nach Rechenleistung deines PCs,
ordentlich Zeit in Anspruch nehmen kann.
Anzeige
Einspruch
14.06.2017 08:18:38
lupo1
Bei 324 Punkten gibt es für jeden einzelnen Punkt 323 Verbindungen (von denen eine die kürzeste ist).
Die kürzeste Gesamtstrecke (Abfahren aller Punkte) hingegen ist eine aus 323! Möglichkeiten.
Keine Gewähr für diese Aussage.
AW: Einspruch abgewiesen
14.06.2017 14:13:17
EtoPHG
Hallo Lupo,
1. Das kürzester-Weg-Problem ist P-complete.
2. Hingegen ist dasProblem des Handlungsreisenden NP-Complete.
Die Anfrage war vom Typ 1 und der Dijkstra-Algorithmus ist eine valable, wenn auch nicht die effizienteste, Lösung für diesen Typ.
Gruess Hansueli
Hm, aneinander vorbei?
14.06.2017 21:45:43
lupo1
Ich habe mich nicht auf das Problem bezogen, und hätte daher vermutlich im Titel nicht "Einspruch" sagen dürfen.
Also, abstrahierend von der Thread-Frage:
Wie viele Streckenmöglichkeiten bei 324 Punkten berechnest Du denn, also anders als 323! (Ich kann mich ja auch vertan haben)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige