RosettaCodeData/Task/Topological-sort/FreeBASIC/topological-sort-1.basic

151 lines
4.3 KiB
Plaintext

Type Pair
primero As Integer
segundo As Integer
End Type
Type Graph
vertices(14) As String
numVertices As Integer
proximos(14, 14) As Boolean
Declare Constructor(s As String, edges() As Pair)
Declare Function hasDependency(r As Integer, todo() As Integer, todoCount As Integer) As Boolean
Declare Function topoSort() As String
End Type
Function splitString(text As String, delimiter As String, Byref count As Integer) As String Ptr
Dim As Integer numTokens = 0
Dim As String tmp = text
Dim As Long posic
' Count delimiters
Do
posic = Instr(tmp, delimiter)
If posic = 0 Then Exit Do
numTokens += 1
tmp = Mid(tmp, posic + Len(delimiter))
Loop
numTokens += 1
' Allocate array
count = numTokens
Dim As String Ptr result = Callocate((numTokens) * Sizeof(String))
' Split string
tmp = text
numTokens = 0
Do
posic = Instr(tmp, delimiter)
If posic = 0 Then
result[numTokens] = tmp
Exit Do
End If
result[numTokens] = Left(tmp, posic - 1)
tmp = Mid(tmp, posic + Len(delimiter))
numTokens += 1
Loop
Return result
End Function
Constructor Graph(s As String, edges() As Pair)
Dim As Integer i, tokenCount
Dim As String Ptr tokens = splitString(s, ", ", tokenCount)
numVertices = tokenCount
For i = 0 To numVertices - 1
vertices(i) = tokens[i]
Next
Deallocate(tokens)
' Initialize proximos matrix
For i = 0 To Ubound(edges)
proximos(edges(i).primero, edges(i).segundo) = True
Next
End Constructor
Function Graph.hasDependency(r As Integer, todo() As Integer, todoCount As Integer) As Boolean
For i As Integer = 0 To todoCount - 1
If proximos(r, todo(i)) Then Return True
Next
Return False
End Function
Function Graph.topoSort() As String
Dim As String result = ""
Dim As Integer todoCount, i, j
Dim As Integer todo(numVertices)
todoCount = numVertices
' Initialize todo list
For i = 0 To numVertices - 1
todo(i) = i
Next
While todoCount > 0
i = 0
Dim As Boolean found = False
While i < todoCount
If Not hasDependency(todo(i), todo(), todoCount) Then
' Add to result
If Len(result) > 0 Then result &= ", "
result &= vertices(todo(i))
' Remove from todo
For j = i To todoCount - 2
todo(j) = todo(j + 1)
Next
todoCount -= 1
found = True
Exit While
End If
i += 1
Wend
If Not found Then Return "Graph has cycles"
Wend
Return "[" & result & "]"
End Function
' Main program
Dim As String s = "std, ieee, des_system_lib, dw01, dw02, dw03, dw04, dw05, " & _
"dw06, dw07, dware, gtech, ramlib, std_cell_lib, synopsys"
Dim As Pair deps(33)
' Initialize deps array
deps(0) = Type<Pair>(2, 0) : deps(1) = Type<Pair>(2, 14)
deps(2) = Type<Pair>(2, 13) : deps(3) = Type<Pair>(2, 4)
deps(4) = Type<Pair>(2, 3) : deps(5) = Type<Pair>(2, 12)
deps(6) = Type<Pair>(2, 1) : deps(7) = Type<Pair>(3, 1)
deps(8) = Type<Pair>(3, 10) : deps(9) = Type<Pair>(3, 11)
deps(10) = Type<Pair>(4, 1) : deps(11) = Type<Pair>(4, 10)
deps(12) = Type<Pair>(5, 0) : deps(13) = Type<Pair>(5, 14)
deps(14) = Type<Pair>(5, 10) : deps(15) = Type<Pair>(5, 4)
deps(16) = Type<Pair>(5, 3) : deps(17) = Type<Pair>(5, 1)
deps(18) = Type<Pair>(5, 11) : deps(19) = Type<Pair>(6, 1)
deps(20) = Type<Pair>(6, 3) : deps(21) = Type<Pair>(6, 10)
deps(22) = Type<Pair>(6, 11) : deps(23) = Type<Pair>(7, 1)
deps(24) = Type<Pair>(7, 10) : deps(25) = Type<Pair>(8, 1)
deps(26) = Type<Pair>(8, 10) : deps(27) = Type<Pair>(9, 1)
deps(28) = Type<Pair>(9, 10) : deps(29) = Type<Pair>(10, 1)
deps(30) = Type<Pair>(11, 1) : deps(31) = Type<Pair>(12, 0)
deps(32) = Type<Pair>(12, 1) : deps(33) = Type<Pair>(13, 1)
Dim As Graph g = Graph(s, deps())
Print "Topologically sorted order:"
Print g.topoSort()
Print
' Add new dependency
For i As Integer = 33 To 11 Step -1
deps(i) = deps(i-1)
Next
deps(10) = Type<Pair>(3, 6)
Dim As Graph g2 = Graph(s, deps())
Print "Following the addition of dw04 to the dependencies of dw01:"
Print g2.topoSort()
Sleep