Anagrams
#1
Speed this up!

http://rosettacode.org/wiki/Anagrams

Append: BTW the link to the dictionary file from which the words are being found can be found from the Rosetta Code link above.

Code:
_TITLE "Searching for large sets of Anagrams with same characters, loading data..."
DIM w$(30000, 1): DIM SHARED er$: er$ = STR$(999999999)
index = 0: t = TIMER
OPEN "unixdict.txt" FOR INPUT AS #1
WHILE NOT (EOF(1))
   INPUT #1, wd$
   IF LEN(wd$) > 2 THEN index = index + 1: w$(index, 0) = wd$: w$(index, 1) = order$(wd$)
WEND
CLOSE #1
FOR i = 1 TO index - 1
   b$ = w$(i, 0): anaFlag = 0
   FOR j = i + 1 TO index
       IF w$(i, 1) = w$(j, 1) THEN b$ = b$ + ", " + w$(j, 0): anaFlag = anaFlag + 1
   NEXT
   IF anaFlag > 3 THEN PRINT b$
NEXT
PRINT "Done !!! "; TIMER - t
FUNCTION order$ (word$)
   DIM a(26)
   FOR i = 1 TO LEN(word$)
       ac = ASC(MID$(word$, i, 1)) - 96
       IF 0 < ac AND ac < 27 THEN a(ac) = a(ac) + 1 ELSE flag = 1
   NEXT
   b$ = ""
   FOR i = 1 TO 26: b$ = b$ + LTRIM$(STR$(a(i))): NEXT
   IF flag THEN er$ = STR$(VAL(er$) - 1)
   IF flag <> 1 THEN order$ = b$ ELSE order$ = er$
END FUNCTION


Attached Files Thumbnail(s)

B += x
Reply
#2
Sped up considerably with QSort:
Code:
_TITLE "Searching for large sets of Anagrams with same characters, loading data..."
DIM SHARED w$(30000): DIM SHARED er$: er$ = "999"
index = 0: t = TIMER
OPEN "unixdict.txt" FOR INPUT AS #1
WHILE NOT (EOF(1))
   INPUT #1, wd$
   IF LEN(wd$) > 2 THEN index = index + 1: w$(index) = order$(wd$) + "!" + wd$
WEND
CLOSE #1
QSort 0, index
FOR i = 1 TO index - 1
   IF first$(w$(i)) = first$(w$(i + 1)) AND flag THEN b$ = b$ + ", " + w2$(w$(i + 1)): cnt = cnt + 1
   IF first$(w$(i)) = first$(w$(i + 1)) AND flag = 0 THEN b$ = w2$(w$(i)) + ", " + w2$(w$(i + 1)): cnt = 2: flag = -1
   IF first$(w$(i)) <> first$(w$(i + 1)) THEN
       IF cnt > 4 THEN PRINT b$
       cnt = 0: b$ = "": flag = 0
   END IF
NEXT
PRINT "Done !!! "; TIMER - t

FUNCTION order$ (word$)
   DIM a(26)
   FOR i = 1 TO LEN(word$)
       ac = ASC(MID$(word$, i, 1)) - 96
       IF 0 < ac AND ac < 27 THEN a(ac) = a(ac) + 1 ELSE flag = 1
   NEXT
   b$ = ""
   FOR i = 1 TO 26: b$ = b$ + LTRIM$(STR$(a(i))): NEXT
   IF flag THEN er$ = STR$(VAL(er$) - 1)
   IF flag <> 1 THEN order$ = b$ ELSE order$ = er$
END FUNCTION

SUB QSort (Start, Finish)
   i = Start: j = Finish: x$ = w$(INT((i + j) / 2))
   WHILE i <= j
       WHILE w$(i) < x$: i = i + 1: WEND
       WHILE w$(j) > x$: j = j - 1: WEND
       IF i <= j THEN
           a$ = w$(i): w$(i) = w$(j): w$(j) = a$
           i = i + 1: j = j - 1
       END IF
   WEND
   IF j > Start THEN QSort Start, j
   IF i < Finish THEN QSort i, Finish
END SUB

FUNCTION first$ (wd$)
   first$ = MID$(wd$, 1, INSTR(wd$, "!") - 1)
END FUNCTION

FUNCTION w2$ (wd$)
   w2 = MID$(wd$, INSTR(wd$, "!") + 1)
