104 lines
2.5 KiB
Plaintext
104 lines
2.5 KiB
Plaintext
#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
|