Happy 2006

[Perl Mouse]

After seeing the following puzzle floating around the net, I decided to automate it:

Take the digits 9, 8, 7, 6, 5, 4, 3, 2, 1 in that order. Insert one or more basic math operators (addition, subtraction, division, multiplication) so that the result makes 2006.

#!/usr/bin/perl

use strict;
use warnings;

my @o    = (" + ", " - ", " * ", " / ", "");
my @s    = (" ", "-");
my @d    = (0, 1 .. 9);
my $year = @ARGV ? shift : 2006;

for my $o8 (@o) {
for my $o7 (@o) {
for my $o6 (@o) {
for my $o5 (@o) {
for my $o4 (@o) {
for my $o3 (@o) {
for my $o2 (@o) {
for my $o1 (@o) {
for my $s  (@s) {
    my $expr = "$s$d[9]$o8$d[8]$o7$d[7]$o6$d[6]$o5" .
                 "$d[5]$o4$d[4]$o3$d[3]$o2$d[2]$o1$d[1]";
    print "$expr == $year\n" if $year == eval $expr;
}}}}}}}}}


__END__
2006 == -9 + 8 * 7 + 654 * 3 - 2 - 1
2006 ==  9 + 8 * 7 + 654 * 3 - 21
2006 ==  9 + 8 * 7 * 6 * 5 - 4 + 321
2006 ==  9 * 8 - 7 + 654 * 3 - 21

I'm sure there are cleverer ways of writing the nested loop, using some kind of module. But cut-and-paste is fast, and this takes less programmer time.

[Roy Johnson]

An arguably cleverer way to write the nested loop without using some kind of module:

use strict;
use warnings;

my $year = @ARGV ? shift : 2006;
my $ops = '{-,+,x,/,}';
my $globpat = '{-,}' . (join $ops, (reverse 1..9));

print $globpat, "\n";
for (glob $globpat) {
  tr/x/*/;
  print "$_ == $year\n" if $year == eval;
}

[Perl Mouse]

I'm not a big fan of the glob trick - there's always the possibility something matches (although for the given pattern, that's pretty unlikely). But just for kicks, I compared your solution with mine:

$ /usr/bin/time ./perlmouse ; /usr/bin/time ./ray_johnson 
-9 + 8 * 7 + 654 * 3 - 2 - 1 == 2006
 9 + 8 * 7 + 654 * 3 - 21 == 2006
 9 + 8 * 7 * 6 * 5 - 4 + 321 == 2006
 9 * 8 - 7 + 654 * 3 - 21 == 2006
56.60user 0.19system 2:04.01elapsed 39%CPU (0avgtext+0avgdata 0maxresi
+dent)k
0inputs+0outputs (356major+87minor)pagefaults 0swaps
-9+8*7+654*3-2-1 == 2006
9+8*7+654*3-21 == 2006
9+8*7*6*5-4+321 == 2006
9*8-7+654*3-21 == 2006
56.98user 3.45system 2:43.21elapsed 41%CPU (0avgtext+0avgdata 0maxresi
+dent)k
0inputs+0outputs (398major+21556minor)pagefaults 0swaps

The running time is about the same, but your solution uses a lot more memory, as it makes a list of all possible expressions to test before making the first test, while my solution tests each expressions right after it is constructed. My solution has a lot less pagefaults.

[QM]

The running time is about the same, but your solution uses a lot more memory, as it makes a list of all possible expressions to test before making the first test, while my solution tests each expressions right after it is constructed. My solution has a lot less pagefaults.

Ah, someday soon, glob will be an iterator in scalar context.

[BrowserUk]

This has been seen to produce 3 of the 4 possibles.

perl -e"($_='987654321')=~s[(?!$)][pos()?(qw[+ - * /],('')x4)[rand 8]:
+int(rand 2)?'':'-']ge while 2006!=eval;print;"

[Perl Mouse]

Some golfing nitpicks:
• Instead of int(rand 2)?'':'-', you can write '-'x rand 2, saving seven characters.
• No need to quote 987654321, Perl will happely turn this integer into a string for you. This saves two characters.
• Use $` instead of pos(). Three characters.
• If you use an empty pattern in the substitution, Perl will do the right thing. Another five characters.
• Use s### instead of s[][] for one character savings.
Result:

$ perl -e'($_=987654321)=~s##$`?(qw[+ - * /],("")x4)[rand 8]:"-"x rand
+ 2#ge while 2006!=eval;print'
9+8*7+654*3-21

[BrowserUk]

I'll go along with most of that except

If you use an empty pattern in the substitution, Perl will do the right thing. Another five characters.

Without the negative lookahead, the regex will produce a very high proportion of invalid expressions because it will insert an operator at the very end of the string:

9+8*7*6*54/3-2/1-
-9-8-7*6+5/43/2+1
987+6/54321
98/7-6+5-4/321+
9*8/7/6/54-3/2-1
9/876*543/21
-9*8/76543*2-1-
-987/65-432+1*
9*8+7+65*432*1-
9876/5*43+21
9876-54321*
987/6-5-4/3-21/
9-8+7*65432+1
98765+432*1+
-9*8-7*65432-1+
9+87*6543*21
9-87*65*4-3-2*1
-987654-321+
98*76/54*32*1-
-9-876/5-432*1*
-987*654+321
9/87+6543*21
98-7654/3+21
-98*7-6-5*4321
98+7+6/5+4*3+2-1
-98+76+54*3/2+1/
9876543/21
-9-8+76-54321*

Not always, and so it can be expected to still produce occasional correct answers, but it will take much longer and somehow offends my sensibilities :)

[ambrus]

A bit related is Re^4: Finding Sum of Consecutive Numerical Difference in Set of Numbers except that it allows reordering the numbers and parenthisizing.

[Limbic~Region]

Perl Mouse,
After finishing my solution, I realized that I must have intepreted the puzzle wrong. I thought each term was evaluated left to right in succession not as 1 entire expression. *shrug*

Here is the (likely incorrect) code I came up with intentionally avoiding eval $string;

Read more... (1267 Bytes)

[Perl Mouse]

I don't quite understand how your program is supposed to work, but the results are indeed incorrect. It seems all your operators have the same precedence?

+9*8*7-6+5*4-3-2-1 == 512
+98/7+654*3+2/1 == 1978
+98/7+654*3+2*1 == 1978

[Limbic~Region]

Perl Mouse,
No, just each term in the expression is evaluated independently. This is how we did similar puzzles in school. The program works as follows:

Algorithm::Loops generates all the permutation of operators needed and then the numbers are zipped forming a single string. This is the point where eval $string would produce the same results as your code. Instead, I break each term apart and keep a running total of the value which is returned.

In my opinion, what would make the puzzle much more interesting would be to require single expression evaluation as your solution does but prohibit the use of eval $string. Here is my original solution modified accordingly though it is quite slow and a bit obfu now. Thanks for the puzzle.

Read more... (1483 Bytes)

[Aristotle]

use strict;
use warnings;
use Set::CrossProduct;

my @ops = qw( * + - / );
my $expr = '2006 == ' . join ' %s ', 1 .. 9;

my $xp = Set::CrossProduct->new( [ map \@ops, $expr =~ /%s/g ] );
while( my @attempt = $xp->get ) {
        my $attempt = sprintf $expr, @attempt;
        print $attempt, "\n" if eval $attempt;
}