WordCracker

[Zeppelin]

Hey,
I run into a issue with my program.
Im trying to make a program that will, when given a string of 9 letters and 1 key letter to print out all the possible words using these letters.
For example:
9 Letters: ABCDEFGHI
Key Letter: A
PRINTS:
BAD
CAB
DEAF
etc....

I am using a .txt database full of words from the Oxford dictionary and each time I run the program nothing is output. I cant find the issue.

Thanks,
Zeppelin

Ps. The program and wordlist are attached below.

[SMcNeill]

http://qb64.freeforums.net/thread/42/scrabble-word-maker -- Sounds like what you're wanting is basically the same thing I've did here.  Give it a look and see if it helps.

[bplus]

Code: QB64: [Select]

1. 'SPLIT UP LETTERS
2. FOR n = 1 TO 9
3.     ltr$(n) = MID$(in$, n, 1)
4. NEXT n
5. PRINT LEN(ltr$)  '>>>>>>>>>>>> 0 !!!
6. END
7.  

Code: QB64: [Select]

1.             FOR x = 1 TO LEN(in$)  '<<<<<<<<<<<<<<<<<<<<<<< change to this?
2.                 IF ltr$(x) = templtr$ THEN
3.                     ltr$(x) = ""
4.                     count = count + 1
5.                 END IF
6.             NEXT x
7.  

OH!!! This is screwing you up too!

Code: QB64: [Select]

1.     FOR n = 1 TO 9
2.         ltr$(n) = MID$(in$, n, 1)
3.     NEXT n

You are using n for the word index from the file, and then changing n here when resetting ltr$() array!!!

[bplus]

OK now get stuff printed in reasonable time!

Code: QB64: [Select]

1.  
2. DIM word$(84100)
3. DIM key$
4. DIM SHARED ltr$(9)  '<<<<<<<<<<< shared to debug
5.  
6. 'SET KEY AND LETTERS
7. key$ = "a"
8. in$ = "abcdefghi"
9. lenin = LEN(in$) '<<<<<<<<<<< for faster processing
10.  
11. 'SPLIT UP LETTERS
12. FOR n = 1 TO 9
13.     ltr$(n) = MID$(in$, n, 1)
14. NEXT n
15.  
16. 'LOAD ALL WORDS FROM .TXT FILE
17. PRINT "LOADING...."
18. OPEN "WordList.txt" FOR INPUT AS #1  '<<<<<<<<< moved to more appropriate place
19. WHILE NOT EOF(1)
20.     filecount = filecount + 1
21.     INPUT #1, line$
22.     word$(filecount) = line$
23. WEND
24. CLOSE #1
25. CLS
26.  
27.  
28. 'RUN THROUGH WORDS
29. FOR n = 1 TO filecount
30.     findkey = INSTR(word$(n), key$)
31.  
32.     IF findkey THEN
33.         FOR i = 1 TO LEN(word$(n))
34.             templtr$ = MID$(word$(n), i, 1)
35.             FOR x = 1 TO lenin '<<<<<<<<<<<<<<<<< main fix #1
36.                 IF ltr$(x) = templtr$ THEN
37.                     ltr$(x) = ""
38.                     count = count + 1
39.                 END IF
40.                 'debugging
41.                 'PRINT "Update: file word = "; word$(n); " and here is current letters crossed off: "; letters$
42.                 'INPUT "OK press enter... "; wate$
43.             NEXT x
44.         NEXT i
45.  
46.         IF count = LEN(word$(n)) THEN
47.             PRINT word$(n)
48.         END IF
49.     END IF
50.  
51.     FOR m = 1 TO 9  'main fix #2 n's  to m's
52.         ltr$(m) = MID$(in$, m, 1)
53.     NEXT m
54.     count = 0
55. NEXT n
56.  
57. PRINT "DONE..."
58.  
59. 'for debugging
60. FUNCTION letters$ ()
61.     FOR i = 1 TO 9
62.         b$ = b$ + ltr$(i)
63.     NEXT
64.     letters$ = "*" + b$ + "*"
65. END FUNCTION
66.  

DONE? Looks like the logic was OK, just the variable assignments needed fixing.

[codeguy]

Gives you every permutation of letters, numbers, etc. If parray() is ordered, so is the output.

