This is the new home of the egghelp.org community forum.
All data has been migrated (including user logins/passwords) to a new phpBB version.


For more information, see this announcement post. Click the X in the top right-corner of this box to dismiss this message.

About scrabble game

Old posts that have not been replied to for several years.
Locked
C
Caribou
Voice
Posts: 28
Joined: Thu Apr 15, 2004 12:51 pm
Location: France

About scrabble game

Post by Caribou »

Hello, im trying to make a scrabble game, or boggle if you prefer, and i wanna make him abble to check a full database of words, with a string (random letters) to say how many words the string is able to make.

But with this code it take like 30sec to check the database, and also it use like 40% of shell cpu :!:

Here is the code, if someone got an idea to make it faster, but maybe it is impossible with TCL ?

made fast comments to make it fast reading.

Code: Select all

proc read:scrab { } {
 
 #Opening the db
 if {![catch {set fileRead [open mydatabase r]}]} {
 
   #Setting a var for counting
   set count 0

   #Launching a loop to read the file
   while {![eof $fileRead]} {

    #Checking each Words in db, and incr count if it fit with Letters
    if {[checking [gets $fileRead]] == "1"} { incr count; }

   }
   return $count
   close $fileRead
 }
}

#Here is the code who compare Words & Letters
proc checking {arg} {
  #Calling var ll who contain Letters from Scrabble
  global ll

  #Spliting var of Letters and Words to make them as lists
  set Letters [split [string tolower $ll] ""]
  set Word [split [string tolower $arg] ""]

  #Launching a loop who'll compare each letter for Words one by one
  for {set nb 0} {$nb<[llength $Word]} {incr nb} {
   
   #Searching for a letter from $Word in $Letters
   set sch [lsearch $Letters [lindex $Word $nb]]
   
   #If the letter from $Word isin $Letters, then erase it, or get out
   if {$sch >= "0"} { set temp [lreplace $Letters $sch $sch]; } else { return "-1"; }

  }

  #To confirm that the $Letters can construct the $Word
  return "1"

}
User avatar
De Kus
Revered One
Posts: 1361
Joined: Sun Dec 15, 2002 11:41 am
Location: Germany

Post by De Kus »

Hmm, you maybe suggested to try running it as C modul, but im sure it will still take over 10sek consuming about the same CPU usage. Complex string operations in this amount always consume much CPU power. I dont exactly understand the search, since I don't know if $letters contains randomly ordered letters or it is just a word that should be checked. In last case a single search should do the trick, shouldn't it? In the first case I cannot understand, how its supposed to find anything... maybe its to high for me :D.
De Kus
StarZ|De_Kus, De_Kus or DeKus on IRC
Copyright © 2005-2009 by De Kus - published under The MIT License
Love hurts, love strengthens...
C
Caribou
Voice
Posts: 28
Joined: Thu Apr 15, 2004 12:51 pm
Location: France

Post by Caribou »

Yeah $Letters contain random sentence, i mean i can be EFOIBZURLS for example. $Word will be every words who exists, and trying to check if they fit in EFOIBZURLS.
I saw some game coded in C/C++ who can execute this extremely fast, i wanted to check if TCL could make it since i dont know how C is working yet :D

