RosettaCodeData/Task/Order-disjoint-list-items/FreeBASIC/order-disjoint-list-items.basic
2024-10-16 18:07:41 -07:00

137 lines
3.2 KiB
Text

Function isInArray(arr() As Integer, value As Integer, count As Integer) As Boolean
For i As Integer = 0 To count - 1
If arr(i) = value Then Return True
Next
Return False
End Function
Sub Sort(arr() As Integer, count As Integer)
Dim As Integer i, j
For i = 0 To count - 2
For j = i + 1 To count - 1
If arr(i) > arr(j) Then Swap arr(i), arr(j)
Next j
Next i
End Sub
Dim Shared As String*3 testm(12, 8) = { _
{"the", "cat", "sat", "on", "the", "mat"}, _
{"the", "cat", "sat", "on", "the", "mat"}, _
{"A", "B", "C", "A", "B", "C", "A", "B", "C"}, _
{"A", "B", "C", "A", "B", "D", "A", "B", "E"}, _
{"A", "B"}, _
{"A", "B"}, _
{"A", "B", "B", "A"}, _
{"A"}, _
{"A", "B", "B", "A"}, _
{"A", "B", "A", "B"}, _
{"A", "B", "A", "B"}, _
{"A", "B", "C", "C", "B", "A"}, _
{"A", "B", "C", "C", "B", "A"} }
Dim Shared As String*3 testn(12, 3) = { _
{"mat", "cat"}, _
{"cat", "mat"}, _
{"C", "A", "C", "A"}, _
{"E", "A", "D", "A"}, _
{"B"}, _
{"B", "A"}, _
{"B", "A"}, _
{"A"}, _
{"A", "B"}, _
{"A", "B"}, _
{"B", "A", "B", "A"}, _
{"A", "C", "A", "C"}, _
{"C", "A", "C", "A"} }
Sub OrderDisjoint(m() As String, n() As String, p() As String)
Dim As Integer rlen = Ubound(n) - Lbound(n) + 1
Dim As Integer rdis(rlen - 1)
Dim As Integer i, j
Dim As String e
For i = 0 To rlen - 1
e = n(i)
For j = 0 To Ubound(m)
If m(j) = e And Not isInArray(rdis(), j + 1, rlen) Then
rdis(i) = j + 1
Exit For
End If
Next j
Next i
For i = 0 To rlen - 1
If rdis(i) = 0 Then Print "DomainError": Exit Sub
Next i
Sort(rdis(), rlen)
For i = 0 To Ubound(m)
p(i) = m(i)
Next i
For i = 0 To rlen - 1
p(rdis(i) - 1) = n(i)
Next i
End Sub
Sub TestOrderDisjoint()
Dim As Integer i, j
Dim As String m(), n(), p()
For i = 0 To Ubound(testm, 1) '6
Dim As Integer mCount = 0, nCount = 0
' Count non-empty elements in testm
For j = 0 To Ubound(testm, 2)
If testm(i, j) <> "" Then mCount += 1
Next j
' Count non-empty elements in testn
For j = 0 To Ubound(testn, 2)
If testn(i, j) <> "" Then nCount += 1
Next j
' Resize dynamic arrays
Redim m(mCount - 1)
Redim n(nCount - 1)
Redim p(mCount - 1)
' Fill arrays m and n with non-empty elements
mCount = 0
nCount = 0
For j = 0 To Ubound(testm, 2)
If testm(i, j) <> "" Then
m(mCount) = testm(i, j)
mCount += 1
End If
Next j
For j = 0 To Ubound(testn, 2)
If testn(i, j) <> "" Then
n(nCount) = testn(i, j)
nCount += 1
End If
Next j
OrderDisjoint(m(), n(), p())
Print "[ ";
For j = 0 To Ubound(m)
Print m(j); " ";
Next j
Print Chr(8); ", ";
For j = 0 To Ubound(n)
Print n(j); " ";
Next j
Print "] => ";
For j = 0 To Ubound(p)
Print p(j); " ";
Next j
Print
Next i
End Sub
TestOrderDisjoint()
Sleep