Code: QB64: [Select]

1. WIDTH 80, 43
2. DIM parray(0 TO 3) AS LONG
3. FOR i = 0 TO UBOUND(parray)
4.     parray(i) = i
5. NEXT
6. PRINT
7. PRINT
8. PRINT "permutations"
9. Permute parray(), 0, UBOUND(parray), np
10. DO
11.     x$ = INKEY$
12. LOOP UNTIL x$ > ""
13. SYSTEM
14.  
15. SUB DisplayResults (PArray() AS LONG, start, finish, np AS DOUBLE)
16. DIM i AS LONG
17. PRINT USING "#,###,###,###,###"; np;
18. FOR i = LBOUND(parray) TO UBOUND(parray)
19.     PRINT PArray(i);
20. NEXT
21. PRINT
22. END SUB
23.  
24. SUB Rotate (parray() AS LONG, Start AS LONG, finish AS LONG)
25. DIM ts AS LONG
26. ts = parray(Start)
27. FOR i = Start TO finish - 1
28.     SWAP parray(i), parray(i + 1)
29. NEXT
30. parray(finish) = ts
31. END SUB
32.  
33. SUB Permute (parray() AS LONG, start AS LONG, finish AS LONG, np AS DOUBLE)
34. np = np + 1
35. DisplayResults parray(), LBOUND(parray), UBOUND(parray), np
36. IF start < finish THEN
37.     DIM i AS LONG
38.     DIM j AS LONG
39.     FOR i = finish - 1 TO start STEP -1
40.         FOR j = i + 1 TO finish
41.             SWAP parray(i), parray(j)
42.             Permute parray(), i + 1, finish, np
43.         NEXT
44.         Rotate parray(), i, finish
45.     NEXT
46. END IF
47. END SUB
48.  

[bplus]

Hi codeguy,

I thought about permutations and then thought nah! won't work with real words at varying lengths.

But I could be wrong, wouldn't be first time.

Wanna race? You modify your code for checking for real words and I will see if I can optimize Zeppellin's code some more.... post in 24 hours?

[SMcNeill]

Hi codeguy,

I thought about permutations and then thought nah! won't work with real words at varying lengths.

But I could be wrong, wouldn't be first time.

Wanna race? You modify your code for checking for real words and I will see if I can optimize Zeppellin's code some more.... post in 24 hours?

Here's how I'd go, I think:

First, reduce the word list to exclude any words > 9 digits.  No need to search for impossible combinations.
Then count letters.  Save these in an array WordLetters(1 TO WordCount,1 TO 26).

Then count letters in the target word.
Compare.  If target count > word count then it's a match!

************************
The word list is going to be rather limited (less than 50k words I'd imagine), and most searches will terminate rather quickly.  (need an "A", don't have any?  Quit the search at this point.) 

I really don't think you'd need to worry about optimizing for speed any more than that, to be honest.

[bplus]

Hi codeguy,

I thought about permutations and then thought nah! won't work with real words at varying lengths.

But I could be wrong, wouldn't be first time.

Wanna race? You modify your code for checking for real words and I will see if I can optimize Zeppellin's code some more.... post in 24 hours?

Here's how I'd go, I think:

First, reduce the word list to exclude any words > 9 digits.  No need to search for impossible combinations.
Then count letters.  Save these in an array WordLetters(1 TO WordCount,1 TO 26).

Then count letters in the target word.
Compare.  If target count > word count then it's a match!

************************
The word list is going to be rather limited (less than 50k words I'd imagine), and most searches will terminate rather quickly.  (need an "A", don't have any?  Quit the search at this point.) 

I really don't think you'd need to worry about optimizing for speed any more than that, to be honest.

Hmm... I think you are saying permutations is slower too?

I am thinking this part:

Code: QB64: [Select]

1. 'SET KEY AND LETTERS
2. key$ = "a"
3. in$ = "abcdefghi"
4. lenin = LEN(in$) '<<<<<<<<<<< for faster processing
5.  

key$ and in$ might be input into the program at run time, so the letters might not be nine and in$ might be real words too not segments of the alphabet. That's how I would use this code for word games or word game solving. And the real words might have 2 or 3 of the same letters. I was planning on optimizing for such events.