END FUNCTION


Attached Files Thumbnail(s)

B += x
Reply
#3
Shaved off some more time:
Code:
_TITLE "Searching for large sets of Anagrams with same characters, loading data..."
'anagrams3 is starting to adapt to data,
'there are no 5 set anagrams of 3 letters nor of digits or apostrophes
'so they are not added to the word list to sort.
'The word coding has also been shortened.
'Multiple IF's reduced to IF THEN ELSEIF ELSE where ever possible.
'No calls to subs or functions except the recursive QSort routine.
DIM SHARED w$(24200)
index = 0: t = TIMER
OPEN "unixdict.txt" FOR INPUT AS #1
WHILE NOT (EOF(1))
   INPUT #1, wd$
   'don't bother with 3 letter words even though possibe to have 6 permutations there are none of 5 or more
   IF LEN(wd$) > 3 THEN
       REDIM a(26): flag = 0
       FOR i = 1 TO LEN(wd$)
           ac = ASC(MID$(wd$, i, 1)) - 96
           IF 0 < ac AND ac < 27 THEN a(ac) = a(ac) + 1 ELSE flag = 1: EXIT FOR
       NEXT
       'don't code and store a word unless all letters, no digits or apostrophes
       IF flag = 0 THEN
           b$ = "": zc = 0
           'zc zero counts replaces strings of 0's with a letter according to how many in string
           'this shortens the strings considerably before the sort
           FOR i = 1 TO 26
               IF a(i) = 0 THEN
                   zc = zc + 1
               ELSE
                   IF zc > 0 THEN b$ = b$ + CHR$(96 + zc): zc = 0
                   b$ = b$ + LTRIM$(STR$(a(i)))
               END IF
           NEXT
           index = index + 1
           w$(index) = b$ + "!" + wd$
       END IF
   END IF
WEND
CLOSE #1
QSort 0, index
flag = 0
FOR i = 1 TO index - 1
   IF MID$(w$(i), 1, INSTR(w$(i), "!") - 1) <> MID$(w$(i + 1), 1, INSTR(w$(i + 1), "!") - 1) THEN
       IF cnt > 4 THEN PRINT b$
       cnt = 0: b$ = "": flag = 0
   ELSEIF flag THEN
       b$ = b$ + ", " + MID$(w$(i + 1), INSTR(w$(i + 1), "!") + 1): cnt = cnt + 1

   ELSE
       b$ = MID$(w$(i), INSTR(w$(i), "!") + 1) + ", " + MID$(w$(i + 1), INSTR(w$(i + 1), "!") + 1): cnt = 2: flag = -1
   END IF
NEXT
PRINT "Done !!! "; TIMER - t

SUB QSort (Start, Finish)
   i = Start: j = Finish: x$ = w$(INT((i + j) / 2))
   WHILE i <= j
       WHILE w$(i) < x$: i = i + 1: WEND
       WHILE w$(j) > x$: j = j - 1: WEND
       IF i <= j THEN
           a$ = w$(i): w$(i) = w$(j): w$(j) = a$
           i = i + 1: j = j - 1
       END IF
   WEND
   IF j > Start THEN QSort Start, j
   IF i < Finish THEN QSort i, Finish
END SUB

Oh look, they are in alpha order again!


Attached Files Thumbnail(s)

B += x
Reply
#4
nice! can this be extended to find anagram sentences?
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
Reply
#5
RE: Anagram sentences possible?

Sure, absolutely! 

But the point of this thread was to find fastest most elegant code to answer the Rosetta Code challenge. I was attempting a version in QB64. 

For me, it is like the Phillips tutorial to speed up Mandelbrot. 

I was hoping people would pitch in and show off their tricks with memory.

It would be cool to see QB64 represented at Rosetta Code.
B += x
Reply
#6
Yeah! I have below the 1 sec mile stone!

