#!/usr/bin/perl
use constant PIECES => 0;
use constant POSITION => 1;
use constant USED_DIG => 2;
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.txt' for reading: $!";
while (<$fh>) {
chomp;
# 123-4/56 -> 123456 -> push @{data{1}{2}{3}{4}{5}{6}{nodes}}, '123-4/56'
eval join '', 'push @{$data', (map {defined $l{$_} ? "{$l{$_}}" : ()} split //, $_), "{nodes}}, '$_';";
}
open($fh, '<', 'input.txt') or die "Unable to open 'input.txt' for reading: $!";
while (<$fh>) {
chomp;
# Make a copy of original phone number for readability (not $_)
my $orig_num = $_;
# Make a copy of phone number using just digits
my $num = join '', /(\d+)/g;
# Determine the position of last digit in phone number for substr
my $end = length($num) - 1;
# Special case - if single digit, print it and move on
if (! $end) {
print "$orig_num: $num\n";
next;
}
# Initialize potential solution queue
my @solution = ([
["$orig_num:"], # pieces of solution
0, # position in $num to look for next piece
0 # boolean to indicate last piece was not digit
]);
while (@solution) {
# Get a reference to our data tree
my $tree = \%data;
# Get a potential solution off the queue
my $work = pop @solution;
# Boolean indicating we have not yet found the next piece of a solution
my $found = 0;
# Record the first digit in the next solution piece. Needed in case no words found
my $first = substr($num, $work->[POSITION], 1);
# Find all possible words from the current position to the end of $num
for my $pos ($work->[POSITION] .. $end) {
# Get the digit associated with the current position
my $dig = substr($num, $pos, 1);
# There are no possible solutions beyond this point in the $num
if (! exists $tree->{$dig}) {
# If we have not yet found a solution and didn't use a digit in last piece
if (! $work->[USED_DIG] && ! $found) {
# Indicate we found the next piece of solution
$found = 1;
# Use a digit as the next piece and put the solution back on the work queue
push @solution, [
[@{$work->[PIECES]}, $first], # Add digit to possible solution set
$work->[POSITION] + 1, # Increment the position by 1
1 # Indicate we used a digit for last piece
];
# No more possible solutions can exist, so move on
last;
}
}
# Move one step down in our data tree
$tree = $tree->{$dig};
# If any words can be found at this depth
if (exists $tree->{nodes}) {
# Indicate we found the next piece of solution
$found = 1;
# If we are at the end of the phone number
if ($pos == $end) {
# For each word found
for my $word (@{$tree->{nodes}}) {
# Print all the pieces of the solution
print join ' ', @{$work->[PIECES]}, $word;
print "\n";
}
# No more possible solutions can exist (end of num), so move on
last;
}
# If only one digit remains in the phone number
if ($end - $pos == 1) {
# Grab that last digit
my $last_dig = substr($num, $end, 1);
# For each word found at current position
for my $word (@{$tree->{nodes}}) {
# Print all the pieces of the solution using last dig as last piece
print join ' ', @{$work->[PIECES]}, $word, $last_dig;
print "\n";
}
# If the data tree doesn't have a branch for the next digit
# Or if the branch for the next digit has no word nodes
# Then no more possible solutions, so move on
last if ! exists $tree->{$last_dig} || ! exists $tree->{$last_dig}{nodes};
}
# We are not yet at the end, so push each word on to the possible solution queue
for my $word (@{$tree->{nodes}}) {
push @solution, [
[@{$work->[PIECES]}, $word], # Add word to possible solution set
$pos + 1, # Increment position by 1
0 # Indicate last piece was not a digit
];
}
}
}
# If we made it all the way to the end
# And we did not find a possible solution
# And the last piece found was not a digit
# Use the first digit seen as a possible piece
if (! $found && ! $work->[USED_DIG]) {
push @solution, [
[@{$work->[PIECES]}, $first], # Add digit to possible solution set
$work->[POSITION] + 1, # Increment position by 1
1 # Indicate last piece was a digit
];
}
}
}