[SMcNeill]

Here's an easy fix for you to optimize your code and run it faster.  (An increase of about 15x faster on my machine.) 

I'll post 2 routines here so you can run them and compare for speed differences:

YOURS (modified to loop and run for a set amount of time -- 5 seconds in this case):

Code: QB64: [Select]

1. DIM word$(84100)
2. DIM key$
3. DIM SHARED ltr$(9) '<<<<<<<<<<< shared to debug
4.  
5. 'SET KEY AND LETTERS
6. key$ = "a"
7. in$ = "abcdefghi"
8. lenin = LEN(in$) '<<<<<<<<<<< for faster processing
9.  
10. 'SPLIT UP LETTERS
11. FOR n = 1 TO 9
12.     ltr$(n) = MID$(in$, n, 1)
13. NEXT n
14.  
15.  
16.  
17. 'LOAD ALL WORDS FROM .TXT FILE
18. PRINT "LOADING...."
19. OPEN "WordList.txt" FOR INPUT AS #1 '<<<<<<<<< moved to more appropriate place
20. filecount = 0
21. WHILE NOT EOF(1)
22.     filecount = filecount + 1
23.     INPUT #1, line$
24.     word$(filecount) = line$
25. WEND
26. CLOSE #1
27.  
28.  
29. t# = TIMER
30.  
31. timelimit = 5
32. DO UNTIL TIMER > t# + timelimit
33.     CLS
34.     loopsran = loopsran + 1
35.  
36.  
37.  
38.     'RUN THROUGH WORDS
39.     FOR n = 1 TO filecount
40.         findkey = INSTR(word$(n), key$)
41.  
42.         IF findkey THEN
43.             FOR i = 1 TO LEN(word$(n))
44.                 templtr$ = MID$(word$(n), i, 1)
45.                 FOR x = 1 TO lenin '<<<<<<<<<<<<<<<<< main fix #1
46.                     IF ltr$(x) = templtr$ THEN
47.                         ltr$(x) = ""
48.                         count = count + 1
49.                     END IF
50.                     'debugging
51.                     'PRINT "Update: file word = "; word$(n); " and here is current letters crossed off: "; letters$
52.                     'INPUT "OK press enter... "; wate$
53.                 NEXT x
54.             NEXT i
55.  
56.             IF count = LEN(word$(n)) THEN
57.                 PRINT word$(n)
58.             END IF
59.         END IF
60.  
61.         FOR m = 1 TO 9 'main fix #2 n's  to m's
62.             ltr$(m) = MID$(in$, m, 1)
63.         NEXT m
64.         count = 0
65.     NEXT n
66.  
67.     PRINT "DONE..."
68. LOOP
69. PRINT USING "###,###,###,###,### loops ran in ##.# seconds"; loopsran, timelimit
70.  
71.  
72. 'for debugging
73. FUNCTION letters$ ()
74.     FOR i = 1 TO 9
75.         b$ = b$ + ltr$(i)
76.     NEXT
77.     letters$ = "*" + b$ + "*"
78. END FUNCTION

Modified:

Code: QB64: [Select]

