RosettaCodeData/Task/Anagrams/RapidQ/anagrams.rapidq
2015-02-20 00:35:01 -05:00

63 lines
1.6 KiB
Text

dim x as integer, y as integer
dim SortX as integer
dim StrOutPut as string
dim Count as integer
dim MaxCount as integer
dim AnaList as QStringlist
dim wordlist as QStringlist
dim Templist as QStringlist
dim Charlist as Qstringlist
function sortChars(expr as string) as string
Charlist.clear
for SortX = 1 to len(expr)
Charlist.AddItems expr[SortX]
next
charlist.sort
result = Charlist.text - chr$(10) - chr$(13)
end function
'--- Start main code
wordlist.loadfromfile ("unixdict.txt")
'create anagram list
for x = 0 to wordlist.itemcount-1
AnaList.AddItems sortChars(wordlist.item(x))
next
'Filter largest anagram lists
analist.sort
MaxCount = 0
for x = 0 to AnaList.Itemcount-1
Count = 0
for y = x+1 to AnaList.Itemcount-1
if AnaList.item(y) = AnaList.item(x) then
inc(count)
else
if count > MaxCount then
Templist.clear
MaxCount = Count
Templist.AddItems AnaList.item(x)
elseif count = MaxCount then
Templist.AddItems AnaList.item(x)
end if
exit for
end if
next
next
'Now get the words
for x = 0 to Templist.Itemcount-1
for y = 0 to wordlist.Itemcount-1
if Templist.item(x) = sortChars(wordlist.item(y)) then
StrOutPut = StrOutPut + wordlist.item(y) + " "
end if
next
StrOutPut = StrOutPut + chr$(13) + chr$(10)
next
ShowMessage StrOutPut
End