Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^7: Challenge: 8 Letters, Most Words

by choroba (Abbot)
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 (Abbot) 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 making s'mores by the fire in the courtyard of the Monastery: (6)
As of 2014-04-19 15:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (482 votes), past polls