1. DEFLNG A-Z
2. DIM word$(84100)
3. DIM key$
4. DIM SHARED ltr(9) '<<<<<<<<<<< shared to debug
5.  
6. 'SET KEY AND LETTERS
7. key$ = "a"
8. in$ = "abcdefghi"
9. lenin = LEN(in$) '<<<<<<<<<<< for faster processing
10.  
11. 'SPLIT UP LETTERS
12. FOR n = 1 TO 9
13.     ltr(n) = ASC(in$, n)
14. NEXT n
15.  
16.  
17.  
18.  
19.  
20. 'LOAD ALL WORDS FROM .TXT FILE
21. PRINT "LOADING...."
22. OPEN "WordList.txt" FOR BINARY AS #1 '<<<<<<<<< moved to more appropriate place
23. filecount = 0
24. WHILE NOT EOF(1)
25.     LINE INPUT #1, line$
26.     IF LEN(line$) < 10 THEN
27.         filecount = filecount + 1
28.         word$(filecount) = line$
29.     END IF
30. WEND
31. CLOSE #1
32.  
33.  
34. t# = TIMER
35. timelimit = 5
36. DO UNTIL TIMER > t# + timelimit
37.     CLS
38.     loopsran = loopsran + 1
39.  
40.  
41.     'RUN THROUGH WORDS
42.     FOR n = 1 TO filecount
43.         findkey = INSTR(word$(n), key$)
44.  
45.         IF findkey THEN
46.             FOR i = 1 TO LEN(word$(n))
47.                 templtr = ASC(word$(n), i)
48.                 FOR x = 1 TO lenin '<<<<<<<<<<<<<<<<< main fix #1
49.                     IF ltr(x) = templtr THEN
50.                         ltr(x) = 0
51.                         count = count + 1
52.                     END IF
53.                 NEXT x
54.                 IF count <> i GOTO skipmore
55.             NEXT i
56.  
57.             IF count = LEN(word$(n)) THEN
58.                 PRINT word$(n),
59.             END IF
60.         END IF
61.  
62.         skipmore:
63.         FOR m = 1 TO 9 'main fix #2 n's  to m's
64.             ltr(m) = ASC(in$, m)
65.         NEXT m
66.         count = 0
67.     NEXT n
68.  
69.     PRINT "DONE..."
70. LOOP
71. PRINT USING "###,###,###,###,### loops ran in ##.# seconds"; loopsran, timelimit
72.  
73. 'for debugging
74. FUNCTION letters$ ()
75.     FOR i = 1 TO 9
76.         b$ = b$ + ltr$(i)
77.     NEXT
78.     letters$ = "*" + b$ + "*"
79. END FUNCTION

Yours will run 22 times in 5 seconds, mine 324 times...

The changes?

#1) STRINGS are gone.  Why do we need them?  Especially, WHY DO WE NEED MID$??

When going for speed routines, ASC outperforms MID$(x$,y,1) every time, hands down!  This is a major performance boost.

#2) The word list is limited to begin with.

    IF LEN(line$) < 10 THEN
        filecount = filecount + 1
        word$(filecount) = line$
    END IF

You're not going to find 10 letter word matches with only 9 letter words.

#3) (Not timed, but a huge speed boost): Changed file from INPUT to BINARY and changed INPUT # to LINE INPUT#.  This makes loading the word list a whole heck of a lot faster.  Even faster would be to load it all at once and then parse the words out of it, but who wants to go through the trouble for all of the few microseconds we'd save in this case?

Simple little things, but the affect the performance like crazy.

[SMcNeill]

And, if we create a letter index for our words (since we're going to do a limit by key$), we can almost double the performance.  (Probably more for certain letters which aren't going to be indexed as much as "a" is, in this case.)

Code: QB64: [Select]

1. DEFLNG A-Z
2. DIM word$(84100)
3. DIM key$
4. DIM SHARED ltr(9) '<<<<<<<<<<< shared to debug
5. DIM backup(9)
6. DIM keycount(97 TO 122, 50000) 'letter/index
7.  
8. 'SET KEY AND LETTERS
9. key$ = "a"
10. in$ = "abcdefghi"
11. lenin = LEN(in$) '<<<<<<<<<<< for faster processing
12.  
13. 'SPLIT UP LETTERS
14. FOR n = 1 TO 9
15.     ltr(n) = ASC(in$, n)
16.     backup(n) = ltr(n)
17. NEXT n
18.  
19.  
20.  
21.  
22.  
23. 'LOAD ALL WORDS FROM .TXT FILE
24. PRINT "LOADING...."
25. OPEN "WordList.txt" FOR BINARY AS #1 '<<<<<<<<< moved to more appropriate place
26. filecount = 0
27. WHILE NOT EOF(1)
28.     LINE INPUT #1, line$
29.     IF LEN(line$) < 10 THEN
30.         filecount = filecount + 1
31.         word$(filecount) = line$
32.         FOR i = 97 TO 122
33.             IF INSTR(line$, CHR$(i)) THEN
34.                 keycount(i, 0) = keycount(i, 0) + 1 'record 0 tells us how many there are for that letter
35.                 keycount(i, keycount(i, 0)) = filecount 'add the word number to the proper index
36.             END IF
37.         NEXT
38.     END IF
39. WEND
40. CLOSE #1
41.  
42.  
43. t# = TIMER
44. timelimit = 5
45. DO UNTIL TIMER > t# + timelimit
46.     CLS
47.     loopsran = loopsran + 1
48.  
49.  
50.     'RUN THROUGH WORDS
51.     findkey = ASC(key$)
52.     FOR n = 1 TO keycount(findkey, 0)
53.         w$ = word$(keycount(findkey, n))
54.         l = LEN(w$)
55.         FOR i = 1 TO l
56.             templtr = ASC(w$, i)
57.             FOR x = 1 TO lenin '<<<<<<<<<<<<<<<<< main fix #1
58.                 IF ltr(x) = templtr THEN
59.                     ltr(x) = 0
60.                     count = count + 1
61.                 END IF
62.             NEXT x
63.             IF count <> i GOTO skipmore
64.         NEXT i
65.  
66.         IF count = l THEN PRINT w$,
67.  
68.         skipmore:
69.         FOR m = 1 TO 9 'main fix #2 n's  to m's
70.             ltr(m) = backup(m)
71.         NEXT m
72.         count = 0
73.     NEXT n
74.  
75.     PRINT "DONE..."
76. LOOP
77. PRINT USING "###,###,###,###,### loops ran in ##.# seconds"; loopsran, timelimit
78.  
79. 'for debugging
80. FUNCTION letters$ ()
81.     FOR i = 1 TO 9
82.         b$ = b$ + ltr$(i)
83.     NEXT
84.     letters$ = "*" + b$ + "*"
85. END FUNCTION
86.  

