Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Re^7: Challenge: 8 Letters, Most Words

by BrowserUk (Pope)
on Oct 05, 2013 at 00:12 UTC ( #1056959=note: print w/ replies, xml ) Need Help??


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

I'll present my "solution" as sson as I have the feeling I did it right.

The beauty of challenges is that no one is harmed -- and we can all learn from -- imperfect attempts.

The trouble with waiting for brute force is that if you've not considered something, that someone else can point out, you've a long time to wait before you discover that.

I look forward to critiquing your approach :)


With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
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.


Comment on Re^7: Challenge: 8 Letters, Most Words
Re^8: Challenge: 8 Letters, Most Words
by McA (Priest) on Oct 05, 2013 at 00:16 UTC

    Well spoken! (++)

    I hope there will be no reason for doing so, besides of the runtime... ;-)

    I'm really curious.

    I'm just searching for a module helping me to parallize the approch. I need one which is able to return results to the parent.

    UPDATE: The very first output of my script is:

    'tux' can be produced by 'aaaaatux'

    I'm sure THIS IS A SIGN! ;-)

    Regards
    McA

      UPDATE: The very first output of my script is: 'tux' can be produced by 'aaaaatux' I'm sure THIS IS A SIGN! ;-)

      Hm. Neither tux nor aaaaatux appear in either my dictionary or 2of12int.txt?


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      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.

        As the original author says:

        ...I tend to use the 2of12inf from...

        and in the file 2of12inf.txt I do find 'tux' on line 75305. ;-)

        Regards
        McA

      McA,
      You may want to look at my solution as it will likely be the heat death of the universe before your code finishes if you wrote it in Perl. I too considered divide and conquer approach but abandoned it for simplicity and the fact that I can do millions of iterations per second in C.

      Cheers - L~R

        Good morning all.

        I suspect L~R will be right with his assumption concerning the runtime. I do have to ask my colleagues if they mind when they loose one processor on the development machine the next week... :-)

        Therefor I show my solution to receive the critics I earn.

        Have a nice day
        McA

        #!/usr/bin/perl use strict; use warnings; use Data::Dumper; use 5.010; $| = 1; my %words; my %sorted; my %alphabet; while(defined(my $line = <>)) { chomp $line; next if $line =~ /%$/; # ignore entries with '%' at the end my $slot = length $line; $line = lc $line; next if $slot > 8; next if exists $words{$line}; $words{$line} = 1; my @chars = sort split //, $line; %alphabet = (%alphabet, map { $_ => 1 } @chars); my $characters = join('', @chars); if(defined $sorted{$characters}) { push @{$sorted{$characters}}, $line; } else { $sorted{$characters} = [$line]; } } my @sorted = keys %sorted; say "Base: " . scalar @sorted . " unique words"; my @alphabet = sort keys %alphabet; my $word; my $count = @alphabet; my $permutations = 0; my %found; my $max_found = 0; foreach (my $pos1 = 0; $pos1 < $count; $pos1++) { foreach (my $pos2 = 0; $pos2 < $count; $pos2++) { next if $pos2 < $pos1; foreach (my $pos3 = 0; $pos3 < $count; $pos3++) { next if $pos3 < $pos2; foreach (my $pos4 = 0; $pos4 < $count; $pos4++) { next if $pos4 < $pos3; foreach (my $pos5 = 0; $pos5 < $count; $pos5++) { next if $pos5 < $pos4; foreach (my $pos6 = 0; $pos6 < $count; $pos6++) { next if $pos6 < $pos5; foreach (my $pos7 = 0; $pos7 < $count; $pos7++ +) { next if $pos7 < $pos6; foreach (my $pos8 = 0; $pos8 < $count; $po +s8++) { next if $pos8 < $pos7; # Check what can be produced by this c +ombination $permutations++; say $permutations if $permutations % 1 +000 == 0; my %source; $source{$_}++ for(@alphabet[$pos1, $po +s2, $pos3, $pos4, $pos5, $pos6, $pos7, $pos8]); #say "================================ +==========="; #say "Source: ". Dumper(\%source); my @last; my $source; INNER: foreach my $word (@sorted) { #say "Word: $word"; my %source_copy = (%source); for(my $i = 0; $i < length $word; +$i++) { my $c = substr($word, $i, 1); next INNER unless $source_copy +{$c}; $source_copy{$c}--; } $source = join '', @alphabet[$pos1 +, $pos2, $pos3, $pos4, $pos5, $pos6, $pos7, $pos8]; #say join(', ', @{$sorted{$word}}) + . "' can be produced by '$source'"; push @last, @{$sorted{$word}}; } # something found which can be produce +d if(@last) { if(@last > $max_found) { %found = (); $found{$source} = [@last]; $max_found = @last; } elsif (@last == $max_found) { $found{$source} = [@last]; } } } } } } } } } } say "Found. $permutations out of $count unique characters"; say Dumper(\%found);

Log In?
Username:
Password:

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

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

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





    Results (61 votes), past polls