150 lines
4.4 KiB
Plaintext
150 lines
4.4 KiB
Plaintext
Const tests As String = "0-1 1-2 2-0 3" & Chr(10) & _
|
|
"1-6 1-7 1-8 2-5 2-7 2-8 3-5 3-6 3-8 4-5 4-6 4-7" & Chr(10) & _
|
|
"1-4 1-6 1-8 3-2 3-6 3-8 5-2 5-4 5-8 7-2 7-4 7-6" & Chr(10) & _
|
|
"1-6 7-1 8-1 5-2 2-7 2-8 3-5 6-3 3-8 4-5 4-6 4-7"
|
|
|
|
Sub Colour(links() As Integer, nodeCount As Integer, colours() As Integer, _
|
|
soln() As Integer, Byref best As Integer, sgte As Integer, used As Integer = 0)
|
|
|
|
Dim As Integer i, c = 1
|
|
Dim As Integer tmpColours(nodeCount - 1)
|
|
|
|
For i = 0 To nodeCount - 1
|
|
tmpColours(i) = colours(i)
|
|
Next
|
|
|
|
While c <= best
|
|
Dim As Boolean avail = True
|
|
For i = 0 To nodeCount - 1
|
|
If links(sgte, i) = 1 Andalso tmpColours(i) = c Then
|
|
avail = False
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
If avail Then
|
|
tmpColours(sgte) = c
|
|
Dim As Integer newused = used
|
|
If c > used Then newused = c
|
|
|
|
If sgte < nodeCount - 1 Then
|
|
Colour(links(), nodeCount, tmpColours(), soln(), best, sgte + 1, newused)
|
|
Elseif newused < best Then
|
|
best = newused
|
|
For i = 0 To nodeCount - 1
|
|
soln(i) = tmpColours(i)
|
|
Next
|
|
End If
|
|
End If
|
|
c += 1
|
|
Wend
|
|
End Sub
|
|
|
|
Function GetNodeIndex(nodeMap() As String, nodeCount As Integer, nodeName As String) As Integer
|
|
For i As Integer = 0 To nodeCount - 1
|
|
If nodeMap(i) = nodeName Then Return i
|
|
Next
|
|
Return -1
|
|
End Function
|
|
|
|
Sub main()
|
|
Dim As String testLines(3)
|
|
Dim As Integer lineCount = 0, posic = 1, nextPos
|
|
|
|
' Split the test chain into lines
|
|
Do
|
|
nextPos = Instr(posic, tests, Chr(10))
|
|
If nextPos = 0 Then
|
|
testLines(lineCount) = Mid(tests, posic)
|
|
lineCount += 1
|
|
Exit Do
|
|
Else
|
|
testLines(lineCount) = Mid(tests, posic, nextPos - posic)
|
|
lineCount += 1
|
|
posic = nextPos + 1
|
|
End If
|
|
Loop
|
|
|
|
For t As Integer = 0 To 3
|
|
Dim As String linea = testLines(t)
|
|
Dim As String nodeMap(20)
|
|
Dim As Integer nodeCount = 0
|
|
Dim As String token
|
|
posic = 1
|
|
|
|
Do
|
|
If posic > Len(linea) Then Exit Do
|
|
|
|
nextPos = Instr(posic, linea, " ")
|
|
If nextPos = 0 Then nextPos = Len(linea) + 1
|
|
|
|
token = Mid(linea, posic, nextPos - posic)
|
|
posic = nextPos + 1
|
|
|
|
Dim As Integer dashPos = Instr(token, "-")
|
|
If dashPos > 0 Then
|
|
Dim As String node1 = Left(token, dashPos - 1)
|
|
Dim As String node2 = Mid(token, dashPos + 1)
|
|
|
|
If GetNodeIndex(nodeMap(), nodeCount, node1) = -1 Then
|
|
nodeMap(nodeCount) = node1
|
|
nodeCount += 1
|
|
End If
|
|
|
|
If GetNodeIndex(nodeMap(), nodeCount, node2) = -1 Then
|
|
nodeMap(nodeCount) = node2
|
|
nodeCount += 1
|
|
End If
|
|
Else
|
|
If GetNodeIndex(nodeMap(), nodeCount, token) = -1 Then
|
|
nodeMap(nodeCount) = token
|
|
nodeCount += 1
|
|
End If
|
|
End If
|
|
Loop
|
|
|
|
Dim As Integer links(nodeCount - 1, nodeCount - 1)
|
|
Dim As Integer edgeCount = 0
|
|
|
|
posic = 1
|
|
Do
|
|
If posic > Len(linea) Then Exit Do
|
|
|
|
nextPos = Instr(posic, linea, " ")
|
|
If nextPos = 0 Then nextPos = Len(linea) + 1
|
|
|
|
token = Mid(linea, posic, nextPos - posic)
|
|
posic = nextPos + 1
|
|
|
|
Dim As Integer dashPos = Instr(token, "-")
|
|
If dashPos > 0 Then
|
|
Dim As String node1 = Left(token, dashPos - 1)
|
|
Dim As String node2 = Mid(token, dashPos + 1)
|
|
|
|
Dim As Integer idx1 = GetNodeIndex(nodeMap(), nodeCount, node1)
|
|
Dim As Integer idx2 = GetNodeIndex(nodeMap(), nodeCount, node2)
|
|
|
|
links(idx1, idx2) = 1
|
|
links(idx2, idx1) = 1
|
|
edgeCount += 1
|
|
End If
|
|
Loop
|
|
|
|
Dim As Integer colours(nodeCount - 1), soln(nodeCount - 1)
|
|
Dim As Integer best = nodeCount
|
|
|
|
Colour(links(), nodeCount, colours(), soln(), best, 0)
|
|
|
|
Print "test" & t + 1 & ": " & nodeCount & " nodes, " & edgeCount & " edges, " & best & " colours:";
|
|
|
|
For i As Integer = 0 To nodeCount - 1
|
|
Print soln(i);
|
|
Next
|
|
Print
|
|
Next
|
|
End Sub
|
|
|
|
main()
|
|
|
|
Sleep
|