No need to check each and every word for a letter, if we already have built an index to tell us which words contain those letters.  ;)

(Current run time is 488 loops in 5 seconds on my PC, if you're curious about the actual number to compare improvement.)

[bplus]

Here's what I had in mind:

Code: QB64: [Select]

1. ' WordCrack mod 1.bas B+ 2018-10-07
2.  
3. INPUT "Enter a string to build words from "; in$
4. 'load words
5. OPEN "WordList.txt" FOR BINARY AS #1
6. gulp& = LOF(1)
7. buff$ = STRING$(gulp&, " ")
8. GET #1, , buff$
9. CLOSE #1
10. REDIM word$(0)
11. Split buff$, CHR$(10), word$()
12. filecount& = UBOUND(word$)
13. 'RUN THROUGH WORDS
14. FOR n& = 0 TO filecount&
15.     c$ = in$
16.     OK% = -1
17.     FOR i% = 1 TO LEN(word$(n&))
18.         p% = INSTR(c$, MID$(word$(n&), i%, 1))
19.         IF p% = 0 THEN
20.             OK% = 0: EXIT FOR
21.         ELSE
22.             MID$(c$, p%, 1) = "+"
23.         END IF
24.     NEXT
25.     IF OK% THEN PRINT word$(n&); ", ";
26. NEXT
27. PRINT "DONE..."
28.  
29.  
30. SUB Split (mystr AS STRING, delim AS STRING, arr() AS STRING)
31.     ' bplus modifications of Galleon fix of Bulrush Split reply #13
32.     ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
33.     ' this sub further developed and tested here: \test\Strings\Split test.bas
34.     DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, lc AS LONG, dpos AS LONG
35.     copy = mystr 'make copy since we are messing with mystr
36.     'special case if delim is space, probably want to remove all excess space
37.     IF delim = " " THEN
38.         copy = RTRIM$(LTRIM$(copy))
39.         p = INSTR(copy, "  ")
40.         WHILE p > 0
41.             copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
42.             p = INSTR(copy, "  ")
43.         WEND
44.     END IF
45.     curpos = 1
46.     arrpos = 0
47.     lc = LEN(copy)
48.     dpos = INSTR(curpos, copy, delim)
49.     DO UNTIL dpos = 0
50.         arr(arrpos) = MID$(copy, curpos, dpos - curpos)
51.         arrpos = arrpos + 1
52.         REDIM _PRESERVE arr(arrpos + 1) AS STRING
53.         curpos = dpos + LEN(delim)
54.         dpos = INSTR(curpos, copy, delim)
55.     LOOP
56.     arr(arrpos) = MID$(copy, curpos)
57.     REDIM _PRESERVE arr(arrpos) AS STRING
58. END SUB
59.  

Looks pretty simple to me.

Yes, Binary load most significant speed improvement! :)

