Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re: One for the weekend: challenge

by Limbic~Region (Chancellor)
on Jun 03, 2008 at 03:17 UTC ( #689795=note: print w/ replies, xml ) Need Help??


in reply to One for the weekend: challenge

BrowserUk,
Now that I understand the problem, here is a correct working solution that is relatively fast (8 seconds locally). Running it through perl -MO=Deparse solution.pl | wc -l indicates it is 42 lines. It isn't very clean as I didn't have very much time to implement. If I have time, I will see about clarity and optimizations. If nothing else, I will add comments tomorrow so at least the algorithm is clear even if the code is not.

#!/usr/bin/perl use strict; use warnings; my %l = ( 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, %data); open($fh, '<', 'dictionary.txt') or die "Unable to open 'dictionary.tx +t' for reading: $!"; while (<$fh>) { chomp; eval join '', 'push @{$data', (map {defined $l{$_} ? "{$l{$_}}" : +()} split //, $_), "{nodes}}, '$_';"; } open($fh, '<', 'input.txt') or die "Unable to open 'input.txt' for rea +ding: $!"; while (<$fh>) { chomp; my $num = join '', /(\d+)/g; my $end = length($num) - 1; print "$_: $num\n" and next if ! $end; my @solution = [["$_:"], 0, 0]; while (@solution) { my ($tree, $work) = (\%data, pop @solution); my ($found, $first) = (0, substr($num, $work->[1], 1)); for my $pos ($work->[1] .. $end) { my $dig = substr($num, $pos, 1); if (! exists $tree->{$dig}) { push @solution, [[@{$work->[0]}, $first], $work->[1] + + 1, 1] if ! $work->[2] && ! $found++; last; } $tree = $tree->{$dig}; if (exists $tree->{nodes} && ++$found) { if ($pos == $end) { print join(' ', @{$work->[0]}, $_), "\n" for @{$tr +ee->{nodes}}; last; } if ($end - $pos == 1) { my $last_dig = substr($num, $end, 1); print join(' ', @{$work->[0]}, $_, $last_dig), "\n +" for @{$tree->{nodes}}; last if ! exists $tree->{$last_dig} || ! exists $t +ree->{$last_dig}{nodes}; } push @solution, [[@{$work->[0]}, $_], $pos + 1, 0] for + @{$tree->{nodes}}; } } push @solution, [[@{$work->[0]}, $first], $work->[1] + 1, 1] i +f ! $work->[2] && ! $found; } }

Cheers - L~R


Comment on Re: One for the weekend: challenge
Select or Download Code
Re^2: One for the weekend: challenge
by BrowserUk (Pope) on Jun 03, 2008 at 04:14 UTC
      So which solution matched up to your expectations the best? I haven't tried all of them yet... waiting for my next break.
      BrowserUk,
      Here is the same code re-written to be more clear and maintainable. I still think the handful of special case scenarios could be reduced to a more general case. Unfortunately, I don't have time to try.

      Cheers - L~R

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2014-07-25 00:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (167 votes), past polls