### Re^2: Challenge: 8 Letters, Most Words

by oiskuu (Hermit)
 on Oct 09, 2013 at 14:33 UTC ( #1057558=note: print w/replies, xml ) Need Help??

in reply to Re: Challenge: 8 Letters, Most Words
in thread Challenge: 8 Letters, Most Words

Ok, I tried to filter the word set before going into loops. This appears to reduce the search space by a factor of 30.
Run time is down to ~5 minutes.

```Word counts for 2of12inf.txt, along with word "power":
============================
WORDS           COMBINATIONS
len:number      k:number
----------------------------
2: 62           6: 736281
3: 642          5: 142506
4: 2546         4: 23751
5: 5122         3: 3276
6: 8303         2: 351
7: 11571        1: 26
8: 12687        0: 1
============================

Expected hits: 12687*1 + 11571*26 + 8303*351 + 5122*3276 + 2546*23751
++ 642*142506 + 62*736281
= 217615878
Counted hits (with filtering):
= 217615878

```#! /usr/bin/perl
use Config;
use if \$Config{longsize} >= 8, "integer";

my \$HITS :shared = 0;
my \$TOTAL;
my \$tresh = 0;
my (%P, %N, %RES);

sub x2 { map { my \$t = \$_; map {\$t.\$_} @_ } @_ }
sub wfilt { tr/a-z//cd; length() <= 8; }
sub wv { my \$x = 1; \$x *= \$P{\$_} for split //; \$x }
@P{'a'..'z'} = grep {(1x\$_)!~/^(11+)\1+\$/} 2..101;      # Primes

# combinations with repetition over 'a'..'z':
my @C = ( 1, 26, 351, 3276, 23751, 142506, 736281, 3365856, 13884156 )
+;

open(WORDS, "words") or die;
my @words = grep wfilt, <WORDS>;
\$N{wv()}++ for @words;
\$TOTAL += \$C[8-length] for @words;

for ('a'..'z') {
\$SEM->down();
}

sub worker {
my (\$pivot) = @_;                                     # aaaPzzzz
my (%A, %Z);

\$A{wv()} //= \$_ for grep s/.\$/\$pivot/, x2(x2('a'..\$pivot));
\$Z{wv()} //= \$_ for x2(x2(\$pivot..'z'));

my \$aaa = sub { join '', /[^\$pivot-z]/g };
my \$zzzz = sub { join '', /[^a-\$pivot]/g };

# map full wv to just the aaa factors:
my %Va = map {wv} map {\$_ => &\$aaa}
grep {length &\$aaa < 4 and length &\$zzzz < 5} @words;

for my \$a (keys %A) {
my @V = grep {\$a % \$Va{\$_} == 0} keys %Va;
my (\$hits, @R);
for my \$z (keys %Z) {
my (\$v, \$n) = (\$a*\$z, 0);
\$v % \$_ or \$n += \$N{\$_} for @V;
\$hits += \$n;
push @R, (\$A{\$a}.\$Z{\$z} => \$n) if (\$n > \$tresh);
}
report(\$hits, @R);
}
return (%RES);
}

sub report {
lock(\$HITS); \$HITS += shift;
return unless @_;

%RES = (%RES, @_);
my @top = sort { \$RES{\$b} <=> \$RES{\$a} } keys %RES;
(\$tresh) = delete @RES{splice(@top, 20)} if @top > 20;
print "\$_: \$RES{\$_}\n" for @top;

no integer;
printf "! coverage %s/%s (% 3.1f%%)\n@{['-'x40]}\n",
\$HITS, \$TOTAL, 100.0*\$HITS/\$TOTAL;
}

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2017-11-20 04:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
In order to be able to say "I know Perl", you must have:

Results (284 votes). Check out past polls.

Notices?