WordCracker

[Zeppelin]

Wow. Thanks everyone for their responses. Thanks for the performance tips (It really helps. I still learning).
Its nice to see everyone trying to out-do each others programs.

I have to say SMcNeill..... what do you do with your life.

Just joking man. Unbelievably fast program by the way.

Thanks everyone,
Zeppelin

[bplus]

Made some more improvements like getting rid of blank word and preprocessed file according to number of letters input to build words from. "abcdefghi" now runs around 518 loops in 5 secs and finds 351 words from "Steve McNeil" input. Steve's code crashes if "Steve McNeil" is input. ;-))

Code: QB64: [Select]

1. _TITLE "WordCrack mod 2 with preprocessing.bas B+ 2018-10-08"
2.  
3. ' now with timer mod and preprocessing of word file to length of in$
4.  
5. 'INPUT "Enter a string to build words from "; inp$
6. inp$ = "Steve McNeil"
7. in$ = LCASE$(inp$)
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 longWords$(0)
17. Split buff$, CHR$(10), longWords$()
18.  
19. 'preprocess word list, use only words <= the build words string
20. DIM word$(84100)
21. FOR i& = 0 TO UBOUND(longWords$)
22.     IF LEN(longWords$(i&)) <= lenin THEN
23.         IF LTRIM$(longWords$(i&)) <> "" THEN
24.             IF ASC(longWords$(i&)) > 96 AND ASC(longWords$(i&)) < 123 THEN
25.                 wi& = wi& + 1
26.                 word$(wi&) = longWords$(i&)
27.             END IF
28.         END IF
29.     END IF
30. NEXT
31.  
32. 'NOW do the loop count, should add lots of loops checking one less thing per loop and looping less times
33. start! = TIMER
34. WHILE TIMER - start! < 5
35.     'RUN THROUGH WORDS
36.     foundWords% = 0
37.     FOR n& = 0 TO wi&
38.         c$ = in$
39.         OK% = -1
40.         FOR i% = 1 TO LEN(word$(n&))
41.             p% = INSTR(c$, MID$(word$(n&), i%, 1))
42.             IF p% = 0 THEN
43.                 OK% = 0: EXIT FOR
44.             ELSE
45.                 MID$(c$, p%, 1) = "+"
46.             END IF
47.         NEXT
48.         IF OK% THEN foundWords% = foundWords% + 1: PRINT word$(n&); ", ";
49.     NEXT
50.     counter% = counter% + 1
51. WEND
52. PRINT: PRINT: PRINT "Found:"; foundWords%; "words in "; CHR$(34); inp$; CHR$(34); ","; counter%; "times in 5 secs."
53. END
54.  
55. SUB Split (mystr AS STRING, delim AS STRING, arr() AS STRING)
56.     ' bplus modifications of Galleon fix of Bulrush Split reply #13
57.     ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
58.     ' this sub further developed and tested here: \test\Strings\Split test.bas
59.     DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, lc AS LONG, dpos AS LONG
60.     copy = mystr 'make copy since we are messing with mystr
61.     'special case if delim is space, probably want to remove all excess space
62.     IF delim = " " THEN
63.         copy = RTRIM$(LTRIM$(copy))
64.         p = INSTR(copy, "  ")
65.         WHILE p > 0
66.             copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
67.             p = INSTR(copy, "  ")
68.         WEND
69.     END IF
70.     curpos = 1
71.     arrpos = 0
72.     lc = LEN(copy)
73.     dpos = INSTR(curpos, copy, delim)
74.     DO UNTIL dpos = 0
75.         arr(arrpos) = MID$(copy, curpos, dpos - curpos)
76.         arrpos = arrpos + 1
77.         REDIM _PRESERVE arr(arrpos + 1) AS STRING
78.         curpos = dpos + LEN(delim)
79.         dpos = INSTR(curpos, copy, delim)
80.     LOOP
81.     arr(arrpos) = MID$(copy, curpos)
82.     REDIM _PRESERVE arr(arrpos) AS STRING
83. END SUB
84.  

PS codeguy's code is going to crash also if only permutations up to 8 letters is allowed, without even checking I can see that.

Less than 4 hours to go. Will Steve fix his code in time? Stay tuned...  ;)

[bplus]

Steve wins again! My name only has 271 words in it. :) (but none are vile)

[SMcNeill]

Modified to run with any size string (even "Steve McNeil"; which, btw, is named WRONG.  /cry!!):

Code: QB64: [Select]

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

About 300 loops in 5 seconds with the longer name giving us more letters to check against.  Oddly enough, my list is only counting 350 words for us, and not 351 as Bplus says his is generating.  Is this a glitch in my counting method?  His?  Or is somebody leaving a word out, or including a false positive?   

I dunno!

Some digging will be required to see where that extra word comes from, and what the heck it is!  :P

[SMcNeill]

