[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