Re: unscrambler speedup rewrite

2006-06-20 Thread Chad Perrin
On Mon, Jun 19, 2006 at 11:54:46PM -0400, Jeremy Kister wrote:
 I wrote a word descrambler that works very well, but is very slow 
 compared to http://www.jumble.org

Whew.  Judging by the subject line, I was worried this was going to turn
out to be spam.

-- 
CCD CopyWrite Chad Perrin [ http://ccd.apotheon.org ]
Brian K. Reid: In computer science, we stand on each other's feet.

-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response




RE: unscrambler speedup rewrite

2006-06-20 Thread Charles K. Clarkson
Jeremy Kister wrote:

 I'm wondering how others could write to code so that it'd
 find words faster.

You don't say where the speed problem is. There are two
distinct parts to your script. Loading the dictionary and
finding the scrambled word.

The scrambling algorithm depends on splitting every same
length word in the dictionary into a character array and then
comparing each character against the characters in the
selected word or words.

A better choice might compare entire words. You could
massage the dictionary entries in another script into a hash
with two words for each entry. The second entry would contain
all the words of each alphabetized letter arrangement.
Assuming these are the only 3 letter words in the dictionary,
each entry might look like this.

aet = [ 'ate', 'tea', 'eta', ],
art = [ 'rat', 'tar', 'art', ]
foo = [ 'foo' ],


Store the dictionary hash with Storable or with DBM::Deep
and access it as a hash in the guessing part of the script.
In the data massaging script we might use this to stuff words
into the hash (warning: untested code). Note that this code
only needs to be run when the dictionary changes, not each
time the scramble script runs.


use strict;
use warnings;
use Storable 'store';

my $dir = $ENV{'HOME'}/data/dictionary/;
opendir my $dh, $dir or die qq(Cannot open $dir: $!);

my( %dictionary, $word_count );
foreach my $file ( grep {/^english-word/} readdir $dh ){

open my $fh, $dir$file or next;

while ( my $word = $fh ) {
next if $word =~ /[^a-z]/;
chomp $word;
my $alpha = join '', sort split //, $word;
push @{ $dictionary{ $alpha } }, $word;
$word_count++;
}
}

close $dh;

store( \%dictionary, 'scramble.db' );

# Feedback.
printf
Stored %s words in %s keys\n,
$word_count,
scalar keys %dictionary;

__END__



Assuming the dictionary hash is in scramble.db, we might
do something like this (warning: untested code).

use strict;
use warnings;
use Storable 'retrieve';

# This loads the special dictionary.
my $dictionary = retrieve( 'scramble.db' );

while (1) {
print 'word: ';
chomp( my $scramble = STDIN );

last if $scramble eq 'q';

( my $alpha = $scramble ) =~ s/\s+//g;

# test this to see what it does.
$alpha = join '', sort split //, lc $alpha;

if ( defined $dictionary-{$alpha} ) {

if ( @{ $dictionary-{$alpha} } ) {

print \n;
foreach my $word ( @{ $dictionary-{$alpha} } ) {
next if $word eq $scramble;
print $word\n;
}
print \n;

} else {
print qq(Sorry, I cannot scramble $scramble.\n\n);
}

} else {
print qq(Sorry, I cannot scramble $scramble.\n\n);
}
}

__END__

HTH,

Charles K. Clarkson
-- 
Mobile Homes Specialist
Free Market Advocate
Web Programmer

254 968-8328

Don't tread on my bandwidth. Trim your posts.


-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response




Re: unscrambler speedup rewrite

2006-06-20 Thread John W. Krahn
Jeremy Kister wrote:
 I wrote a word descrambler that works very well, but is very slow
 compared to http://www.jumble.org
 
 I'm wondering how others could write to code so that it'd find words
 faster.
 
 #useful with dictionary from http://wordlist.sourceforge.net/
 
 
 use strict;
 
 my %dictionary;
 opendir(DIR, $ENV{'HOME'}/data/dictionary/);
 foreach my $file (grep {/^english-word/} readdir DIR){
 open(DICT, $ENV{'HOME'}/data/dictionary/$file);
 warn reading data/dictionary/$file\n;
 while(DICT){
 chop;
 next unless(/^[a-z]+$/);
 my $len = length($_);
 push @{$dictionary{$len}}, $_;
 }
 close DICT;
 }
 closedir DIR;
 
 while(1){
 print word: ;
 chop(my $scramble = STDIN);
 $scramble =~ s/\s+//g;
 
 my $slen = length($scramble);
 my @s = split //, $scramble;
 foreach my $word (@{$dictionary{$slen}}){
 my @w = split //, $word;
 my $found;
 foreach my $sl (0..($slen-1)){
 foreach my $l (0..($slen-1)){
 if($s[$sl] eq $w[$l]){
 delete $w[$l];
 $found++;
 last;
 }
 }
 last unless($found);
 }
 next unless($found == $slen);
 print $word\n;
 }
 }

This runs a bit faster:

use warnings;
use strict;

my $dir = $ENV{HOME}/data/dictionary;

opendir DIR, $dir or die Cannot open '$dir' $!;

my %dictionary;
while ( my $file = readdir DIR ) {
next unless /^english-word/;
open DICT, '', $dir/$file or die Cannot open '$dir/$file' $!;
warn reading data/dictionary/$file\n;
while ( DICT ) {
chomp;
next unless /^[a-z]+$/;
push @{ $dictionary{ join '', sort /[a-z]/g } }, $_;
}
close DICT;
}
closedir DIR;

while ( 1 ) {
print 'word: ';
my $scramble = join '', sort STDIN =~ /[a-z]/g;

print map $_\n, @{ $dictionary{ $s } } if exists $dictionary{ $s }
}

__END__



John
-- 
use Perl;
program
fulfillment

-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response




Re: unscrambler speedup rewrite

2006-06-19 Thread Jeremy Kister

On 6/19/2006 11:54 PM, Jeremy Kister wrote:
I wrote a word descrambler that works very well, but is very slow 
compared to http://www.jumble.org


already found a very important piece that I missed ($lfound)..

while(1){
print word: ;
chop(my $scramble = STDIN);
$scramble =~ s/\s+//g;

my $slen = length($scramble);
my @s = split //, $scramble;
foreach my $word (@{$dictionary{$slen}}){
my @w = split //, $word;
my $found;
foreach my $sl (0..($slen-1)){
my $lfound;
foreach my $l (0..($slen-1)){
if($s[$sl] eq $w[$l]){
delete $w[$l];
$found++;
$lfound=1;
last;
}
}
last unless($found  $lfound);
}
next unless($found == $slen);
print $word\n;
}
}




--

Jeremy Kister
http://jeremy.kister.net./

--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response