Data update

Task/Burrows-Wheeler-transform/FreeBASIC/burrows-wheeler-transform.basic

@@ -0,0 +1,103 @@
+#define STX  Chr(&H2)
+#define ETX  Chr(&H3)
+
+Sub Sort(arr() As String)
+    Dim As Integer i, j, n
+    n = Ubound(arr) + 1
+    For i = 0 To n - 1
+        For j = i + 1 To n - 1
+            If arr(i) > arr(j) Then Swap arr(i), arr(j)
+        Next j
+    Next i
+End Sub
+
+Function Replace(Byval cadena As String, Byval subcadena As String, Byval reemplazaCon As String) As String
+    Dim As Integer posic = Instr(cadena, subcadena)
+    While posic <> 0
+        cadena = Left(cadena, posic - 1) & reemplazaCon & Mid(cadena, posic + Len(subcadena))
+        posic = Instr(posic + Len(reemplazaCon), cadena, subcadena)
+    Wend
+    Return cadena
+End Function
+
+Sub Rotate(s As String)
+    Dim As Integer longi = Len(s)
+    Dim As String t = Right(s, 1)
+    s = t & Left(s, longi - 1)
+End Sub
+
+Function BWT(s As String) As String
+    Dim As Integer i
+    For i = 1 To Len(s)
+        If Mid(s, i, 1) = STX Orelse Mid(s, i, 1) = ETX Then
+            Print "ERROR: String can't contain STX or ETX";
+            Exit Function
+        End If
+    Next i
+
+    Dim As String ss = STX & s & ETX
+    Dim As Integer longi = Len(ss)
+    Dim As String tabla(longi)
+
+    For i = 1 To longi
+        tabla(i) = ss
+        Rotate(ss)
+    Next i
+
+    Sort tabla()
+
+    Dim As String salida
+    For i = 1 To longi
+        salida &= Right(tabla(i), 1)
+    Next i
+
+    Return salida
+End Function
+
+Function Ibwt(r As String) As String
+    Dim As Integer i, j
+    Dim As Integer longi = Len(r)
+    Dim As String sa(1 To longi)
+    Dim As String tabla(Lbound(sa) To Ubound(sa))
+
+    For i = 1 To longi
+        For j = 1 To longi
+            tabla(j) = Mid(r, j, 1) & tabla(j)
+        Next j
+        Sort tabla()
+    Next i
+
+    For i = Lbound(tabla) To Ubound(tabla)
+        If Right(tabla(i), 1) = ETX Then Return Mid(tabla(i), 2, longi - 2)
+    Next i
+
+    Return ""
+End Function
+
+Function makePrintable(s As String) As String
+    Dim As String ls = s
+
+    For i As Integer = 1 To Len(ls)
+        Select Case Mid(ls, i, 1)
+        Case STX : Mid(ls, i, 1) = "^"
+        Case ETX : Mid(ls, i, 1) = "|"
+        End Select
+    Next i
+
+    Return ls
+End Function
+
+Dim As String tests(5) = { _
+"banana", "appellee", "dogwood", "TO BE OR NOT TO BE OR WANT TO BE OR NOT?", _
+"SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES", STX & "ABC" & ETX }
+
+For i As Integer = Lbound(tests) To Ubound(tests)
+    Print makePrintable(tests(i))
+    Print " --> ";
+    Dim As String t = BWT(tests(i))
+    Print makePrintable(t)
+    Dim As String r = iBWT(t)
+    Print " --> "; r; Chr(10); Chr(10);
+Next i
+
+Sleep