Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re: Challenge: 8 Letters, Most Words

by oiskuu (Friar)
on Oct 08, 2013 at 15:28 UTC ( #1057426=note: print w/ replies, xml ) Need Help??


in reply to Challenge: 8 Letters, Most Words

Nice challenge. I went for a particular brute force approach that requires 64bit perl with threads.
Runs for ~140 mins on my quad-core. Top results:

aeinprst: 346 aeilprst: 344 adeiprst: 332 aeimprst: 328

Filtering 2of12inf.txt gives 40933 words, 35893 of which incongruent.
Exhaustive search must cover 13884156 letter combinations, like e.g.:

use Algorithm::Combinatorics qw(:all); my $iter = combinations_with_repetition(\@{['a'..'z']}, 8);

Anyway, this is what I wrote:

#! /usr/bin/perl use threads; use threads::shared; use Thread::Semaphore; use integer; my $CORES = 8; my $TOTAL :shared = 0; my $TDONE :shared = 0; my $tresh = 0; my (%P, %N, @W, @N, %RES); sub wfilt { tr/a-z//cd; length() <= 8; } sub wval { my $x = 1; $x *= $P{$_} for split //; $x } @P{'a'..'z'} = grep {(1x$_)!~/^(11+)\1+$/} 2..101; open(WORDS, "words") or die; @W = grep wfilt, <WORDS>; $N{&wval}++ for @W; @N = keys %N; my $SEM = Thread::Semaphore->new($CORES); my @T = map threads->new(\&worker, $_), 'a'..'z'; report ((map {$_->join()} @T), 0); sub x2 { map { my $t = $_; map {$t.$_} @_ } @_ } sub worker { my ($pivot) = @_; # aaaPzzzz my (%A, %Z, @A, @Z, $a, $z); $A{&wval} //= $_ for grep s/.$/$pivot/, x2(x2('a'..$pivot)); $Z{&wval} //= $_ for x2(x2($pivot..'z')); @A = keys %A; @Z = keys %Z; report (-int(@A)*int(@Z)); for $a (@A) { $SEM->down(); my @R; for $z (@Z) { my ($v, $n) = ($a*$z, 0); $v % $_ or $n += $N{$_} for @N; # 99.99% push @R, ($A{$a}.$Z{$z} => $n) if ($n > $tresh); } report (@R, int(@Z)); $SEM->up(); } return (%RES); } sub report { if ((my $n = pop) < 0) { lock($TOTAL); $TOTAL -= $n; } else { lock($TDONE); $TDONE += $n; } return unless @_; %RES = (%RES, @_); my @top = sort { $RES{$b} <=> $RES{$a} } keys %RES; delete @RES{splice(@top, 20)} if @top > 20; print "$_: $RES{$_}\n" for @top; $tresh = $RES{pop @top}; no integer; printf "! progress %d/%d (% 3.1f%%)\n@{['-'x40]}\n", $TDONE, $TOTAL, 100.0*$TDONE/$TOTAL; }


Comment on Re: Challenge: 8 Letters, Most Words
Select or Download Code
Re^2: Challenge: 8 Letters, Most Words
by oiskuu (Friar) on Oct 09, 2013 at 14:33 UTC

    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

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (8)
As of 2014-12-23 02:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (133 votes), past polls