#!/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.txt' for reading: $!"; while (<$fh>) { chomp; my $num = join '', map {defined $lookup{$_} ? $lookup{$_} : ()} split //, $_; push @{$data{$num}}, $_; } $data{$_} = [$_] for 0 .. 9; open($fh, '<', 'input.txt') or die "Unable to open 'input.txt' for reading: $!"; 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); } } }