RosettaCodeData/Task/De-Bruijn-sequences/FreeBASIC/de-bruijn-sequences.basic
2024-10-16 18:07:41 -07:00

135 lines
3.7 KiB
Text

#define DIGITS "0123456789"
' Funciones que agraga un elemento a un array dinámico
Sub AddToArray(arr() As Byte, value As Byte)
Redim Preserve arr(Ubound(arr) + 1)
arr(Ubound(arr)) = value
End Sub
Sub AddToArrayString(arr() As String, value As String)
Redim Preserve arr(Ubound(arr) + 1)
arr(Ubound(arr)) = value
End Sub
Sub DeBruijnHelper(k As Integer, n As Integer, a() As Byte, seq() As Byte, t As Integer, p As Integer)
Dim As Integer i, j
If t > n Then
If n Mod p = 0 Then
For i = 1 To p
Redim Preserve seq(Ubound(seq) + 1)
seq(Ubound(seq)) = a(i)
Next
End If
Else
a(t) = a(t - p)
DeBruijnHelper(k, n, a(), seq(), t + 1, p)
j = a(t - p) + 1
While j < k
a(t) = j
DeBruijnHelper(k, n, a(), seq(), t + 1, t)
j += 1
Wend
End If
End Sub
Function DeBruijn(k As Integer, n As Integer) As String
Dim As String alphabet = Left(DIGITS, k)
Dim As Byte a(k * n)
Dim As Byte seq()
DeBruijnHelper(k, n, a(), seq(), 1, 1)
Dim As String buf = ""
For i As Integer = 0 To Ubound(seq)
buf &= Mid(alphabet, seq(i) + 1, 1)
Next
Dim As String b = buf
Return b & Left(b, n - 1)
End Function
Function AllDigits(s As String) As Boolean
For i As Integer = 1 To Len(s)
Dim c As String = Mid(s, i, 1)
If c < "0" Orelse c > "9" Then Return False
Next
Return True
End Function
Sub Validate(db As String)
Dim As Integer i, n, lerr
Dim As Integer le = Len(db)
Dim As Integer found(9999)
Dim As String errs()
Dim As String s
' Check all strings of 4 consecutive digits within 'db'
' to see if all 10,000 combinations occur without duplication.
For i = 1 To le - 3
s = Mid(db, i, 4)
If AllDigits(s) Then
n = Val(s)
found(n) += 1
End If
Next
For i = 0 To 9999
If found(i) = 0 Then
Redim Preserve errs(Ubound(errs) + 1)
errs(Ubound(errs)) = " PIN number " & Right("0000" & i, 4) & " missing"
Elseif found(i) > 1 Then
Redim Preserve errs(Ubound(errs) + 1)
errs(Ubound(errs)) = " PIN number " & Right("0000" & i, 4) & " occurs " & found(i) & " times"
End If
Next
lerr = Ubound(errs) + 1
If lerr = 0 Then
Print " No errors found"
Else
s = Iif(lerr = 1, "", "s")
Print " "; lerr; " error"; s; " found:"
For i = 0 To Ubound(errs)
Print errs(i)
Next
End If
End Sub
Function Reverse(s As String) As String
Dim As Integer i
Dim As String arr()
For i = 1 To Len(s)
Redim Preserve arr(Ubound(arr) + 1)
arr(Ubound(arr)) = Mid(s, i, 1)
Next
Dim rev As String = ""
For i = Ubound(arr) To 0 Step -1
rev &= arr(i)
Next
Return rev
End Function
Sub main()
Dim As String bytes()
Dim As String db = DeBruijn(10, 4)
Dim As Integer i, le = Len(db)
Print "The length of the de Bruijn sequence is "; le
Print !"\nThe first 130 digits of the de Bruijn sequence are: "; Left(db, 130)
Print !"\nThe last 130 digits of the de Bruijn sequence are: "; Mid(db, le - 129, 130)
Print !"\nValidating the deBruijn sequence:"
Validate(db)
Print !"\nValidating the reversed deBruijn sequence:"
Validate(Reverse(db))
For i = 1 To Len(db)
Redim Preserve bytes(Ubound(bytes) + 1)
bytes(Ubound(bytes)) = Mid(db, i, 1)
Next
bytes(4443) = "."
db = ""
For i = 0 To Ubound(bytes)
db &= bytes(i)
Next
Print !"\nValidating the overlaid deBruijn sequence:"
Validate(db)
End Sub
main()
Sleep