Problems? Is your data what you think it is? PerlMonks

Re: One for the weekend: challenge

 on Jun 01, 2008 at 15:27 UTC ( #689562=note: print w/replies, xml ) Need Help??

in reply to One for the weekend: challenge

This took about two hours to write, through three iterations to get reasonable performance (under one second on a Sempron 3000). I'm sure I'll have issues with the "maintainability" score :)
```
#!perl
use strict;
my %dict;
@ARGV = qw( d.dict d.input );

while(<>) # read in both files, load dict on first, match on second
{
chomp;
(my \$d = lc) =~ tr|a-z"/-|57630499617851881234762239|d;
\$ARGV eq 'd.dict' ?  push @{\$dict{\$d}}, \$_ : match(\$d, 0, "\$_:");
}

sub match # (to match, last was digit, matches)
{
my (\$in, \$digit, @have, \$cnt) = @_;
\$in eq '' and return print "@have\n"; # have full match
for my \$k (map { substr \$in, 0, \$_ } 2..length \$in)
{
match(substr(\$in, length \$k), !++\$cnt, @have, \$_) for @{\$dict{\$k}}
+;
}
\$cnt or \$digit or match(substr(\$in, 1), 1, @have, substr \$in, 0, 1);
}

Replies are listed 'Best First'.
Re^2: One for the weekend: challenge
by karavelov (Monk) on Jun 01, 2008 at 21:30 UTC

Amazing! It runs very fast! Here it runs for 0,6 seconds on the standard set of 1000 numbers (compared to 2.2 sec my code). With growing the set of numbers they are comparable in speed - for 50000 numbers they are equal 13.7 seconds. It seems that I am hurt by the regex compile time.

I think your code is better than mine because :
1. you do not relay on some experimental features and recent optimizations;
2. The difference is in how we get the possible correct continuations of the number. My code generates them with the hairy regular expression. Your code generates all possible continuations and filter only the correct ones trough hash lookup.
3. less is more

Best regards
Re^2: One for the weekend: challenge
by BrowserUk (Pope) on Jun 01, 2008 at 15:59 UTC

Utterly, utterly amazing.

As presented, I think you would have to acquire a few maintainability demerits, but I don't think that it would be that hard to clean it up, and I don't think the result would hurt your timing or LOC unduly.

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
Remember when considering "maintainability" that the shorter the program, the easier it is to understand :)

/me ducks
Re^2: One for the weekend: challenge
by Anonymous Monk on Jun 03, 2008 at 14:09 UTC
Slightly faster :)
```#!perl
use strict;
my %dict;
@ARGV = qw( d.dict d.input );

while(<>) # read in both files, load dict on first, match on second
{
chomp;
(my \$d = lc) =~ tr|a-z"/-|57630499617851881234762239|d;
@ARGV ? push @{\$dict{\$d}}, \$_ : match(\$d, 0, "\$_:");
}

sub match # (to match, last was digit, matches)
{
my (\$in, \$digit, @have, \$k) = @_;
map match(substr(\$in, \$k), !++\$digit, @have, \$_),
@{\$dict{substr \$in, 0, \$k = \$_}} for 2..length \$in;
\$in =~ s/(.)// ? \$digit || match(\$in, 1, @have, \$1) : print "@have\n
+";
}

Create A New User
Node Status?
node history
Node Type: note [id://689562]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2018-06-24 11:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should cpanminus be part of the standard Perl release?

Results (126 votes). Check out past polls.

Notices?