[SMcNeill]

And another small modification of the original gives us another decent speed boost:

Code: QB64: [Select]

1. DEFLNG A-Z
2. DIM word$(84100)
3. DIM keys
4. DIM SHARED ltr(1 TO 9) '<<<<<<<<<<< shared to debug
5. DIM backup(1 TO 9)
6. DIM keycount(97 TO 122, 50000) 'letter/index
7. DIM m1 AS _MEM, m2 AS _MEM 'just for quick array restoration
8. m1 = _MEM(ltr()): m2 = _MEM(backup())
9.  
10. 'SET KEY AND LETTERS
11. keys = ASC("a")
12. in$ = "abcdefghi"
13. lenin = LEN(in$) '<<<<<<<<<<< for faster processing
14.  
15. 'SPLIT UP LETTERS
16. FOR n = 1 TO 9
17.     ltr(n) = ASC(in$, n)
18. NEXT n
19. _MEMPUT m2, m2.OFFSET, ltr()
20.  
21.  
22. 'LOAD ALL WORDS FROM .TXT FILE
23. PRINT "LOADING...."
24. OPEN "WordList.txt" FOR BINARY AS #1 '<<<<<<<<< moved to more appropriate place
25. filecount = 0
26. WHILE NOT EOF(1)
27.     LINE INPUT #1, line$
28.     IF LEN(line$) < 10 THEN
29.         filecount = filecount + 1
30.         word$(filecount) = line$
31.         FOR i = 97 TO 122
32.             IF INSTR(line$, CHR$(i)) THEN
33.                 keycount(i, 0) = keycount(i, 0) + 1 'record 0 tells us how many there are for that letter
34.                 keycount(i, keycount(i, 0)) = filecount 'add the word number to the proper index
35.             END IF
36.         NEXT
37.     END IF
38. WEND
39. CLOSE #1
40.  
41.  
42. t# = TIMER
43. timelimit = 5
44.  
45.  
46. DO UNTIL TIMER > t# + timelimit
47.     CLS
48.     loopsran = loopsran + 1
49.  
50.  
51.     'RUN THROUGH WORDS
52.     FOR n = 1 TO keycount(keys, 0)
53.         w$ = word$(keycount(keys, n))
54.         l = LEN(w$)
55.         FOR i = 1 TO l
56.             templtr = ASC(w$, i)
57.             FOR x = 1 TO lenin '<<<<<<<<<<<<<<<<< main fix #1
58.                 IF ltr(x) = templtr THEN
59.                     ltr(x) = 0
60.                     count = count + 1
61.                     EXIT FOR
62.                 END IF
63.             NEXT x
64.             IF count <> i GOTO skipmore
65.         NEXT i
66.  
67.         PRINT w$,
68.  
69.         skipmore:
70.         $CHECKING:OFF
71.         _MEMPUT m1, m1.OFFSET, backup()
72.         $CHECKING:ON
73.         count = 0
74.     NEXT n
75.  
76.     PRINT "DONE..."
77. LOOP
78. PRINT USING "###,###,###,###,### loops ran in ##.# seconds"; loopsran, timelimit
79.  
80. 'for debugging
81. FUNCTION letters$ ()
82.     FOR i = 1 TO 9
83.         b$ = b$ + ltr$(i)
84.     NEXT
85.     letters$ = "*" + b$ + "*"
86. END FUNCTION
87.  

Instead of a FOR...LOOP to reset the search list, I simply restored it with a backup array with _MEM.

From:

        FOR m = 1 TO 9 'main fix #2 n's  to m's
            ltr$(m) = MID$(in$, m, 1)
        NEXT m

To:

        $CHECKING:OFF
        _MEMPUT m1, m1.OFFSET, backup()
        $CHECKING:ON

*****************
*****************

I'm now getting ~900 runs in a short 5 second period.  I'd call that fast enough for just about anything I'd need to use it for.  (And a nice improvement from the original 22 runs in 5 seconds.)  ;)

[bplus]

I am getting 363 cycles for abcdefghi in 5 secs with Windows 10 Intel Core i5 processor without any preprocessing of the word$() array.

