prog.pl   6 6 5 2  -goal 17

##</code><code>##


use Getopt::Long;
use strict;
use warnings;

sub permutations
{
	my $accum_ar = shift;
	my $bells_ar = shift;
	if ( @$bells_ar == 0 ) # we've reached a "leaf"
	{
		local( $\, $, ) = ( "\n", " " );
		push @$accum_ar, [ @_ ];
		return;
	}
	for my $i ( 0 .. $#{$bells_ar} )
	{
		my @bells = @{$bells_ar};
		my $bell = splice @bells, $i, 1;
		permutations( $accum_ar, \@bells, @_, $bell );
	}
}

sub combinations
{
	@_ or return [];
	my $l = shift;
	map
	{
		my $n = $_;
		map { [ $n, @$_ ] } combinations(@_)
	}
	@$l
}


my %op = (
	'+' => sub { $_[1] + $_[0] },
	'-' => sub { $_[1] - $_[0] },
	'*' => sub { $_[1] * $_[0] },
	'/' => sub { $_[1] / $_[0] },
);

sub uniqv(@)
{
	my %seen;
	grep { !$seen{"@$_"}++ } @_
}


my $quiet;    sub output { $quiet or  print @_ }
my $debug;    sub report { $debug and print @_ }
my $goal;
my $format = '%.6g';

my $Usage_statement = <<EOF;
Usage: $0  A B ... [-goal G]  [-debug] [-quiet] [-format FORMAT]

-goal G  (where G is a number) : only print the results when the result of the evaluation equals G.
         If you do not specify a goal value, the results of all successful evaluations will be printed.
-quiet : Do not print the results of any successful evaluations.
-debug : Also print any errors encountered, such as division by zero, and popping from an empty stack.

-format FORMAT  (where FORMAT is a sprintf-compatible format string) : When results are printed, this
         format will be used for the numeric result of the evaluation.  It should contain exactly one
	 numeric format specifier.  The default is "$format"

EOF

sub Usage { die "@_\n$Usage_statement" }

GetOptions(
	'goal=f' => \$goal,
	'debug!' => \$debug,
	'quiet!' => \$quiet,
	'format=s' => \$format,
) or die $Usage_statement;

@ARGV >= 2 or die $Usage_statement;

=pod

Given N numbers input, which will be the operands of each "program",
each formula will have placeholders for N operands, and N-1 operators.
However, for sanity, the first two terms (i.e. the bottom) in each formula
will invariantly be operands, and the last term (i.e. the top) will be an
operator.  
So the variant part in the middle will have N-2 operands, and (N-1)-1 operators.
(Even with this heuristic, some formulae will be invalid, e.g. 1 1 a a 1 1 a.)

In formulae, '1' = operand, 'a' = operator.

=cut

my $agnd = @ARGV - 2;
my @formulae;  # initially, just the variant parts:
permutations( \@formulae, [ ( ('1') x $agnd ), ( ('a') x $agnd ) ] );
@formulae = uniqv @formulae;
# now add the invariant parts:
for ( @formulae ) { @$_ = ( '1', '1', @$_, 'a' ) }


my @operand_permuts;
permutations( \@operand_permuts, [@ARGV] );
@operand_permuts = uniqv @operand_permuts;

my @operator_combos = combinations( ( [keys %op] ) x (@ARGV-1) );
@operator_combos = uniqv @operator_combos;


FORMULA:
for my $form_v ( @formulae )
{
	for my $arg_v ( @operand_permuts )
	{
		INPUTS:
		for my $op_v ( @operator_combos )
		{
			report( "(@$form_v) (@$arg_v) (@$op_v) \n" );
			my @arg  = @$arg_v;
			my @op   = @$op_v;
			my @form = @$form_v;
			my @stack;
			my @expr;
			while ( @form )
			{
				my $t = shift @form;
				if ( $t eq '1' ) # operand
				{
					my $arg = shift @arg;
					push @expr, $arg;
					push @stack, $arg;
				}
				elsif ( $t eq 'a' ) # operator
				{
					if ( @stack < 2 ) { report( "(@$form_v) is bad formula - stack underflow \n" ); next FORMULA; }
					my $op = shift @op;
					push @expr, $op;
					eval { push @stack, $op{$op}->( pop @stack, pop @stack ); };
					my $p = @expr == @$form_v ? '' : ' (partial)';
					if ( $@ ) { report( "Other error? $@    expr=(@expr)$p" ); next INPUTS; }
				}
				else
				{
					warn "Unrecognized formula term '$t' ";
					exit 1;
				}
			}
			if ( @stack != 1 ) { report( "(@$form_v) is bad formula - stack overflow \n" ); next FORMULA; }
			my $r = pop @stack;
			if ( !defined($goal) || $r == $goal )
			{
				$r = sprintf $format, $r;
				output( "$r = @expr\n" );
			}
		}
	}
}