[Wellington-pm] SEND + MORE = MONEY
Srdjan
srdjan at catalyst.net.nz
Wed Mar 2 14:25:30 PST 2005
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
I just couldn't help when I saw Ewen taking on this.
Ewen McNeill wrote:
|
| I'd like to make the recursion go away (recursion feels "wrong" -- I
| guess that means I didn't grow up a LISP programmer), but it's already
| complicated enough without doing explicit stack management.
Au contraire mes amis, I just love recursion. And I did not really bother with
managing stacks - I just make a copy of everything that will be discarded if
unsuccessful. I am a wasteful pig, but it could be improved by detecting places
where copying is not necessary because no changes that may need reversing are made.
Bonuses:
1. More than two words can be summed
2. Switch for allowing two letters to represent the same digit
use strict;
use POSIX qw(floor);
use Storable qw(dclone);
use Data::Dumper;
use constant SCRAPPED => 'SCRAPPED';
use constant CURRENT => 'CURRENT';
my $ALLOW_DUPS = 0;
my @summands = qw(SEND ME MORE);
my $sum = 'MONEY';
my @reversed_split_summands;
my $max_len = length($sum);
foreach (@summands) {
~ my $len = length($_);
~ $max_len = $len if $len > $max_len;
~ my @reversed_split = reverse($_ =~ /(\w)/g);
~ push @reversed_split_summands, \@reversed_split;
}
my @reversed_split_sum = reverse($sum =~ /(\w)/g);
my $sum_len = length($sum);
my %init_ctrl;
foreach ($sum, @summands) {
~ my $first_letter = substr($_, 0, 1);
~ $init_ctrl{$first_letter}{SCRAPPED()}{0} = 1;
}
my $solution_ctrl = try(\%init_ctrl, 0, 0, @reversed_split_summands);
$solution_ctrl or print "No solution\n", exit;
print "The solution\n";
traverse_ctrl($solution_ctrl, sub {
~ my ($letter, $letter_ctrl) = @_;
~ printf "%s => %d\n", $letter, $letter_ctrl->{CURRENT()};
});
sub traverse_ctrl {
~ my ($ctrl, $sub) = @_;
~ while ( my ($letter, $letter_ctrl) = each %$ctrl) {
~ $sub->($letter, $letter_ctrl);
~ }
}
sub try {
~ my ($ctrl, $pos, $carry, $my_element, @rest_of_the_summands) = @_;
~ $ctrl or die "No ctrl";
~ my $my_ctrl = dclone($ctrl);
~ unless ($my_element) {
~ my $new_carry = sum($my_ctrl, $pos, $carry);
~ return unless defined $new_carry;
~ if ($pos == $sum_len - 1) {
~ return $new_carry == 0 ? $my_ctrl : undef;
~ }
~ return try($my_ctrl, $pos + 1, $new_carry, @reversed_split_summands);
~ }
~ my $curr_letter = $my_element->[$pos];
~ unless ($curr_letter) {
~ debug ("No letter on pos $pos");
~ return try( $my_ctrl, $pos, $carry, @rest_of_the_summands );
~ }
~ my $letter_ctrl = $my_ctrl->{$curr_letter} ||= {};
~ if ( my $curr_val = $letter_ctrl->{CURRENT()} ) {
~ debug ("Value for $curr_letter already set - $curr_val");
~ return try( $my_ctrl, $pos, $carry, @rest_of_the_summands );
~ }
~ my $scrapped = $letter_ctrl->{SCRAPPED()} ||= {};
~ unless ($ALLOW_DUPS) {
~ traverse_ctrl($my_ctrl, sub {
~ my ($other_letter, $other_letter_ctrl) = @_;
~ return if $other_letter eq $curr_letter;
~ my $other_curr_val = $other_letter_ctrl->{CURRENT()};
~ return unless defined $other_curr_val;
~ $scrapped->{$other_curr_val} = 1;
~ debug ("Scrapping $other_curr_val for $curr_letter - already used
for $other_letter");
~ });
~ }
~ for (0..9) {
~ next if $scrapped->{$_};
~ debug( "Letter $curr_letter - will try $_" );
~ $letter_ctrl->{CURRENT()} = $_;
~ my $new_ctrl = try( $my_ctrl, $pos, $carry, @rest_of_the_summands );
~ return $new_ctrl if $new_ctrl;
~ $scrapped->{$_} = 1;
~ }
~ return; # no good digit found
}
sub sum {
~ my ($ctrl, $pos, $carry) = @_;
~ $ctrl or die "No ctrl";
~ my $s = $carry;
~ foreach (@reversed_split_summands) {
~ my $letter = $_->[$pos] or next;
~ my $value = $ctrl->{$letter}{CURRENT()};
~ die "No value for $letter" unless defined $value;;
~ $s += $value;
~ }
~ my $new_sum_value = $s % 10;
~ my $new_carry = floor($s/10);
~ debug ("New sum and carry: $new_sum_value $new_carry");
~ my $sum_letter = $reversed_split_sum[$pos]
~ or die "No sum letter on pos $pos";
# debug ("Sum letter $sum_letter", Dumper($ctrl));
~ my $curr_sum_value = $ctrl->{$sum_letter}{CURRENT()};
~ if ( defined $curr_sum_value ) {
~ unless ($new_sum_value == $curr_sum_value) {
~ debug ("New value for sum letter $sum_letter $new_sum_value
conflicts with previously set $curr_sum_value");
~ return;
~ }
~ } else {
~ unless ($ALLOW_DUPS) {
~ my $already_used;
~ traverse_ctrl($ctrl, sub {
~ my ($other_letter, $other_letter_ctrl) = @_;
~ return if $other_letter eq $sum_letter;
~ my $other_curr_val = $other_letter_ctrl->{CURRENT()};
~ $already_used = $other_letter if $other_curr_val == $new_sum_value;
~ });
~ if ($already_used) {
~ debug ("Cannot set sum letter to $new_sum_value - already used
for $already_used");
~ return;
~ }
~ }
~ $ctrl->{$sum_letter}{CURRENT()} = $new_sum_value;
~ debug ("Setting sum letter $sum_letter to $new_sum_value");
~ }
~ return $new_carry;
}
sub debug {
# print map "$_\n", @_;
}
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.0 (GNU/Linux)
Comment: Using GnuPG with Thunderbird - http://enigmail.mozdev.org
iD8DBQFCJj1aZtcHxCitRpgRApk7AJ4of2rHe2QHgKU9mVVH/HRe1TLKZgCgudBJ
+YI3I52bjv/rZaBBDTSy/HE=
=w6AE
-----END PGP SIGNATURE-----
More information about the Wellington-pm
mailing list