[Wellington-pm] SEND + MORE = MONEY
Douglas Bagnall
douglas at paradise.net.nz
Tue Mar 1 22:59:50 PST 2005
well,
I couldn't avoid dubious optimisation efforts, and now it may or may not
be a bit quicker. It usually takes less than a second on the via C3.
I thought to add some @ARGV shifts, eg:
my $message = shift || 'SEND + MORE = MONEY';
which enables you to try out lines like
./sum.pl 'PERL / PL = POD'
./sum.pl 'BEE + CAT + DOG = BIRD'
./sum.pl 'POTATO % PEEL = MEAL'
scroll down.
#!/usr/bin/perl -w
use strict;
my $message = shift || 'SEND + MORE = MONEY';
my $ITERATIONS = shift || 1500;
my $POOL = shift || 120;
my $CUTOFF = shift || 60;
my $INF = 1e999;
my @letters = keys %{{ map { $_ => 1} ($message =~ /([A-Z])/g)}};
my $letters = join('', @letters);
my $len = @letters;
my $equation = $message;
$equation =~ s/=/-/; # should check for bad chars,
# put () around each side.
my @nums = (0..9);
my %candidates = map {
for (my $i = 10; --$i;) {
my $r = int(rand($i + 1));
($nums[$i], $nums[$r]) = ($nums[$r], $nums[$i]);
};
substr(join('', @nums), 0, $len) => $INF;
}(1..$POOL);
foreach my $i (1..$ITERATIONS){
my @scores = sort {$a <=> $b} (values(%candidates));
my $cutoff = $scores[$CUTOFF];
my %new_candidates;
while (my ($digits, $score) = each %candidates) {
if ($score eq $INF){
$_ = $equation;
eval "tr/$letters/$digits/";
next if(/\b0/);
$score = abs (eval $_);
next if ($score > $cutoff);
if ($score == 0){
s/-/=/;
print "$_\n$message\n$letters\n$digits\n";
print "took $i iterations\n";
exit;
}
}
$new_candidates{$digits} = $score if ($score <= $cutoff);
}
%candidates = %new_candidates;
my @mutatees = keys(%candidates);
my $c = @mutatees;
while ($c < $POOL){
foreach my $digits (@mutatees){
my $pos = int(rand($len));
my $new_n = int(rand(10));
my $old_n = substr($digits, $pos, 1, 'x');
$digits =~ s/$new_n/$old_n/;
$digits =~ s/x/$new_n/;
$candidates{$digits} = $INF;
last if (++$c >= $POOL);
}
}
}
print "No solution found after $ITERATIONS iterations!\n";
More information about the Wellington-pm
mailing list