By the way a website got a similar script, in Php, who do it in few seconds. (don't know if it is pure Php since i cant see the source code)
http://www.capeutservir.com/mots/pluslong.php
(its in french, enter any letters like "giorengioebfz" if ya what, select "-13" and run it, you will see it is fast to make a list of all words)

Also my database contain 364370 words :cry: it has to be said. (french words)
User avatar
user
&nbsp;
Posts: 1452
Joined: Tue Mar 18, 2003 9:58 pm
Location: Norway

Re: About scrabble game

Post by user »

How about creating an optimized database containing a list of possible words for a set of letters and keep an array with <sorted letters> => <count> + <position in the optimized database file>?

To sort the letters in a word:

Code: Select all

set sorted [join [lsort [split $word ""]] ""]
Oh and btw: your file will never be closed as you return before you close it :shock:
Caribou wrote:

Code: Select all

   return $count
   close $fileRead
EDIT: here's some code to show you what I was thinking:

Code: Select all

# do this only when the original data file is changed:
# (generates two files based on one
#  1: optimized data file with lists of words that use the exact same letters
#  2: lookup table with word counts and positions in data file (to 'seek' for when you want the data)
proc optimizeDB {inData outData outLookup} {
	set f [open $inData]
	set words [split [read -nonewline $f] \n]
	close $f
	# tmp(sorted letters) = {list of words that use these letters}
	foreach word $words {
		lappend tmp([join [lsort [split $word ""]] ""]) $word
	}
	# lookup(split sorted letters) = {wordCount positionInOutData}
	# + write groups of words to outData
	set f [open $outData w]
	set lookup {}
	foreach {sword words} [array get tmp] {
		lappend lookup [weirdSplit $sword] [list [llength $words] [tell $f]]
		puts $f $words
	}
	close $f
	# store the lookup table in a file and the global ::lookup array
	set f [open $outLookup w]
	puts $f $lookup
	close $f
	array set ::lookup $lookup
}

# find the number of words for the given set of letters
proc countPossibleWords letters {
	global lookup
	set sword [join [lsort [split $letters ""]] ""]
	set total 0
	foreach weird [array names lookup [string index $sword 0]*] {
		# check if each part of the list of letters is in our sorted word
		if {[string match *[join $weird *]* $sword]} {
			# ...it was...increase the counter
			incr total [lindex $lookup($weird) 0]
		}
	}
	set total
}

# utility proc to split sorted letters into groups containing the same letter
# aaabbc => {aaa bb c}
proc weirdSplit sword {
	set out {}
	foreach {group .} [regexp -all -inline "(.)(?:\\1)*" $sword] {
		lappend out $group
	}
	set out
}
Have you ever read "The Manual"?
C
Caribou
Voice
Posts: 28
Joined: Thu Apr 15, 2004 12:51 pm
Location: France

Post by Caribou »

Wow, what a job user, thats pretty nice, my skill is to low to understand everything.

Well you mean, i should convert everywords in a sorted sequence of letters, for example, MEDIUM become DEIMMU.
And also doing this to the random letters to compare them easily im right?

But i have a question, if the word is DEIMMU and the letters are DDEIIMMU, D'E'I'M'M'U isin D'D'E'I'I'M'M'U, but it is not equal, which part in your script doing the compare?
This part ?

Code: Select all

[string match *[join $weird *]* $sword]
I can't understand exactly what do *[join *]*

Is it like "isinside" ? cause exact sentence of "DEIMMU" is'nt in "DDEIIMMU" ... but maybe your *[join *]* doing something like "*D*E*I*MM*U*" ? and then it fit in "DDEIIMMU"

Sorry for my bad english, im just trying to understand the whole of your coding.

I'll have to try, and by the way, i know the game could work without giving the total words "makable" every times, but im just curious to know if TCL can handle this.
User avatar
stdragon
Owner
Posts: 959
Joined: Sun Sep 23, 2001 8:00 pm
Contact:

Post by stdragon »

It sounds like you're asking if you can also find partial words, like if you have "abcdefg" it should find "bag", not just words with ALL the letters. I don't have time right now but you might want to check to see if your proc will speed up if you just keep that file loaded into memory and search through it as a list or array rather than with gets.
O
Ofloo
Owner
Posts: 953
Joined: Tue May 13, 2003 1:37 am
Location: Belguim
Contact:

Post by Ofloo »

maybe you should parse it in a mysql db and let mysql querys handle the searching that way its gone be way faster.
XplaiN but think of me as stupid
User avatar
user
&nbsp;
Posts: 1452
Joined: Tue Mar 18, 2003 9:58 pm
Location: Norway

Post by user »

Forget what I said about keeping that array...i didn't realize there would be so many unique combinations (i had a dict with ~120000 words and only ~8000 shared the exact same letters :shock:)

I imagine you'll get faster matching by creating an "indexed" file with masks the way I described, but don't take my word for it...try it :)

