RosettaCodeData/Task/Kosaraju/FreeBASIC/kosaraju.basic

93 lines
2.0 KiB
Plaintext

' Define a custom type for a dynamic array of integers
Type IntArray
Dato As Integer Ptr
Size As Integer
End Type
' Function to add an element to the IntArray
Sub AddToIntArray(arr As IntArray Ptr, value As Integer)
arr->Size += 1
arr->Dato = Reallocate(arr->Dato, arr->Size * Sizeof(Integer))
arr->Dato[arr->Size - 1] = value
End Sub
' Define the graph as an array of IntArrays
Dim Shared As IntArray g(7)
' Global variables for Kosaraju's algorithm
Dim Shared As IntArray t(7)
Dim Shared As Boolean vis(7)
Dim Shared As Integer x, L(7), c(7)
' Initialize the graph
Sub InitGraph()
Dim As Integer i, j
Dim As Integer edges(7, 3) = {{1},{2},{0},{1,2,4},{3,5},{2,6},{5},{4,6,7}}
For i = 0 To 7
For j = 0 To 2
If edges(i, j) >= 0 Then AddToIntArray(@g(i), edges(i, j))
Next
Next
End Sub
Sub Visit(u As Integer)
If Not vis(u) Then
vis(u) = True
For i As Integer = 0 To g(u).Size - 1
Visit(g(u).Dato[i])
AddToIntArray(@t(g(u).Dato[i]), u)
Next
x -= 1
L(x) = u
End If
End Sub
Sub Assign(u As Integer, root As Integer)
If vis(u) Then
vis(u) = False
c(u) = root
For i As Integer = 0 To t(u).Size - 1
Assign(t(u).Dato[i], root)
Next
End If
End Sub
Sub Kosaraju(n As Integer)
Dim As Integer i
' Initialize variables
For i = 0 To n-1
vis(i) = False
t(i).Size = 0
If t(i).Dato Then Deallocate(t(i).Dato)
Next
x = n
' Visit all vertices
For i = 0 To n-1
Visit(i)
Next
' Reset visited array
For i = 0 To n-1
vis(i) = True
Next
' Free temporary arrays
For i = 0 To n-1
Assign(L(i), L(i))
Next
End Sub
InitGraph()
Dim n As Integer = 8 ' Number of vertices
Kosaraju(n)
For i As Integer = 0 To n-1
' Print the result
Print c(i);
' Free allocated memory
If g(i).Dato Then Deallocate(g(i).Dato)
If t(i).Dato Then Deallocate(t(i).Dato)
Next
Sleep