RosettaCodeData/Task/Anagrams/Liberty-BASIC/anagrams.basic

72 lines
1.6 KiB
Plaintext

' count the word list
open "unixdict.txt" for input as #1
while not(eof(#1))
line input #1,null$
numWords=numWords+1
wend
close #1
'import to an array appending sorted letter set
open "unixdict.txt" for input as #1
dim wordList$(numWords,3)
dim chrSort$(45)
wordNum=1
while wordNum<numWords
line input #1,actualWord$
wordList$(wordNum,1)=actualWord$
wordList$(wordNum,2)=sorted$(actualWord$)
wordNum=wordNum+1
wend
'sort on letter set
sort wordList$(),1,numWords,2
'count and store number of anagrams found
wordNum=1
startPosition=wordNum
numAnagrams=0
currentChrSet$=wordList$(wordNum,2)
while wordNum < numWords
while currentChrSet$=wordList$(wordNum,2)
numAnagrams=numAnagrams+1
wordNum=wordNum+1
wend
for n= startPosition to startPosition+numAnagrams
wordList$(n,3)=right$("0000"+str$(numAnagrams),4)+wordList$(n,2)
next
startPosition=wordNum
numAnagrams=0
currentChrSet$=wordList$(wordNum,2)
wend
'sort on number of anagrams+letter set
sort wordList$(),numWords,1,3
'display the top anagram sets found
wordNum=1
while wordNum<150
currentChrSet$=wordList$(wordNum,2)
print "Anagram set";
while currentChrSet$=wordList$(wordNum,2)
print " : ";wordList$(wordNum,1);
wordNum=wordNum+1
wend
print
currentChrSet$=wordList$(wordNum,2)
wend
close #1
end
function sorted$(w$)
nchr=len(w$)
for chr = 1 to nchr
chrSort$(chr)=mid$(w$,chr,1)
next
sort chrSort$(),1,nchr
sorted$=""
for chr = 1 to nchr
sorted$=sorted$+chrSort$(chr)
next
end function