anagram solver problem

[dkl]

The other day I was playing with tenochtitlanuk's Wordwheel and making a few adjustments to generate new words etc (hope you don't mind tenochtitlanuk!

It got me wanting to make an anagram programme. The word list (attached, but shortened version due to size) is taken from the word list used by Mac and PC (sudo cp /usr/share/dict/words .)

The code below does it's desired purpose (sort of.....). The one big problem is it allows for multiple uses of the chosen letters, which of course is not desirable.

Try the programme and you'll see what I mean. I realise it's in the [srch] module section where the problems are, but I'm not quite sure want I need to add!

Could someone steer me in the right direction, please?
Dim dict$(236000),letr$(30),Uword$(30)
Dim store4$(2000),store5$(2000),store6$(2000),store7$(2000),store8$(2000),store9$(2000),store10$(2000)
c = 1

path$ = "C:\Users\kleth\Desktop\"
doc$ =  "words.txt"
f$ = path$+doc$

'input user word here - to be added later
Uword$ = "dialogue":lnwd = len(Uword$) 'len of User word

open  f$ for input as #1

for rd = 1 to 235886
line input #1,data$:if len(data$) >= 4 and len(data$) <= lnwd then ct = ct +1:dict$(ct) = lower$(trim$(data$))
if data$ = "" then exit for
next rd
close #1
print ct;" words loaded from 235889 words available"

[split] 'seperate letters in dictionary Word(dict$)

lnDct = len(dict$(c)) 'len of dictionary word
for a = 1 to lnDct
letr$(a) = mid$(dict$(c),a,1)
'print letr$(a)
next a

[srch] 'compare leters in Uword$ with dict$ word
for b = 1 to lnwd'Uword loop
pos = instr(Uword$,letr$(b)):if pos <> 0 then Lct = Lct +1':print letr$(b)
next b

if Lct = lnDct then gosub [store]
Lct = 0:lnDct = 0

[nextWord]
redim letr$(30)
c = c + 1:if c = ct then [end]
goto [split]

[end]
print:print "4 letter words - ";st4:p = 0
for pr = 1 to st4
print store4$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "5 letter words - ";st5:p = 0
for pr = 1 to st5
print store5$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "6 letter words - ";st6:p = 0
for pr = 1 to st6
print store6$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "7 letter words - ";st7:p = 0
for pr = 1 to st7
print store7$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "8 letter words - ";st8:p = 0
for pr = 1 to st8
print store8$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "9 letter words - ";st9:p = 0
for pr = 1 to st9
print store9$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "10 letter words - ";st10:p = 0
for pr = 1 to st10
print store10$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print st4+st5+st6+st7+st8+st9+st10;" words found in total"
end

[store]
if lnDct = 4 then store4$(st4) = dict$(c):st4 = st4 +1
if lnDct = 5 then store5$(st5) = dict$(c):st5 = st5 +1
if lnDct = 6 then store6$(st6) = dict$(c):st6 = st6 +1
if lnDct = 7 then store7$(st7) = dict$(c):st7 = st7 +1
if lnDct = 8 then store8$(st8) = dict$(c):st8 = st8 +1
if lnDct = 9 then store9$(st9) = dict$(c):st9 = st9 +1
if lnDct = 10 then store10$(st10) = dict$(c):st10 = st10 +1
return



Attachments:

words.txt (901.49 KB)

[dkl]

I have just realised that the first for/next loop needs to be adjusted to 81456. I forgot its a smaller file!

open f$ for input as #1
for rd = 1 to 81456 <------- here

[tsh73]

I've got something running
- basically you got to count numbers of occurrence of each letters in user word and dictionary word
User word
   dial-l-logue
1             - 45          2
2             a 97          1
3             d 100         1
4             e 101         1
5             g 103         1
6             i 105         1
7             l 108         3
8             o 111         1
9             u 117         1
processing word dual
   is good
processing word edea
   is no good: not enough e
processing word gill
   is good
over


but it got rather convoluted


dict$(0)="dual" 'good
dict$(1)="edea" 'bad
dict$(2)="gill" 'well, we added a fewi L's so...

Uword$ = "dial-l-logue":lnwd = len(Uword$)
print "User word"
print "    ";Uword$
'prepare Uword$ for comparing
redim wordCounter(255)    'how many of each character
for a = 1 to lnwd
   code = asc(mid$(Uword$,a,1))
   wordCounter(code)=wordCounter(code)+1