[bplus]

Steve your last code improvement is running 1067 or so loops on my machine.

Yeah OK, checking word length first does make sense and adds another 100 loops in 5 secs:

Code: QB64: [Select]

1. ' WordCrack mod 1.bas B+ 2018-10-07
2.  
3. ' now with timer mod
4.  
5. 'INPUT "Enter a string to build words from "; in$
6. in$ = "abcdefghi"
7. in$ = LCASE$(in$)
8. lenin = LEN(in$)
9.  
10. 'load words
11. OPEN "WordList.txt" FOR BINARY AS #1
12. gulp& = LOF(1)
13. buff$ = STRING$(gulp&, " ")
14. GET #1, , buff$
15. CLOSE #1
16. REDIM word$(0)
17. Split buff$, CHR$(10), word$()
18. filecount& = UBOUND(word$)
19. start! = TIMER
20. WHILE TIMER - start! < 5
21.     'RUN THROUGH WORDS
22.     FOR n& = 0 TO filecount&
23.         IF LEN(word$(n&)) <= lenin THEN
24.             c$ = in$
25.             OK% = -1
26.             FOR i% = 1 TO LEN(word$(n&))
27.                 p% = INSTR(c$, MID$(word$(n&), i%, 1))
28.                 IF p% = 0 THEN
29.                     OK% = 0: EXIT FOR
30.                 ELSE
31.                     MID$(c$, p%, 1) = "+"
32.                 END IF
33.             NEXT
34.             IF OK% THEN PRINT word$(n&); ", ";
35.         END IF
36.     NEXT
37.     counter = counter + 1
38. WEND
39. PRINT "Loop count in 5 secs ="; counter
40. END
41.  
42. SUB Split (mystr AS STRING, delim AS STRING, arr() AS STRING)
43.     ' bplus modifications of Galleon fix of Bulrush Split reply #13
44.     ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
45.     ' this sub further developed and tested here: \test\Strings\Split test.bas
46.     DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, lc AS LONG, dpos AS LONG
47.     copy = mystr 'make copy since we are messing with mystr
48.     'special case if delim is space, probably want to remove all excess space
49.     IF delim = " " THEN
50.         copy = RTRIM$(LTRIM$(copy))
51.         p = INSTR(copy, "  ")
52.         WHILE p > 0
53.             copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
54.             p = INSTR(copy, "  ")
55.         WEND
56.     END IF
57.     curpos = 1
58.     arrpos = 0
59.     lc = LEN(copy)
60.     dpos = INSTR(curpos, copy, delim)
61.     DO UNTIL dpos = 0
62.         arr(arrpos) = MID$(copy, curpos, dpos - curpos)
63.         arrpos = arrpos + 1
64.         REDIM _PRESERVE arr(arrpos + 1) AS STRING
65.         curpos = dpos + LEN(delim)
66.         dpos = INSTR(curpos, copy, delim)
67.     LOOP
68.     arr(arrpos) = MID$(copy, curpos)
69.     REDIM _PRESERVE arr(arrpos) AS STRING
70. END SUB
71.  

[codeguy]

generates strings and retrieves matches for permutations of letters creating words up to 8 characters long. in order too. On my humble machine, (39/64)s. Because permutations are generated in lexical order AND the wordlist is in lexical order (both ascending), this becomes nothing more than a simple merge/find algorithm, the same used for batch database updates. Quick? Judge for yourself. found 58 matches in 322560 variable-length permutations. I am uncertain how many loops/second this code executes, but I'm gonna say it's 322560/(39/64), roughly 529329 trials/second on my humble 2.16GHz machine. On my machine, this will also execute about 8 times, perhaps a wee bit more. I am uncertain how fast Steve's CPU is, but mine is no speed demon nor is it super slow. Mine is roughly 240,000 trials/GHz.

Code: QB64: [Select]

