58 lines
1.5 KiB
Text
58 lines
1.5 KiB
Text
Function Isogram(word As String) As String
|
|
Dim As Integer i, k
|
|
Dim As String ch, chars = ""
|
|
Dim As Integer counts(26) '= {0}
|
|
|
|
For i = 1 To Len(word)
|
|
ch = Mid(word, i, 1)
|
|
k = Instr(chars, ch)
|
|
If k = 0 Then
|
|
chars &= ch
|
|
counts(Len(chars)) = 1
|
|
Else
|
|
counts(k) += 1
|
|
End If
|
|
Next
|
|
|
|
Dim As Integer c1 = counts(1), lc = Len(chars), lw = Len(word)
|
|
Dim As Integer isEqual = 1
|
|
For i = 1 To lc
|
|
If counts(i) <> c1 Then
|
|
isEqual = 0
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
Return Iif((c1 > 1 Or lw > 10) And isEqual, word & " " & Str(c1) & " " & Str(lw), "")
|
|
End Function
|
|
|
|
Dim As String res = ""
|
|
Dim As String word
|
|
Dim As Integer i, j
|
|
Dim As String results(1000) ' Assuming a maximum of 1000 words
|
|
Dim As Integer count = 0
|
|
|
|
Open "i:\unixdict.txt" For Input As #1
|
|
Do Until Eof(1)
|
|
Line Input #1, word
|
|
Dim As String result = Isogram(word)
|
|
If result <> "" Then
|
|
results(count) = result
|
|
count += 1
|
|
End If
|
|
Loop
|
|
Close #1
|
|
|
|
Print "word n length"
|
|
For i = 0 To count - 1
|
|
Dim As String result = results(i)
|
|
Dim As Integer space1 = Instr(result, " ")
|
|
Dim As Integer space2 = Instr(Mid(result, space1 + 1), " ") + space1
|
|
|
|
word = Left(result, space1 - 1)
|
|
Dim As Integer c1 = Val(Mid(result, space1 + 1, space2 - space1 - 1))
|
|
Dim As Integer lw = Val(Mid(result, space2 + 1))
|
|
Print Using "\ \ ## ######"; word; c1; lw
|
|
Next i
|
|
|
|
Sleep
|