(I did a test on that dict of mine and it managed to check every single combination in about 2 seconds on a 700mhz pIII - didn't check vs. your version though)
Have you ever read "The Manual"?
User avatar
stdragon
Owner
Posts: 959
Joined: Sun Sep 23, 2001 8:00 pm
Contact:

Post by stdragon »

Hey I have a pretty simple algorithm that works well for finding anagrams of small groups of letters (1-12). It's not a bad restriction because scrabble only gives you 7 letters. I dunno about your game though.

Anyway, here's a sample:

# Short words are very fast: this one is .0003 seconds
% anagram_check dragon
dragon argon groan organ adorn radon grand
% time {anagram_check dragon} 10
353 microseconds per iteration

# Longer words aren't bad either. This one is about .005 seconds
% time {anagram_check stdragon} 10
5399 microseconds per iteration
% puts $anagram(results)
strong snort tongs roast rants arson sonar goats argot gator grants angst gnats grant argon groan organ groans organs darts toads roads strand stand darns adorn radon adorns drags grand grands dragon dragons

# Default is to only return anagrams > 5 letters. Setting the min to 1
# will increase the time it takes, and returns a bunch of dumb words like
# "no". Still very fast, about .01 seconds.
% time {anagram_check stdragon 1} 10
15110 microseconds per iteration
% puts $anagram(results)
strong snort rots sort to so rot or tons not ton no on son torn nor got go tongs song dots dot do sod trod rod rods don nod dons nods dog god dogs gods roast arts rats star sat at as art rat tar oats oat oar oars soar rants ants ant tan an rant ran arson sonar stag tags tag gas sag rag rags goats goat ago argot gator grants angst gnats gnat tang nag nags sang snag grant rang argon groan organ groans organs darts ad ads sad dart toads toad ado soda road roads strand stand and sand darn darns adorn radon adorns gad drag grad drags goad grand grands dragon dragons

# Big sets of letters take much much longer... better to use a different
# algorithm (not included)! This example takes about 7 seconds.
% time {anagram_check abcdefghijklmnop} 1
6974811 microseconds per iteration
% puts $anagram(results)
kilohm poling lingo login poking joking hoping homing fling lemon melon impel liken phone pinhole gnome pigeon legion mingle jingle hinge neigh helping felon knife feign dolphin doping dingo doing molding kingdom holding folding moped demon poled olden model poked joked pined impend mined dipole piled plied oiled lined dimple limped inked liked kindle linked milked joined phoned hoped honed homed holed holden hiked lodge golden longed deign glide mingled modeling godlike jingled hinged fondle fiend fined field filed foiled filmed knifed clink pinch chink coping coming logic cling mocking locking choking flock flick flinch flocking clone compel mince income police pencil compile polemic clime pickle nickel epoch choke hemlock phonemic niche chime pinochle lichen gecko pecking echoing fickle chief child coding coped cloned mocked locked copied coined medic minced demonic policed coiled docile compiled complied picked nicked pickled licked clinked choked chide pinched inched chinked ceding decking flocked confide flicked flinched blimp limbo blink bingo goblin noble bloke mobile nimble globe belong begin being binge bilge oblige ignoble foible befog blond blind boned blend blonde biped boiled bilked blinked behold behind obliged beholding block climb combing blocking beckon bicep combine bench belch becoming belching combed blocked bodice combined climbed polka plank piano amino plain kanji among along logjam aping amigo paling align palming laming malign making flank final foaming flaming faking flaking panel penal plane alone ample maple oaken ankle anomie alpine alien impale menial alike manhole aphelion inhale omega angel angle glean gleam mangle magpie image enigma agile leaping pealing genial leaking linkage homage halogen heaping healing flame flake famine inflame foliage leafing nodal modal almond podia domain plaid diploma kidnap adjoin aphid dogma gland damping dialog lading loading manifold fading anode dampen amend named daemon moaned paled pedal plead planed laden loaned palmed lamed medal knead naked pained aimed amide media maiden median ideal denial nailed mailed jailed handle pinhead hailed inhaled gaped paged gamed glade angled dangle mangled gained pleading aligned dealing leading hanged headlong heading famed foamed loafed flamed faked flaked flanked afield failed inflamed fangled clamp cloak clank complain panic manic anomic alnico claim poach macho chalk champion aphonic chain caliph hijack clang pacing magic camping placing lacing clamping calming packing caking lacking cajoling jacking aching hacking chalking focal falcon flack facing chafing canoe ocean encamp place clean lance camel cajole policeman anemic cinema pelican malice cheap peach chapel impeach machine glance coinage angelic change fiance facile chafe padlock monadic placid paced dance deacon camped maced placed decal laced candle lanced clamped calmed packed caked lacked cajoled complained pandemic comedian demoniac claimed decimal medical panicked ached hacked chalked championed chained machined hijacked caged clanged glanced changed faced fancied aplomb blank banjo akimbo gambol ambling blaming baking balking bemoan amble blame bleak biplane plebian began bagel gable bangle gamble beaming fable behalf bland bimodal balding abode adobe abdomen blade ambled bedlam blamed baked banked balked blanked abide mandible badge banged bondage gabled gambled beading fabled bacon black cabin blanch backlog cabling backing blacking bifocal beacon placebo cable becalm blacken beach bleach blockage becalming beaching bleaching blockading cabled backed blacked blockade blanched boldface

Oops I have to go, but I'll put a link to the script later!
User avatar
stdragon
Owner
Posts: 959
Joined: Sun Sep 23, 2001 8:00 pm
Contact:

Post by stdragon »

C
Caribou
Voice
Posts: 28
Joined: Thu Apr 15, 2004 12:51 pm
Location: France

Post by Caribou »

I have not much time to test your tips right now (on vacancy), but i'll try them soon.

Downloaded your tcl script stdragon, taking a look on it, thank you so much.
Locked