Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re^7: Challenge: 8 Letters, Most Words

by choroba (Canon)
on Oct 05, 2013 at 08:22 UTC ( #1057013=note: print w/ replies, xml ) Need Help??


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

Something like the following? It slows the algorithm terribly, though...

#!/usr/bin/perl use warnings; use strict; use feature qw(say); my %lc_words; my $dict = shift; my $FH; open $FH, '<', $dict or $FH = *DATA; while (<$FH>) { chomp; next if length > 8; my $lc = lc; $lc_words{$lc} = 1; } say scalar keys %lc_words; my %sorted_count; for (keys %lc_words) { my @letters = sort split //; my $sorted = join q(), @letters; $sorted_count{$sorted}++; } say "$_: $sorted_count{$_}" for sort { $sorted_count{$a} <=> $sorted_count{$b} } keys %sorted_count; print '-' x 78, "\n"; my %summed = %sorted_count; for my $length (1 .. 7) { warn $length; for my $sorted (grep $length == length, keys %sorted_count) { my $regex = join '.*', split //, $sorted; for my $longer (grep $length < length, keys %sorted_count) { $summed{$longer} += $sorted_count{$sorted} if $longer =~ $ +regex; } } } sub merge { my ($str1, $str2) = @_; my $merged = q(); while(length $str1 . $str2) { my $char1 = substr $str1, 0, 1; my $char2 = substr $str2, 0, 1; if ($char1 eq $char2) { $merged .= substr $str1, 0, 1, q(); substr $str2, 0, 1, q(); } elsif ($char1 ne q() and $char1 lt $char2 or $char2 eq q()) +{ $merged .= substr $str1, 0, 1, q(); } else { $merged .= substr $str2, 0, 1, q(); } return if length $merged > 8; } return $merged; } warn "Merging...\n"; my $added; while (1) { $added = 0; my @shorter = grep 8 > length, keys %summed; for my $str1 (@shorter) { for my $str2 (@shorter) { next if $str1 le $str2; my $merged = merge($str1, $str2); if (defined $merged and $str1 ne $merged and $str2 ne $merged) { next if exists $summed{$merged}; $summed{$merged} = $summed{$str1} + $summed{$str2}; $added++; } } } last unless $added; warn "Added $added\n"; } say "$_: $summed{$_}" for sort { $summed{$a} <=> $summed{$b} } keys %summed; __DATA__ abcd acdb adbc dabc bcad efgh fgeh hegf egfh fegh abcdxy efghlm
لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ


Comment on Re^7: Challenge: 8 Letters, Most Words
Download Code
Re^8: Challenge: 8 Letters, Most Words
by choroba (Canon) on Oct 05, 2013 at 11:28 UTC
    Another idea: preprocess the input, adding all the combinations of the shorter words. Then run the original code without postprocessing. I will try to test it later, not much time at the moment...
    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2015-07-04 19:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (60 votes), past polls