Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re^2: Challenge: 8 Letters, Most Words

by oiskuu (Hermit)
on Oct 09, 2013 at 14:33 UTC ( [id://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

Update2: added coverage check

#! /usr/bin/perl use threads; use threads::shared; use Thread::Semaphore; 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; my $SEM = Thread::Semaphore->new(8); # 8 threads for ('a'..'z') { $SEM->down(); report(0, map {$_->join()} threads->list(threads::joinable)); ()=threads->new(sub {&worker, ()=$SEM->up()}, $_); } report(0, map {$_->join()} threads->list()); 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; }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1057558]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (5)
As of 2024-03-28 14:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found