Testing shows that Bplus is wrong.   :D

Compare the 2 file dumps (the first is mine, the second is Bplus's), and it's immediately obvious what the issue is, right at the very top of the file -- a BLANK word.  There's 350 words, with an extra "" at the top of his list.   

Steve wins again!  ;D

[bplus]

Cra...

Sorry about your name Steve, my eyes are going bad.

Wait,  , isn't a word? ;-))  (where the heck did that come from?)

Thanks for heads up!

[SMcNeill]

Cra...

Sorry about your name Steve, my eyes are going bad.

No worries; it's the story of my life...  My family has lived here since forever, so when it was time to name the roads, the powers that be named the road here after my family...

And, spelt it wrong!

No kidding!!

You can find me on McNeil Hill Rd, still laughing at the irony of being immortalized incorrectly.

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

And funniest thing?? 

The local government says we can change the name, as long as WE are willing to pay the $$$$$ to change the road signs.

Two little signs, only needing an extra "l" in them, and yet to comply to state standards, they cost over $2600 each!

It's no damn wonder our government is broke, trying to hit such costs just to stay within regulation.  On a low traveled, rural as heck road like mine, a $2.00 slab of wood, $1 can of white paint, and $1 can of black paint for lettering, would be more than sufficient to serve the needs of the community...

And yet...  The sign has to be a certain gauge steel, painted X coats of reflective green, with Y coats of Z-size white paint, mixed with XX percent reflective beads....

(And, just in case you want to see how nutty regulations are for government stuff, here's the regs on signs:  http://www.vdot.virginia.gov/business/resources/TED/final_MUTCD/2013_sup/Revision_1_Part_2_Signs.pdf --- Well, it's the BASIC regulations.  There are 14 supplements, with 5 supplements to supplement the supplements also...l)

[Cobalt]

And funniest thing?? 

The local government says we can change the name, as long as WE are willing to pay the $$$$$ to change the road signs.

Two little signs, only needing an extra "l" in them, and yet to comply to state standards, they cost over $2600 each!

It's no damn wonder our government is broke, trying to hit such costs just to stay within regulation.  On a low traveled, rural as heck road like mine, a $2.00 slab of wood, $1 can of white paint, and $1 can of black paint for lettering, would be more than sufficient to serve the needs of the community...

And yet...  The sign has to be a certain gauge steel, painted X coats of reflective green, with Y coats of Z-size white paint, mixed with XX percent reflective beads....

(And, just in case you want to see how nutty regulations are for government stuff, here's the regs on signs:  http://www.vdot.virginia.gov/business/resources/TED/final_MUTCD/2013_sup/Revision_1_Part_2_Signs.pdf --- Well, it's the BASIC regulations.  There are 14 supplements, with 5 supplements to supplement the supplements also...l)

just do what the kids do, take some paint and add your own extra 'l', find some spray paint thats lying around it costs you nothing! unless you get caught and fined. or go the extra mile with some masking tape so it looks better!
175 pages, does that meet novel requirements too?

[bplus]

Yep, for shorter strings Steve's loop count is a winner!

But for longer strings this current version is a winner.

Code: QB64: [Select]

1. WIDTH 80, 50
2. _TITLE "WordCrack mod 2 with preprocessing.bas B+ 2018-10-08"
3.  
4. ' now with timer mod and preprocessing of word file to length of in$
5.  
6. ' fix the extra "" word being printed   12:28 PM
7. ' use same print method as Steve's code, change type for wordsFound
8.  
9. 'INPUT "Enter a string to build words from "; inp$
10. inp$ = "thequickbrownfoxjumpedoverthelazydog"
11. 'inp$ = "thequickbrownfoxjumpedoverthelazydogdreamingofcountingsheep"
12. 'inp$ = "thequickbrownfoxjumpedoverthelazydogdreamingofcountingsheepthinkingofbrownfoxjumpingoverdogs"
13. in$ = LCASE$(inp$)
14. lenin = LEN(in$)
15.  
16. 'load words
17. OPEN "WordList.txt" FOR BINARY AS #1
18. gulp& = LOF(1)
19. buff$ = STRING$(gulp&, " ")
20. GET #1, , buff$
21. CLOSE #1
22. REDIM longWords$(0)
23. Split buff$, CHR$(10), longWords$()
24.  
25. 'preprocess word list, use only words <= the build words string
26. DIM word$(84100)
27. FOR i& = 0 TO UBOUND(longWords$)
28.     IF LEN(longWords$(i&)) <= lenin THEN
29.         IF LTRIM$(longWords$(i&)) <> "" THEN
30.             IF ASC(longWords$(i&)) > 96 AND ASC(longWords$(i&)) < 123 THEN
31.                 wi& = wi& + 1
32.                 word$(wi&) = longWords$(i&)
33.             END IF
34.         END IF
35.     END IF
36. NEXT
37.  
38. 'NOW do the loop count, should add lots of loops checking one less thing per loop and looping less times
39. start! = TIMER
40. WHILE TIMER - start! < 5
41.     'RUN THROUGH WORDS
42.     foundWords& = 0
43.     FOR n& = 1 TO wi& '<<<<<<<<<<<<<<<<<<<  fixed from 0 to 1
44.         c$ = in$
45.         OK% = -1
46.         FOR i% = 1 TO LEN(word$(n&))
47.             p% = INSTR(c$, MID$(word$(n&), i%, 1))
48.             IF p% = 0 THEN
49.                 OK% = 0: EXIT FOR
50.             ELSE
51.                 MID$(c$, p%, 1) = "+"
52.             END IF
53.         NEXT
54.         IF OK% THEN foundWords& = foundWords& + 1: PRINT word$(n&),
55.     NEXT
56.     counter& = counter& + 1
57. WEND
58. PRINT: PRINT: PRINT "Found:"; foundWords&; "words in "; CHR$(34); inp$; CHR$(34); ","; counter&; "times in 5 secs."
59. END
60.  
61. SUB Split (mystr AS STRING, delim AS STRING, arr() AS STRING)
62.     ' bplus modifications of Galleon fix of Bulrush Split reply #13
63.     ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
64.     ' this sub further developed and tested here: \test\Strings\Split test.bas
65.     DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, lc AS LONG, dpos AS LONG
66.     copy = mystr 'make copy since we are messing with mystr
67.     'special case if delim is space, probably want to remove all excess space
68.     IF delim = " " THEN
69.         copy = RTRIM$(LTRIM$(copy))
70.         p = INSTR(copy, "  ")
71.         WHILE p > 0
72.             copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
73.             p = INSTR(copy, "  ")
74.         WEND
75.     END IF
76.     curpos = 1
77.     arrpos = 0
78.     lc = LEN(copy)
79.     dpos = INSTR(curpos, copy, delim)
80.     DO UNTIL dpos = 0
81.         arr(arrpos) = MID$(copy, curpos, dpos - curpos)
82.         arrpos = arrpos + 1
83.         REDIM _PRESERVE arr(arrpos + 1) AS STRING
84.         curpos = dpos + LEN(delim)
85.         dpos = INSTR(curpos, copy, delim)
86.     LOOP
87.     arr(arrpos) = MID$(copy, curpos)
88.     REDIM _PRESERVE arr(arrpos) AS STRING
89. END SUB
90.  
91.  

inp$ = "thequickbrownfoxjumpedoverthelazydog" > 74 loops versus 65 Steve's
'inp$ = "thequickbrownfoxjumpedoverthelazydogdreamingofcountingsheep" > 41 versus 36-37 Steve's
'inp$ = "thequickbrownfoxjumpedoverthelazydogdreamingofcountingsheepthinkingofbrownfoxjumpingoverdogs" > 37 versus 32-33 Steve's

[SMcNeill]

Yep, for shorter strings Steve's loop count is a winner!

But for longer strings this current version is a winner.

When dealing with such long strings, I'd definitely go a different route.  Read letters.  Preset an array.   Just compare letter counts.  I imagine it'd be a ton faster than how we're currently doing it, but that's because the program needs would be much different than originally stated.

I'll play around with it some and see just how quick a routine I can whip up for those longer words/phrases.  :)

[codeguy]

I got 361 words matching stevemcneill using the wordlist.txt as included in an attachment for this post. Somewhere, someone is wrong. Mine was modified to accommodate the added characters. Yes, it took a while as I did no optimizations for eliminating impossible prefixes and suffixes.

[bplus]

Hi codeguy,

For stevemcneill, 2 l's on end, I am getting 392 words with Steve's code and my version.

I don't know about just a letter? is t a word? I know I is. ;)

[SMcNeill]

Hi codeguy,

For stevemcneill, 2 l's on end, I am getting 392 words with Steve's code and my version.

I don't know about just a letter? is t a word? I know I is. ;)

Large dictionaries list each letter as a single-letter word. Each such word is defined as a noun, denoting the letter with which it is spelled.

"Psychology" starts with a p.

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

What if Q from Star Trek took the L train to the T intersection of C and D streets because he had a map where an X marked that spot? Would he get an A for following directions?

[codeguy]

You ARE using the original wordlist.txt from the original thread post https://www.qb64.org/forum/index.php?action=dlattach;topic=679.0;attach=1619, right? I got 361 unique matches using "stevemcneill" as the original string on my modified code, which was considerably slower BUT it does EXHAUSTIVE permutations of every letter, leading to quite large numbers, in fact the size of the job increases as a factorial.

[bplus]

Hi codeguy,

Is your code geared to handle the triple e and double l in stevemcneill? This is why I thought "nah!" for permutations.

Hi Steve,

You sure know how to drive home a point, N, S, E and W! ;)