1. WIDTH 80, 43
2. DIM parray(0 TO 7) AS LONG '* checks words up to 8 characters long
3. theword$ = "sequoias"
4. FOR i = 0 TO UBOUND(parray)
5.     parray(i) = ASC(theword$, i + 1)
6. NEXT
7. s& = LBOUND(parray)
8. h& = UBOUND(parray)
9. DO
10.     an& = s& + 1
11.     FOR q& = an& TO h&
12.         IF parray(q&) < parray(s&) THEN
13.             SWAP parray(q&), parray(s&)
14.         END IF
15.     NEXT
16.     s& = an&
17. LOOP WHILE s& <= h&
18. PRINT
19. PRINT
20. Wlist% = FREEFILE
21. OPEN ".\wordlist.txt" FOR BINARY AS Wlist%
22. PRINT LOF(Wlist%)
23. chunk$ = INPUT$(LOF(Wlist%), Wlist%)
24. CLOSE Wlist%
25. REDIM words$(0 TO 999999)
26. Wct& = 0
27. FOR u& = 1 TO LEN(chunk$)
28.     IF ASC(chunk$, u&) = 10 OR u& > LEN(chunk$) THEN
29.         IF LEN(w$) <= 8 THEN
30.             words$(Wct&) = w$
31.             PRINT w$; Wct&
32.             Wct& = Wct& + 1
33.         END IF
34.         w$ = ""
35.     ELSE
36.         w$ = w$ + MID$(chunk$, u&, 1)
37.     END IF
38. NEXT
39. chunk$ = ""
40. WordsIndex& = 0
41. nmatches& = 0
42. '_DELAY 60
43. t! = TIMER(.001)
44. PRINT "permutations"
45. Permute parray(), 0, UBOUND(parray), np#, words$(), WordIndex&, Wct&, nmatches&, npermtrials#
46. f! = TIMER(.001)
47. PRINT f! - t!; nmatches&; np#; npermtrials#
48. DO
49.     x$ = INKEY$
50. LOOP UNTIL x$ > ""
51. SYSTEM
52.  
53. SUB DisplayResults (PArray() AS LONG, start, finish, np AS DOUBLE)
54.     DIM i AS LONG
55.     PRINT USING "#,###,###,###,###"; np;
56.     FOR i = LBOUND(parray) TO UBOUND(parray)
57.         PRINT PArray(i);
58.     NEXT
59.     PRINT
60. END SUB
61.  
62. SUB Rotate (parray() AS LONG, Start AS LONG, finish AS LONG)
63.     DIM ts AS LONG
64.     ts = parray(Start)
65.     FOR i = Start TO finish - 1
66.         SWAP parray(i), parray(i + 1)
67.     NEXT
68.     parray(finish) = ts
69. END SUB
70.  
71. SUB Permute (parray() AS LONG, start AS LONG, finish AS LONG, np AS DOUBLE, words$(), index&, wct&, matchcount&, NPermsTried#)
72.     np = np + 1
73.     IF index& < wct& THEN
74.         FOR a& = 0 TO UBOUND(parray)
75.             v$ = array2word$(parray(), LBOUND(parray), LBOUND(parray) + a&)
76.             DO
77.                 IF words$(index&) < v$ THEN
78.                     index& = index& + 1
79.                 ELSE
80.                     NPermsTried# = NPermsTried# + 1
81.                     IF words$(index&) = v$ THEN
82.                         matchcount& = matchcount& + 1
83.                         PRINT v$; ":match:"; words$(index&); index&; matchcount&
84.                     END IF
85.                     EXIT DO
86.                 END IF
87.             LOOP
88.         NEXT
89.     ELSE
90.         EXIT SUB
91.     END IF
92.     IF start < finish THEN
93.         DIM i AS LONG
94.         DIM j AS LONG
95.         FOR i = finish - 1 TO start STEP -1
96.             FOR j = i + 1 TO finish
97.                 SWAP parray(i), parray(j)
98.                 Permute parray(), i + 1, finish, np, words$(), index&, wct&, matchcount&, NPermsTried#
99.             NEXT
100.             Rotate parray(), i, finish
101.         NEXT
102.     END IF
103. END SUB
104.  
105. FUNCTION array2word$ (parray() AS LONG, start AS LONG, finish AS LONG)
106.     m$ = SPACE$(finish - start + 1)
107.     POSITION& = 1
108.     FOR z& = start TO finish
109.         MID$(m$, POSITION&) = CHR$(parray(z&))
110.         POSITION& = POSITION& + 1
111.     NEXT
112.     array2word$ = m$
113. END FUNCTION
114.