[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