'print letr$(a)
next a
'now we compact that array so not to go over 255 characters if we need only 10
dim UwordCode(lnwd), UwordCounter(lnwd)
p = 0
for i = 1 to 255
   if wordCounter(i) then
       p=p+1
       UwordCode(p)=i
       UwordCounter(p)=wordCounter(i)
   end if
next
'p is number of different letters in  Uword$
UwordDiffLett=p
for i = 1 to UwordDiffLett
   print i,  chr$(UwordCode(i));" ";UwordCode(i), UwordCounter(i)
next

'start of main loop
c = 0
ct = 3

[split] 'count letters in dictionary Word(dict$)
print "processing word "; dict$(c)

redim wordCounter(255)    'how many of each character
lnDct = len(dict$(c)) 'len of dictionary word
for a = 1 to lnDct
   code = asc(mid$(dict$(c),a,1))
   wordCounter(code)=wordCounter(code)+1
'print letr$(a)
next a

[srch] 'compare leters in Uword$ with dict$ word
good = 1
for i = 1 to UwordDiffLett
   if wordCounter(UwordCode(i))>UwordCounter(i) then
       good = 0
       print "    is no good: not enough ";chr$(UwordCode(i))
       exit for
   end if
next

if good then gosub [store]
Lct = 0:lnDct = 0

[nextWord]
c = c + 1:if c = ct then [end]
goto [split]

'------------------
[end]
   print "over"
end

[store]
   'print dict$(c);"    is good"
   print "    is good"
return



[dkl]

tsh73 - Thank you for taking the trouble to do all that. I realised after posting I had to add up the occurances of letters in Uword$, but was a bit vague on what to do next, but will try to follow your idea along those lines to help me move forward. I'm trying to change as little as possible with the basic idea as the code runs quite fast and takes about 10/20 seconds to come up with all the answers, which I think is pretty good when searching the 230000 words in the full list(not attached due to size restrictions).

Your time is much appreciated. Thank you.

[dkl]

I'm thinking a quicker way would be to compare each letter in possible word (dict$) and if a match is found then remove it from Uword$(the word you are searching), then repeat the process. That way you don't have to add up the number of occurrences of each letter. Yes? If you get what I mean.

later........ The concept seems to work well, but I cannot use replstr$ as it deletes ALL traces of the letter!

[dkl]

I think I have done it!? Could a few people check this for me and post any problems they see?
I simply changed one line in the [srch] module, so I'm hoping I've got it right. Maybe I'm jumping the gun?!
It takes 20 sec to find 402 words from an 11 letter word using 176360 words from the dictionary
It takes 2.5 sec to find 15 words from a 6 letter word using 33208 words from the dictionary
At the moment the programme goes through every letter of the alphabet, so the speed could be increased if it searches only the letters in the User word.

Dim dict$(236000),letr$(30),Uword$(30)
Dim store4$(2000),store5$(2000),store6$(2000),store7$(2000),store8$(2000),store9$(2000),store10$(2000)
c = 1
wordCount = 235886

path$ = " " [b]'<-add word.txt file path$ here[/b]
doc$ =  "words1.txt"
f$ = path$+doc$

print "Input User Word (Min 4, Max 10)":input Uword$

'Uword$ = "dialogue":
lnwd = len(Uword$) 'len of User word
Uword2$ = Uword$

open  f$ for input as #1
print "loading word file........"
for rd = 1 to wordCount
line input #1,data$:if len(data$) >= 4 and len(data$) <= lnwd then ct = ct +1:dict$(ct) = lower$(trim$(data$))
if data$ = "" then exit for
next rd
close #1
print ct;" words loaded from ";wordCount;"  words available"

[split] 'seperate letters in dictionary Word(dict$)
lnDct = len(dict$(c)) 'len of dictionary word
for a = 1 to lnDct
letr$(a) = mid$(dict$(c),a,1)
'print letr$(a)
next a

[srch] 'compare leters in Uword$ with dict$ word
for b = 1 to lnwd'Uword loop
pos = instr(Uword$,letr$(b)):if pos <> 0 then Lct = Lct + 1:Uword$ =  mid$(Uword$,1,pos-1) + mid$(Uword$,pos+1,len(Uword$))':print Uword$, letr$(b)
'pos = instr(Uword$,letr$(b)):if pos <> 0 then Lct = Lct +1':print letr$(b)
next b

