[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