Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re: One for the weekend: challenge

by Limbic~Region (Chancellor)
on Jun 01, 2008 at 02:56 UTC ( #689490=note: print w/ replies, xml ) Need Help??


in reply to One for the weekend: challenge

BrowserUk,
The following code should produce the correct output. I have tested it individually on a handful of the "expected output" numbers. I am going to let it run overnight to see how long it takes. Using perl -MO=Deparse solution.pl | wc -l it is 44 lines of code.

#!/usr/bin/perl use strict; use warnings; use Algorithm::Loops qw/NextPermute NestedLoops/; use Integer::Partition::Unrestricted; # see http://perlmonks.org/?node +_id=533164 my %lookup = ( E => 0, e => 0, J => 1, j => 1, N => 1, n => 1, Q => 1, q => 1, R +=> 2, r => 2, W => 2, w => 2, X => 2, x => 2, D => 3, d => 3, S => 3, s => 3, Y +=> 3, y => 3, F => 4, f => 4, T => 4, t => 4, A => 5, a => 5, M => 5, m => 5, C +=> 6, c => 6, I => 6, i => 6, V => 6, v => 6, B => 7, b => 7, K => 7, k => 7, U +=> 7, u => 7, L => 8, l => 8, O => 8, o => 8, P => 8, p => 8, G => 9, g => 9, H +=> 9, h => 9, Z => 9, z => 9 ); my ($fh, $part, %data) = (undef, Integer::Partition::Unrestricted->new +(), ()); open($fh, '<', 'dictionary.txt') or die "Unable to open 'dictionary.tx +t' for reading: $!"; while (<$fh>) { chomp; my $num = join '', map {defined $lookup{$_} ? $lookup{$_} : ()} sp +lit //, $_; push @{$data{$num}}, $_; } $data{$_} = [$_] for 0 .. 9; open($fh, '<', 'input.txt') or die "Unable to open 'input.txt' for rea +ding: $!"; while (<$fh>) { chomp; my $num = $_; $num =~ s/\D//g; my $next = $part->gen_iter(length($num)); while (my @part = sort {$a <=> $b} $next->()) { my $ones = "@part" =~ tr/1//; next if $ones > ((@part - 1) / 2 + 1); my $ok = 1; while ($ok) { next if "@part" =~ /\b1 1\b/; my $template = join '', map {'A' . $_} @part; my @dig = unpack($template, $num); next if grep {! defined $data{$_}} @dig; my @solution = map {[@{$data{$_}}]} @dig; my $iter = NestedLoops( \@solution ); while (my @list = $iter->()) { print "$_: @list\n"; } } continue { $ok = NextPermute(@part); } } }

In a nutshell, it generates the unrestricted integer partitions of the number. It skips over any partitioning that has so many 1s it could not satisfy the problem constraints. It then generates all permutations of each possible partition - skipping over partitioning with two adjacent 1s. It then checks if it produces a valid solution. I am sure it could be optimized a lot, but that would add code complexity and lines of code.

Update: Shortly after posting, I realized by re-arranging some logic it would be more efficient. The node has been updated to reflect that.

Cheers - L~R


Comment on Re: One for the weekend: challenge
Select or Download Code
Re^2: One for the weekend: challenge
by karavelov (Monk) on Jun 01, 2008 at 06:54 UTC
    It loops forever on long numbers. And sometimes produces false results. I have not analyzed why exactly this is wrong but for the number -810873502888/74-556227/1 (the last number of the output.txt) it gives 62 results while the number of correct results is 18.
      karavelov,
      Thanks. I am not going to invest too much time in it as I believe the logic to be sound - the implementation is the problem.

      Cheers - L~R

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (11)
As of 2014-10-20 23:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (93 votes), past polls