if Lct = lnDct then gosub [store]
Lct = 0:lnDct = 0

[nextWord]
redim letr$(30)
Uword$ = Uword2$ 'reinstate User word
c = c + 1:if c = ct then [end]
goto [split]

[end]
print:print "4 letter words - ";st4-1:p = 0
for pr = 1 to st4
print store4$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "5 letter words - ";st5-1:p = 0
for pr = 1 to st5
print store5$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "6 letter words - ";st6-1:p = 0
for pr = 1 to st6
print store6$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "7 letter words - ";st7-1:p = 0
for pr = 1 to st7
print store7$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "8 letter words - ";st8-1:p = 0
for pr = 1 to st8
print store8$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "9 letter words - ";st9-1:p = 0
for pr = 1 to st9
print store9$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "10 letter words - ";st10-1:p = 0
for pr = 1 to st10
print store10$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print st4+st5+st6+st7+st8+st9+st10-7;" words found in total"
end

[store]
if lnDct = 4 then store4$(st4) = dict$(c):st4 = st4 +1
if lnDct = 5 then store5$(st5) = dict$(c):st5 = st5 +1
if lnDct = 6 then store6$(st6) = dict$(c):st6 = st6 +1
if lnDct = 7 then store7$(st7) = dict$(c):st7 = st7 +1
if lnDct = 8 then store8$(st8) = dict$(c):st8 = st8 +1
if lnDct = 9 then store9$(st9) = dict$(c):st9 = st9 +1
if lnDct = 10 then store10$(st10) = dict$(c):st10 = st10 +1
return



The partial word list I used, is at the beginning of this post. I'm trying to find the original site I got the word list from, but can't find it - Sorry

Some of the words in the list do seem a bit obscure. If anyone have a better list the do let me know, Please. I think a Scrabble word list word probably be best?

Just found this link to the Official Scrabble WordList - boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file

[Brandon Parker]

Have you seen this...? I have not tested it, but if memory serves me correctly, it was posted way back when we were still using the Conforums site.

rosettacode.org/wiki/Anagrams#Liberty_BASIC


{:0)

Brandon Parker

[dkl]

Thanks for that Brandon. I hadn't seen it, but have now! I looked quite a complicated version. I'm pleased to say that mine churned out the same words and many more. Which made me wonder how I managed to get such results with only a few lines of code. Basically the code below did all the work,the rest was display and make pretty! LOL

[split] 'seperate letters in dictionary Word(dict$)
lnDct = len(dict$(c)) 'len of dictionary word
for a = 1 to lnDct
letr$(a) = mid$(dict$(c),a,1)
next a

[srch] 'compare leters in Uword$ with dict$ word
for b = 1 to lnwd'Uword loop
pos = instr(Uword$,letr$(b)):if pos <> 0 then Lct = Lct + 1:Uword$ = mid$(Uword$,1,pos-1) + mid$(Uword$,pos+1,len(Uword$))':print Uword$, letr$(b)
next b

I've posted my GUI version in a separate post, I'd be interested to see you you can see what is wrong with the redim array I talk about.

Thanks for you help:)

Saw your post about reloading code -----All Done Hope it works this time.

[tsh73]

Well, simple solutions work best

said that, my solution did not worked as posted on all words
(I checked that letters in UserWord counted not less then in DictWord, but not checked that all letters in dictWord are indeed in UserWord)

But I added one more check and now
1) my program got the same output on "dialogue" as yours
That hints they both work OK
2) now it works 3x faster on my machine then your solution. (but that could depend on computer)
Dim dict$(236000),letr$(30),Uword$(30)
Dim store4$(2000),store5$(2000),store6$(2000),store7$(2000),store8$(2000),store9$(2000),store10$(2000)
c = 1

'path$ = "C:\Users\kleth\Desktop\"
path$ = ".\"
doc$ =  "words.txt"
f$ = path$+doc$

'input user word here - to be added later
Uword$ = "dialogue":lnwd = len(Uword$) 'len of User word

redim wordCounter(255)    'how many of each character
for a = 1 to lnwd
   code = asc(mid$(Uword$,a,1))
   wordCounter(code)=wordCounter(code)+1