Code:
_TITLE "Rosetta Code Anagrams: mod #4 by bplus 2017-12-07"
'anagrams4 the word coding has also been shortened again!
'GET file in one gulp = buf$ and then find words
'Multiple IF's reduced to IF THEN ELSEIF ELSE where ever possible.
'No calls to subs or functions except the recursive QSort routine.
'FOR... NEXT replaced with WHILE... WEND
DIM SHARED w$(24200)
index = 0: t = TIMER
OPEN "unixdict.txt" FOR BINARY AS #1
fl = LOF(1): buf$ = SPACE$(fl)
GET #1, , buf$
CLOSE #1
p = 1
WHILE p < fl
   np = INSTR(p, buf$, CHR$(10))
   wd$ = MID$(buf$, p, np - p)
   IF LEN(wd$) > 2 THEN
       REDIM a(26): flag = 0: i = 1
       WHILE i <= LEN(wd$)
           ac = ASC(MID$(wd$, i, 1)) - 96
           IF 0 < ac AND ac < 27 THEN a(ac) = a(ac) + 1 ELSE flag = 1: EXIT WHILE
           i = i + 1
       WEND
       'don't code and store a word unless all letters, no digits or apostrophes
       IF flag = 0 THEN
           b$ = "": i = 1
           WHILE i < 27
               IF a(i) <> 0 THEN b$ = b$ + STRING$(a(i), CHR$(96 + i))
               i = i + 1
           WEND
           index = index + 1
           w$(index) = b$ + "!" + wd$
       END IF
   END IF
   IF np THEN p = np + 1 ELSE p = fl
WEND
QSort 0, index
flag = 0
WHILE i < index
   IF MID$(w$(i), 1, INSTR(w$(i), "!") - 1) <> MID$(w$(i + 1), 1, INSTR(w$(i + 1), "!") - 1) THEN
       IF cnt > 4 THEN PRINT b$
       cnt = 0: b$ = "": flag = 0
   ELSEIF flag THEN
       b$ = b$ + ", " + MID$(w$(i + 1), INSTR(w$(i + 1), "!") + 1): cnt = cnt + 1
   ELSE
       b$ = MID$(w$(i), INSTR(w$(i), "!") + 1) + ", " + MID$(w$(i + 1), INSTR(w$(i + 1), "!") + 1): cnt = 2: flag = -1
   END IF
   i = i + 1
WEND
PRINT "Done !!! "; TIMER - t

SUB QSort (Start, Finish)
   i = Start: j = Finish: x$ = w$(INT((i + j) / 2))
   WHILE i <= j
       WHILE w$(i) < x$: i = i + 1: WEND
       WHILE w$(j) > x$: j = j - 1: WEND
       IF i <= j THEN
           a$ = w$(i): w$(i) = w$(j): w$(j) = a$
           i = i + 1: j = j - 1
       END IF
   WEND
   IF j > Start THEN QSort Start, j
   IF i < Finish THEN QSort i, Finish
END SUB

EDIT: I changed the word length checks to > 2 letters from > 3, apparently it doesn't take significantly longer time to check all words 3 letters long with the rest. Even though I know there are NOT any 3 letter words with an anagram set of 5 or more, it might be a kind of cheat to use that info. Theoretically a 3 letter word could have total of 6 permutations, all words in unixdict.txt. Screen shot shows new time (pretty much same as previous screen shot before edit.)


Attached Files Thumbnail(s)

B += x
Reply
#7
Can you make some Palindromes too??
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#8
Hi Erik,

That sounds like fun! I will get right on that. Smile

I tried Steve's Mem Sort to see if it would work faster than the QSort and though it worked, it was not faster. It did require fixed length strings and the longest word was 22 characters. So I had to fix the length of the array to sort at 45 the longest word *2 + 1 for the coding divider between the coded word and the actual word. As I recall it took over a sec. Then I tried for a fixed length of 11, yes much faster and I think all the correct answers did appear with all the extra garbage that was printed . 82 secs, still not faster!

So unless there is a faster way to sort a variable length string array, I am done with this Rosetta Code challenge.

There might be a faster sort because the version of QSort I used is recursive and I've heard that isn't always the fastest.
B += x
Reply
#9
hi bplus,

I tried running anagrams4.bas but it doesn't print out any words. Only a timing that's close to zero seconds.
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
Reply
#10
Hi Adrian,

I am shaking my head, not a single indication that no file has been loaded, the whole thing runs fine whether there is a file to check or not. But hey! look at the time! (see screen shot)

So my guess is you are running this without getting the file from Rosetta Code link at start of this thread.

Just for you, here is unixdict.txt, 25104 words.

I used same file for Palindromes.


Attached Files Thumbnail(s)

.txt   unixdict.txt (Size: 201.57 KB / Downloads: 6)
B += x
Reply
#11
Oh criminy! the most obvious speed trick of them all, proper types!

