RosettaCodeData/Task/Summarize-and-say-sequence/FreeBASIC/summarize-and-say-sequence.basic
2024-11-04 21:53:44 -08:00

90 lines
2.2 KiB
Text

' Return the next term in the self-referential sequence
Function findNext(nStr As String) As String
Static As Integer i, j, cnt
Static As String outStr
Dim As String digits(1000)
Dim As Integer nLen = Len(nStr)
' Convert string to array
For i = 1 To nLen
digits(i-1) = Mid(nStr, i, 1)
Next
' Sort digits in descending order
For i = 0 To nLen-2
For j = i+1 To nLen-1
If Val(digits(i)) < Val(digits(j)) Then Swap digits(i), digits(j)
Next
Next
' Count and build output
cnt = 1
outStr = ""
For i = 0 To nLen-1
If i < nLen-1 Andalso digits(i) = digits(i+1) Then
cnt += 1
Else
outStr &= Trim(Str(cnt)) & digits(i)
cnt = 1
End If
Next
Return outStr
End Function
' Return boolean indicating whether table t contains string s
Function contains(sequence() As String, term As String, seqLen As Integer) As Boolean
For i As Integer = 0 To seqLen-1
If sequence(i) = term Then Return True
Next
Return False
End Function
' Return the sequence generated by the given seed term
Sub buildSeq(seed As String, sequence() As String, Byref seqLen As Integer)
Dim As String term = Trim(seed)
seqLen = 0
Do
sequence(seqLen) = term
seqLen += 1
term = findNext(term)
Loop Until contains(sequence(), term, seqLen)
End Sub
' Main program
Dim Shared As String sequences(1000, 100)
Dim As String currentSeq(100)
Static As Integer highest, seqCount, currentLen
Static As Integer i, j
highest = 0
seqCount = 0
For i = 1 To 1e6
buildSeq(Str(i), currentSeq(), currentLen)
If currentLen > highest Then
highest = currentLen
seqCount = 1
For j = 0 To currentLen-1
sequences(0, j) = currentSeq(j)
Next
Elseif currentLen = highest Then
For j = 0 To currentLen-1
sequences(seqCount, j) = currentSeq(j)
Next
seqCount += 1
End If
Next
Print "Seed values: ";
For i = 0 To seqCount-1
Print Trim(sequences(i, 0)); " ";
Next
Print !"\n\nIterations: "; highest
Print !"\nSample sequence:"
For i = 0 To highest-1
Print sequences(0, i)
Next
Sleep