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.
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) {
s/x/*/g;
print "$_ == $year\n" if $year == eval;
}
Caution: Contents may have been coded under pressure.
$ /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 0maxresident)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 0maxresident)k 0inputs+0outputs (398major+21556minor)pagefaults 0swapsThe 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.
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, [doc://glob] will be an iterator in scalar context.
-QM
--
Quantum Mechanics: The dreams stuff is made of
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.
Am I the only one to notice that none of your solutions actually evaluate to 2006?
1938 == -9 + 8 * 7 + 654 * 3 - 2 - 1 2298 == 9 + 8 * 7 + 654 * 3 - 21 3887 == 9 + 8 * 7 * 6 * 5 - 4 + 321 2136 == 9 * 8 - 7 + 654 * 3 - 21Here is the code I came up with intentionally avoiding [doc://eval] $string;
#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Loops 'NestedLoops';
use List::MoreUtils 'zip';
my $year = $ARGV[0] || 2006;
my @digit = reverse 1..9;
my $next = NestedLoops( [ ['+', '-'], ([qw{+ - / *}, '']) x $#digit ] );
while ( my @perm = $next->() ) {
my $expr = join '', zip @perm, @digit;
print "$expr\n" if evaluate($expr) == $year;
}
sub evaluate {
my ($expr, $tot) = (shift, 0);
my %math = (
'+' => sub { $_[0] + $_[1] }, '-' => sub { $_[0] - $_[1] },
'/' => sub { $_[0] / $_[1] }, '*' => sub { $_[0] * $_[1] },
);
for my $term ( $expr =~ m|([/*+-]?\d+)|g ) {
if ( $term =~ m|^([/*+-])(\d+)$| ) {
$tot = $math{$1}->($tot, $2);
}
}
return $tot;
}
__END__
+9*8*7-6+5*4-3-2-1
+98/7+654*3+2/1
+98/7+654*3+2*1
Cheers - [Limbic~Region|L~R]
+9*8*7-6+5*4-3-2-1 == 512 +98/7+654*3+2/1 == 1978 +98/7+654*3+2*1 == 1978
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. Thanks for the puzzle.
Cheers - L~R
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.You went to a school where you didn't have to program a calculator in your first year? I have a different opinion - writing an expression evaluator is boring, and it would be a reimplementation of functionality that perl already provides.
I like string eval. I wish every programming language had such functionality.
You went to a school where you didn't have to program a calculator in your first year?
No. Computers were pretty scarce in highschool and programming courses were non-existant.
...writing an expression evaluator is boring...
I am sure doing anything you already know how to do can be boring. If you have had the benefit of a college education in computer science and/or work as a programmer professionally, building a precedence parser this trivial is probably extremely boring.
I like string eval.
I agree and use it when it makes sense to. OTOH, when people post neat puzzles like this I take it as an opportunity to learn things I don't already know. Since it isn't production code - there is no harm in a little golf, obfu, or non-straight forward solutions. I often intentionally limit the tools I will allow myself to use - see Necessity is the mother of invention for an explanation of why.
Again, thanks for the puzzle.
Cheers - L~R
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;"
- 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.
$ perl -e'($_=987654321)=~s##$`?(qw[+ - * /],("")x4)[rand 8]:"-"x rand 2#ge while 2006!=eval;print'
9+8*7+654*3-21
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 :)
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;
}
Makeshifts last the longest.