'print letr$(a)
next a
'now we compact that array so not to go over 255 characters if we need 10
dim UwordCode(lnwd), UwordCounter(lnwd)
p = 0
for i = 1 to 255
   if wordCounter(i) then
       p=p+1
       UwordCode(p)=i
       UwordCounter(p)=wordCounter(i)
   end if
next
'p is number of different letters in  Uword$
UwordDiffLett=p
for i = 1 to UwordDiffLett
   print i,  chr$(UwordCode(i));" ";UwordCode(i), UwordCounter(i)
next

open  f$ for input as #1

'for rd = 1 to 235886
for rd = 1 to 81456' <------- here
line input #1,data$:if len(data$) >= 4 and len(data$) <= lnwd then ct = ct +1:dict$(ct) = lower$(trim$(data$))
if data$ = "" then exit for
next rd
close #1
print ct;" words loaded from 235889 words available"
t0=time$("ms")

[split] 'count letters in dictionary Word(dict$)
'print "processing word "; dict$(c)

redim wordCounter(255)    'how many of each character
lnDct = len(dict$(c)) 'len of dictionary word
good = 1
for a = 1 to lnDct
       'PROBLEM: does not check if all letters of word are in Uword
       'so add check in front
       'if instr(Uword$, mid$(dict$(c),a,1))=0 then good = 0: print "miss ";mid$(dict$(c),a,1):exit for
       if instr(Uword$, mid$(dict$(c),a,1))=0 then good = 0:exit for
   code = asc(mid$(dict$(c),a,1))
   wordCounter(code)=wordCounter(code)+1
'print letr$(a)
next a

if not (good) then [skipSrch]

[srch] 'compare leters in Uword$ with dict$ word
'good = 1
for i = 1 to UwordDiffLett
   if wordCounter(UwordCode(i))>UwordCounter(i) then
       good = 0
       'print "    is no good: not enough ";chr$(UwordCode(i))
       exit for
   end if
next

if good then gosub [store]
[skipSrch]
Lct = 0:lnDct = 0

[nextWord]
redim letr$(30)
'if c mod 100 = 0 then print c
c = c + 1:if c = ct then [end]
goto [split]

[end]
t1=time$("ms")
print "Time taken ";t1-t0   '8719 src  10859 with string manupulation   3266 with char count

print:print "4 letter words - ";st4:p = 0
for pr = 1 to st4
print store4$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "5 letter words - ";st5:p = 0
for pr = 1 to st5
print store5$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "6 letter words - ";st6:p = 0
for pr = 1 to st6
print store6$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "7 letter words - ";st7:p = 0
for pr = 1 to st7
print store7$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "8 letter words - ";st8:p = 0
for pr = 1 to st8
print store8$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "9 letter words - ";st9:p = 0
for pr = 1 to st9
print store9$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print:print "10 letter words - ";st10:p = 0
for pr = 1 to st10
print store10$(pr),:p = p + 1:if p = 6 then print chr$(10),chr$(13):p = 0
next pr

print st4+st5+st6+st7+st8+st9+st10;" words found in total"
end

[store]
if lnDct = 4 then store4$(st4) = dict$(c):st4 = st4 +1
if lnDct = 5 then store5$(st5) = dict$(c):st5 = st5 +1
if lnDct = 6 then store6$(st6) = dict$(c):st6 = st6 +1
if lnDct = 7 then store7$(st7) = dict$(c):st7 = st7 +1
if lnDct = 8 then store8$(st8) = dict$(c):st8 = st8 +1
if lnDct = 9 then store9$(st9) = dict$(c):st9 = st9 +1
if lnDct = 10 then store10$(st10) = dict$(c):st10 = st10 +1
return


[dkl]

Hi tsh73 - only just seen this post from you!

1) my program got the same output on "dialogue" as yours
That hints they both work OK
2) now it works 3x faster on my machine then your solution. (but that could depend on computer)

Good to hear that they both seem to work OK. Yes, your code is a lot faster, but if you used the word file I attached then it would be as it is almost 1/3rd the size of the file I was using (as one can only upload a max of 1mb size files)

Thanks for all of the addition code I will study that to help me speed things up. I'm using the Collins Scrabble Dictionary now which has 280000 words! A bit OTT perhaps. LOL

In my other post 'Anagram S.... with GUI' I mention a few things I want to try to add to speed things up, so if I get stuck hopefully you won't mind if I get back to you to ask for help. I really appreciate what you are doing. it helps me learn a lot.