Data update

Task/Dijkstras-algorithm/FreeBASIC/dijkstras-algorithm.basic

@@ -0,0 +1,140 @@
+Const INFINITY As Integer = &h7FFFFFFF
+
+Type Edge
+    src As String * 1
+    dst As String * 1
+    cost As Integer
+End Type
+
+Type Vertex
+    nom As String * 1
+    dist As Integer
+    prev As String * 1
+End Type
+
+Type Graph
+    edges(100) As Edge
+    edgeCount As Integer
+    verts(100) As Vertex
+    vertCount As Integer
+End Type
+
+Function createGraph(edges() As Edge, cnt As Integer) As Graph
+    Dim As Graph g
+    Dim As String names(100)
+    Dim As Integer i, j, nCount = 0
+
+    g.edgeCount = cnt
+
+    ' Copy edges and collect unique vertices
+    For i = 0 To cnt - 1
+        g.edges(i) = edges(i)
+
+        ' Check source vertex
+        Dim As Boolean found = False
+        For j = 0 To nCount - 1
+            If names(j) = edges(i).src Then
+                found = True
+                Exit For
+            End If
+        Next
+        If Not found Then
+            names(nCount) = edges(i).src
+            nCount += 1
+        End If
+
+        ' Check destination vertex
+        found = False
+        For j = 0 To nCount - 1
+            If names(j) = edges(i).dst Then
+                found = True
+                Exit For
+            End If
+        Next
+        If Not found Then
+            names(nCount) = edges(i).dst
+            nCount += 1
+        End If
+    Next
+
+    ' Initialize vertices
+    g.vertCount = nCount
+    For i = 0 To nCount - 1
+        With g.verts(i)
+            .nom = names(i)
+            .dist = INFINITY
+            .prev = names(i)
+        End With
+    Next
+
+    Return g
+End Function
+
+Function findVertex(g As Graph, nombre As String) As Integer
+    For i As Integer = 0 To g.vertCount - 1
+        If g.verts(i).nom = nombre Then Return i
+    Next
+    Return -1
+End Function
+
+Function dijkstraPath(g As Graph, source As String, dest As String) As Integer
+    Dim As Integer changed, i, srcIdx, dstIdx, newDist, destIdx
+    srcIdx = findVertex(g, source)
+    If srcIdx >= 0 Then g.verts(srcIdx).dist = 0
+
+    Do
+        changed = 0
+        For i = 0 To g.edgeCount - 1
+            With g.edges(i)
+                srcIdx = findVertex(g, .src)
+                dstIdx = findVertex(g, .dst)
+
+                If srcIdx >= 0 Andalso g.verts(srcIdx).dist <> INFINITY Then
+                    newDist = g.verts(srcIdx).dist + .cost
+                    If newDist < g.verts(dstIdx).dist Then
+                        g.verts(dstIdx).dist = newDist
+                        g.verts(dstIdx).prev = .src
+                        changed = 1
+                    End If
+                End If
+            End With
+        Next
+    Loop While changed
+
+    destIdx = findVertex(g, dest)
+    Return Iif(destIdx >= 0, g.verts(destIdx).dist, INFINITY)
+End Function
+
+Function getPath(g As Graph, source As String, dest As String) As String
+    Dim As String path = "", current = dest
+    Dim As Integer idx, destIdx, cost
+
+    ' Build path backwards
+    While current <> source
+        idx = findVertex(g, current)
+        If idx >= 0 Then
+            path = " -> " & current & path
+            current = g.verts(idx).prev
+        End If
+    Wend
+
+    ' Get final cost
+    destIdx = findVertex(g, dest)
+    cost = Iif(destIdx >= 0, g.verts(destIdx).dist, INFINITY)
+
+    Return source & " " & dest & " : " & source & path & " cost : " & cost
+End Function
+
+' Test program
+Dim As Edge testGraph(8) => {_
+("a", "b", 7),  ("a", "c", 9),  ("a", "f", 14), _
+("b", "c", 10), ("b", "d", 15), ("c", "d", 11), _
+("c", "f", 2),  ("d", "e", 6),  ("e", "f", 9)}
+
+Dim As Graph g = createGraph(testGraph(), 9)
+Dim As String source = "a", dest = "e"
+
+dijkstraPath(g, source, dest)
+Print getPath(g, source, dest)
+
+Sleep