67 lines
1.8 KiB
Text
67 lines
1.8 KiB
Text
Dim As String dict, word, domain, result, uniqueWords, w1, w2, w3
|
|
Dim As Integer i
|
|
Dim As String filename = "unixdict.txt"
|
|
'Dim As String filename = "mit.10000.words.txt"
|
|
|
|
Function REPLACE(original As String, find As String, replaceWith As String) As String
|
|
Dim As Integer posic
|
|
Dim As String result = original
|
|
|
|
Do
|
|
posic = Instr(result, find)
|
|
If posic = 0 Then Exit Do
|
|
result = Left(result, posic - 1) & replaceWith & Mid(result, posic + Len(find))
|
|
Loop
|
|
|
|
Return result
|
|
End Function
|
|
|
|
Function isUnique(word As String) As Boolean
|
|
Dim As Integer i, c, chars(255)
|
|
|
|
For i = 1 To Len(word)
|
|
c = Asc(Mid(word, i, 1))
|
|
If chars(c) Then Return False
|
|
chars(c) = 1
|
|
Next
|
|
|
|
Return True
|
|
End Function
|
|
|
|
Function TALLY (Byval s As String, Byval f As String) As Integer
|
|
Return (Len(s) - Len(REPLACE(s, f, ""))) / Len(f)
|
|
End Function
|
|
|
|
Open filename For Input As #1
|
|
dict = Input(Lof(1), #1)
|
|
Close #1
|
|
|
|
For i = 1 To Len(dict)
|
|
If Mid(dict, i, 1) = Chr(10) Then
|
|
If Len(word) = 3 And isUnique(word) Then domain &= word & Chr(10)
|
|
word = ""
|
|
Else
|
|
word &= Mid(dict, i, 1)
|
|
End If
|
|
Next i
|
|
|
|
For i = 1 To Len(domain)
|
|
If Mid(domain, i, 1) = Chr(10) Then
|
|
w2 = Right(w1, 2) & Left(w1, 1)
|
|
w3 = Right(w2, 2) & Left(w2, 1)
|
|
If TALLY(domain, w2 & Chr(10)) > 0 _
|
|
And TALLY(domain, w3 & Chr(10)) > 0 _
|
|
And TALLY(uniqueWords, w1 & Chr(10)) = 0 Then
|
|
result &= w1 & " " & w2 & " " & w3 & Chr(10)
|
|
uniqueWords &= w1 & Chr(10) & w2 & Chr(10) & w3 & Chr(10)
|
|
End If
|
|
w1 = ""
|
|
Else
|
|
w1 &= Mid(domain, i, 1)
|
|
End If
|
|
Next i
|
|
|
|
Print result
|
|
Print "Total words:"; TALLY(dict, Chr(10)); ", and"; TALLY(result, Chr(10)); " are circular."
|
|
|
|
Sleep
|