#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Loops qw{NestedLoops MapCar};

my $year = $ARGV[0] || 2006;
my @digit = reverse 1..9;

my $next = NestedLoops( [ ['+', '-'], ([qw{+ - / *}, '']) x $#digit ] 
+);
while ( my @perm = $next->() ) {
    my $expr = join '', MapCar { @_ } \@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
[download]