Code:
_TITLE "Rosetta Code Anagrams: mod #4.1 by bplus 2017-12-08"
'anagrams4_1 oh hey integers and other exact types
'anagrams4 the word coding has also been shortened again!
'GET file in one gulp = buf$ and then find words
'Multiple IF's reduced to IF THEN ELSEIF ELSE where ever possible.
'No calls to subs or functions except the recursive QSort routine.
'FOR... NEXT replaced with WHILE... WEND
DEFINT A-Z
DIM SHARED w$(25100)
index = 0: t! = TIMER
OPEN "unixdict.txt" FOR BINARY AS #1
fl& = LOF(1): buf$ = SPACE$(fl&
GET #1, , buf$
CLOSE #1
p& = 1
WHILE p& < fl&
   np& = INSTR(p&, buf$, CHR$(10))
   wd$ = MID$(buf$, p&, np& - p&
   IF LEN(wd$) > 2 THEN
       REDIM a(26): flag = 0: i = 1
       WHILE i <= LEN(wd$)
           ac = ASC(MID$(wd$, i, 1)) - 96
           IF 0 < ac AND ac < 27 THEN a(ac) = a(ac) + 1 ELSE flag = 1: EXIT WHILE
           i = i + 1
       WEND
       'don't code and store a word unless all letters, no digits or apostrophes
       IF flag = 0 THEN
           b$ = "": i = 1
           WHILE i < 27
               IF a(i) <> 0 THEN b$ = b$ + STRING$(a(i), CHR$(96 + i))
               i = i + 1
           WEND
           index = index + 1
           w$(index) = b$ + "!" + wd$
       END IF
   END IF
   IF np& THEN p& = np& + 1 ELSE p& = fl&
WEND
QSort 0, index
flag = 0
WHILE i < index
   IF MID$(w$(i), 1, INSTR(w$(i), "!") - 1) <> MID$(w$(i + 1), 1, INSTR(w$(i + 1), "!") - 1) THEN
       IF cnt > 4 THEN PRINT b$
       cnt = 0: b$ = "": flag = 0
   ELSEIF flag THEN
       b$ = b$ + ", " + MID$(w$(i + 1), INSTR(w$(i + 1), "!") + 1): cnt = cnt + 1
   ELSE
       b$ = MID$(w$(i), INSTR(w$(i), "!") + 1) + ", " + MID$(w$(i + 1), INSTR(w$(i + 1), "!") + 1): cnt = 2: flag = -1
   END IF
   i = i + 1
WEND
PRINT "Done !!! "; TIMER - t!

SUB QSort (Start, Finish)
   i = Start: j = Finish: x$ = w$(INT((i + j) / 2))
   WHILE i <= j
       WHILE w$(i) < x$: i = i + 1: WEND
       WHILE w$(j) > x$: j = j - 1: WEND
       IF i <= j THEN
           a$ = w$(i): w$(i) = w$(j): w$(j) = a$
           i = i + 1: j = j - 1
       END IF
   WEND
   IF j > Start THEN QSort Start, j
   IF i < Finish THEN QSort i, Finish
END SUB


Attached Files Thumbnail(s)

B += x
Reply
#12
hi bplus,

Thanks for the mod, I think some closed brackets are missing on lines 12 and 18 in your code snippet.
Yes, I downloaded the Unixdict.txt file and anagram1.bas to anagram3.bas worked fine.
However, I'm still not seeing words printed for anagram4.1, only "Done!!! 0.0546785"

Cheers!
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
Reply
#13
Hi Adrian and all, 

I tried running the a copy / paste of Anagrams4_1.bas with lines 12 and 18 corrected on build /82 and Walter's QB64 both worked fine. Do you use Windows?

Here is a zip copy of my State of Art Anagram programs 4_1 and 6 with a non recursive Quick Sort and $CHECKINGShockedFF both the source code and exe's are included with the txt file.

On my machine I am getting around .6 secs for 4_1 and  <.5 to <.6 for Anagrams6.exe.

What kind of results do you get?


Attached Files .zip   anagram package.zip (Size: 1.09 MB / Downloads: 5)
B += x
Reply
#14
Hi bplus,

Thanks. Everything works fine now. My timing for 4_1 and 6 is 0.109375 secs
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
Reply
#15
Thanks Adrian, I appreciate the feedback!
B += x
Reply
#16
Hi Adrian and all, 

I had reworked Anagrams employing several lessons from Steve's example and my version is now down to under .4 secs (when take average in 100 runs) on my dinosaur thanks to his example! I have more thoroughly commented the code and used more self documenting variable names to help tell the story of what is going on. But I was blown away by Steve's version, I didn't think it necessary to post my latest version which I think I would prefer to represent QB64 at Rosetta Code, if Steve's example were to be accompanied by a much slower version. I leave this in Adrian's court since he got the ball going with Rosetta Code way sooner than I was expecting. I think Steve's version "wins" getting the most impressive results and btw I think the output should be posted with his code.

Code:
$CHECKING:OFF
' Warning: Keep the above line commented out until you know your newly edited code works.
'          You can NOT stop a program in mid run (using top right x button) with checkng off.
'
_TITLE "Rosetta Code Anagrams: mod Waltersmind's - Single Color LED sign with scrolling letters Best times yet w/o memory techniques by bplus 2017-12-12"
' This program now below .4 secs for average time to do 100 loops compared to 92 secs for 1
' loop on my "dinosaur" when I first coded a successful run.
'
' Steve McNeil at QB64.net has +7000 loops per sec on his machine with help of using
' memory techniques.  see page 3 @  http://www.qb64.net/forum/index.php?topic=14622.30
'
' Thanks Steve! I learned allot and am NOW very motivated to learn memory techniques.
'
' This program has timings for 1 loop broken into sections currently commented out and another
' set of timings for multiple loop testing currently set, now at 100 tests for a sort of average.
' But average is misleading, the first test is usually always the longest and really only one test
' is necessary to get the results from a data file that does not change.
'
' Breaking code into logical sections and timing those can help spot trouble areas or the difference
' in a small or great change.
'
' Here is review of speed tips commented as they occur in code:
'
DEFINT A-Z 'there are 25,105 words in the unixdict.txt file so main array index
'           and pointers in sort can all be integers.

' The letters from a word read in from the dictionary file (really just a word list in alpha order)
' are to be counted and coded into an alpha order sequence of letters:
'       eg.  eilv is the same code for words: evil, levi, live, veil, vile
' The longest word in the file had 22 letters, they are all lower case but there are other symbols
' in file like ' and digits we want to filter out.
TYPE wordData
    code AS STRING * 22
    theWord AS STRING * 22
END TYPE
' I originally was coding a word into the whole list (array) of letter counts as a string.
' Then realized I could drop all the zeros if I converted the numbers back to letters.
' I then attached THE word to the end of the coded word using ! to separate the 2 sections.
' That was allot of manipulation with INSTR to find the ! separator and then MID$ to extract the
' code or THE word when I needed the value. All this extra manipulation ended by using TYPE with
' the code part and the word part sharing the same index. Learned from Steve's example!

' Pick the lowest number type needed to cover the problem
DIM SHARED w(25105) AS wordData '  the main array
DIM anagramSetsCount AS _BYTE ' the Rosetta Code Challenge was to find only the largest sets of Anagrams
DIM codeCount AS _BYTE ' counting number of words with same code
DIM wordIndex AS _BYTE
DIM wordLength AS _BYTE
DIM flag AS _BIT 'flag used as true or false
DIM letterCounts(1 TO 26) AS _BYTE 'stores letter counts for coding word
' b$  always stands for building a string.
' For long and strings, I am using the designated suffix

t1# = TIMER: loops = 100
FOR test = 1 TO loops
    'reset these for multiple loop tests
    indexTop = 0 'indexTop for main data array
    anagramSetsCount = 0 'anagrams count if exceed 4 for any one code
    anagramList$ = "" 'list of anagrams

    'get the file data loaded in one pop, disk access is slow!
    OPEN "unixdict.txt" FOR BINARY AS #1
    ' http://www.puzzlers.org/pub/wordlists/unixdict.txt
    ' note: when I downloaded this file line breaks were by chr$(10) only.
    ' Steve had coded for either chr$(13) + chr$(10) or just chr$(10)

    fileLength& = LOF(1): buf$ = SPACE$(fileLength&)
    GET #1, , buf$
    CLOSE #1
    ' Getting the data into a big long string saved allot of time as compared to
    ' reading from the file line by line.

    'Process the file data by extracting the word from the long file string and then
    'coding each word of interest, loading up the w() array.
    filePosition& = 1
    WHILE filePosition& < fileLength&
        nextPosition& = INSTR(filePosition&, buf$, CHR$(10))
        wd$ = MID$(buf$, filePosition&, nextPosition& - filePosition&)
        wordLength = LEN(wd$)
        IF wordLength > 2 THEN
            'From Steve's example, changing from REDIM to ERASE saved an amzing amount of time!
            ERASE letterCounts: flag = 0: wordIndex = 1
            WHILE wordIndex <= wordLength
                'From Steve's example, I was not aware of this version of ASC with MID$ built-in
                ansciChar = ASC(wd$, wordIndex) - 96
                IF 0 < ansciChar AND ansciChar < 27 THEN letterCounts(ansciChar) = letterCounts(ansciChar) + 1 ELSE flag = 1: EXIT WHILE
                wordIndex = wordIndex + 1
            WEND
            'don't code and store a word unless all letters, no digits or apostrophes
            IF flag = 0 THEN
                b$ = "": wordIndex = 1
                WHILE wordIndex < 27
                    IF letterCounts(wordIndex) THEN b$ = b$ + STRING$(letterCounts(wordIndex), CHR$(96 + wordIndex))
                    wordIndex = wordIndex + 1
                WEND
                indexTop = indexTop + 1
                w(indexTop).code = b$
                w(indexTop).theWord = wd$
            END IF
        END IF
        IF nextPosition& THEN filePosition& = nextPosition& + 1 ELSE filePosition& = fileLength&
    WEND
    't2# = TIMER
    'PRINT t2# - t1#; " secs to load word array."

    'Sort using a recursive Quick Sort routine on the code key of wordData Type defined.
    QSort 0, indexTop
    't3# = TIMER
    'PRINT t3# - t2#; " secs to sort array."

    'Now find all the anagrams, word permutations, from the same word "code" that we sorted by.
    flag = 0: j = 0
    WHILE j < indexTop
        'Does the sorted code key match the next one on the list?
        IF w(j).code <> w(j + 1).code THEN ' not matched so stop counting and add to report
            IF codeCount > 4 THEN ' only want the largest sets of anagrams 5 or more
                anagramList$ = anagramList$ + b$ + CHR$(10)
                anagramSetsCount = anagramSetsCount + 1
            END IF
            codeCount = 0: b$ = "": flag = 0
        ELSEIF flag THEN ' match and match flag set so just add to count and build set
            b$ = b$ + ", " + RTRIM$(w(j + 1).theWord)
            codeCount = codeCount + 1
        ELSE ' no flag means first match, start counting and building a new set
            b$ = RTRIM$(w(j).theWord) + ", " + RTRIM$(w(j + 1).theWord)
            codeCount = 2: flag = 1
        END IF
        j = j + 1
    WEND
    't4# = TIMER
    'PRINT t4# - t3#; " secs to count matches from array."
NEXT
PRINT "Ave time per loop"; (TIMER - t1#) / loops; " secs, there were"; anagramSetsCount; " anagrams sets of 5 or more words."
PRINT anagramList$

'This sub modified for wordData Type, to sort by the .code key, the w() array is SHARED
SUB QSort (Start, Finish)
    i = Start: j = Finish: x$ = w(INT((i + j) / 2)).code
    WHILE i <= j
        WHILE w(i).code < x$: i = i + 1: WEND
        WHILE w(j).code > x$: j = j - 1: WEND
        IF i <= j THEN
            SWAP w(i), w(j)
            i = i + 1: j = j - 1
        END IF
    WEND
    IF j > Start THEN QSort Start, j
    IF i < Finish THEN QSort i, Finish
END SUB
B += x
Reply
#17
hi bplus,

I have updated the entry in Rosetta Code with your latest version, and also added output from Steve's program.

Cheers!
A.
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
Reply
#18
That's a lot of mentions of my name up there in your code, Bp.  BlushBlushBlush

I had no idea that anyone had actually studied it that close, or that anyone had learned so many little things from it.  Nice to see that some people actually do take such interest in some of my stuff, and it's nice to know that I actually helped somebody, somewhere, learn and improve their understanding of the language better.  

I'm happy I could be of assistance.  Wink
Reply