RosettaCodeData/Task/Semordnilap/FreeBASIC/semordnilap.basic

81 lines
2.0 KiB
Plaintext

' version 20-06-2015
' compile with: fbc -s console
Function reverse(norm As String) As String
Dim As String rev
Dim As Integer i, l = Len(norm) -1
rev = norm
For i = 0 To l
rev[l-i] = norm[i]
Next
Return rev
End Function
' ------=< MAIN >=------
Dim As Integer i, j, count, amount, ff = FreeFile
Dim As String in_str, rev, big = " " ' big needs to start with a space
Dim As String norm(27000), result(270, 2)
Print
Print "Start reading unixdict.txt";
Open "unixdict.txt" For Input As #ff
While Not Eof(ff) ' read to end of file
Line Input #ff, in_str ' get line = word
in_str = Trim(in_str) ' we don't want spaces
If Len(in_str) > 1 Then ' if length > 1 then reverse
rev = reverse(in_str)
If in_str <> rev Then ' if in_str is not a palingdrome
count = count + 1 ' increase counter
norm(count) = in_str ' store in the array
big = big + rev + " " ' create big string with reversed words
End If
End If
Wend
Close #ff
Print " ... Done"
Print : Print "Start looking for semordnilap"
For i = 1 To count
For j = 1 To amount ' check to avoid the double
If result(j, 2) = norm(i) Then Continue For, For
Next
j = InStr(big, " " + norm(i) + " ")
If j <> 0 Then ' found one
amount = amount + 1 ' increase counter
result(amount,1) = norm(i) ' store normal word
result(amount,2) = reverse(norm(i)) ' store reverse word
End If
Next
Print : Print "Found"; amount; " unique semordnilap pairs"
Print : Print "Display 5 semordnilap pairs"
Print
count = 0
For i = 1 To amount
If Len(result(i,1)) >= 5 Then
count = count + 1
Print result(i, 1), result(i, 2)
If count >= 5 Then Exit For
EndIf
Next
Print
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "Hit any key to end program"
Sleep
End