[Wellington-pm] SEND + MORE = MONEY

Douglas Bagnall douglas at paradise.net.nz
Tue Mar 1 17:24:37 PST 2005


Grant McLean wrote:

>   SEND
>  +MORE
>  =====
>  MONEY

I've got a longer, quicker, but guarantee-free solution below.  It uses 
a simple darwinian approach (betterment through iterative selection and 
mangling).

It's an interesting problem where the human approach, combining 
heuristics and baffled staring, doesn't translate into perl very well at 
all.


douglas


























#!/usr/bin/perl -w

use strict;

my $message = 'SEND + MORE = MONEY';
my $POOL = 100;
my $CUTOFF = 50;
my $ITERATIONS = 500;
my $INF = 1e999;

my @letters = keys %{{ map { $_ => 1} ($message =~ /([A-Z])/g)}};
my $letters = join('', @letters);
my $len  = @letters;

my $equation = $message;
$equation =~ s/=/-/;

my %candidates;

foreach (1..$POOL){
     my %attempt;
     my $nums = [0..9];
     # shuffle...
     for (my $i = 10; -- $i;) {
         my $r = int rand ($i + 1);
         ($nums -> [$i], $nums -> [$r]) = ($nums -> [$r], $nums -> [$i]);
     }
     # and truncate
     my $digits = substr(join('', @$nums), 0, $len);
     $candidates{$digits} = $INF;
}

foreach my $i (1..$ITERATIONS){
     my ($digits, $score);
     foreach $digits (keys %candidates) {
         $_ = $equation;
         eval "tr/$letters/$digits/";
         next if(/\b0/);
         my $score = abs int(eval $_);
         if ($score == 0){
             s/-/=/;
             print "$_\n$message\n$letters\n$digits\n";
             print "took $i iterations\n";
            exit;
         }
         $candidates{$digits} = $score;
     }

     my @scores = sort {$a <=> $b} (values(%candidates));

     my $cutoff = $scores[$CUTOFF];
     # print "iteration $i\nbest is $scores[0]\n cutoff is $cutoff\n";

     my %new_candidates;
     while (($digits, $score) = each %candidates) {
         next if ($score > $cutoff);
         $new_candidates{$digits} = $score;
         my $pos = int(rand($len));
         my $new_n = int(rand(10));
         my $old_n = substr($digits, $pos,1);
         $digits =~ s/$old_n/x/;
         $digits =~ s/$new_n/$old_n/;
         $digits =~ s/x/$new_n/;
         $new_candidates{$digits} = $INF;
         last if (keys(%new_candidates) > $POOL);
     }
     %candidates = %new_candidates;
}





More information about the Wellington-pm mailing list