RosettaCodeData/Task/Kolakoski-sequence/FreeBASIC/kolakoski-sequence.basic

104 lines
2.3 KiB
Plaintext

Sub Kolakoski(c() As Integer, slen As Integer, s() As Integer)
Redim s(slen - 1)
Dim As Integer i, k, j
i = 0: k = 0
Do
s(i) = c(k Mod (Ubound(c) + 1))
If s(k) > 1 Then
For j = 1 To s(k) - 1
i += 1
If i = slen Then Exit Sub
s(i) = s(i - 1)
Next
End If
i += 1
If i = slen Then Exit Sub
k += 1
Loop
End Sub
Function possibleKolakoski(s() As Integer) As Boolean
Dim As Integer i, slen, prev, cnt
Dim As Integer rle()
slen = Ubound(s) + 1
prev = s(0)
cnt = 1
For i = 1 To slen - 1
If s(i) = prev Then
cnt += 1
Else
Redim Preserve rle(Ubound(rle) + 1)
rle(Ubound(rle)) = cnt
cnt = 1
prev = s(i)
End If
Next
For i = 0 To Ubound(rle)
If rle(i) <> s(i) Then Return False
Next
Return True
End Function
Dim As Integer slens(3) = {20, 20, 30, 30}
Dim As Integer j, ia, slen, i = 0
Dim As Integer kol()
Dim As Boolean p
Dim As String poss
Dim As Integer ias1(1, 1) = {{1, 2}, {2, 1}}
For ia = 0 To Ubound(ias1)
slen = slens(i)
Dim As Integer iaArray(Ubound(ias1, 2))
For j = 0 To Ubound(ias1, 2)
iaArray(j) = ias1(ia, j)
Next
Kolakoski(iaArray(), slen, kol())
Print "First "; slen; " members of the sequence generated by [";
For j = 0 To Ubound(iaArray)
Print iaArray(j);
Next
Print " ]:"
Print "[";
For j = 0 To Ubound(kol)
Print kol(j);
Next
Print "]"
p = possibleKolakoski(kol())
poss = Iif(p, "Yes", "No")
Print "Possible Kolakoski sequence? "; poss
Print
i += 1
Next
Dim As Integer ias2(1, 3) = {{1, 3, 1, 2}, {1, 3, 2, 1}}
For ia = 0 To Ubound(ias2)
slen = slens(i)
Dim As Integer iaArray(Ubound(ias2, 2))
For j = 0 To Ubound(ias2, 2)
iaArray(j) = ias2(ia, j)
Next
Kolakoski(iaArray(), slen, kol())
Print "First "; slen; " members of the sequence generated by [";
For j = 0 To Ubound(iaArray)
Print iaArray(j);
Next
Print !" ]:\n[";
For j = 0 To Ubound(kol)
Print kol(j);
Next
Print "]"
p = possibleKolakoski(kol())
poss = Iif(p, "Yes", "No")
Print "Possible Kolakoski sequence? "; poss
Print
i += 1
Next
Sleep