use strict;
use warnings;
use Data::Dumper;

###############################################################################
#
# Variables
#
###############################################################################

my %uni_ops = (
	'nullop' => '',
	'sqrt' => 'sqrt',
	#'minus' => '-',
);

my %bi_ops = (
	'add' => '+',
	'subtract' => '-',
	'multiply' => '*',
	'divide' => '/',
);

my @base_vals = qw(4); # base values we can choose from (not working)
my $max_base_vals = 4; # number of base vals allowed in the expression

my $outfile = 'answer.out'; # file to write answer to
my $threshold = 20; # num of answers of a given value after which it is boring

my $debug = 0;

###############################################################################
#
# Main begins here
#
###############################################################################


# Fill in the first level
#my @lv1 = apply_unis(@base_vals);
my @lv1 = qw(4 sqrt(4)); # hack to make things look nice

#foreach my $n (@lv1) { print $n, " - ", eval($n), "\n"; }

# Generate each level
my %levels = (1 => \@lv1);
foreach my $num_bv (2..$max_base_vals) {
	#print "> $num_bv\n";

	# All possible amounts of values on each side of the next operator
	foreach my $left (1..int($num_bv/2)) {
		my $right = $num_bv - $left;
		#print "\t$left - $right\n";
		push @{$levels{$num_bv}}, apply_bis($levels{$left}, $levels{$right});
	}
	
	# Remove duplicates
	@{$levels{$num_bv}} = remove_dups(@{$levels{$num_bv}});
}

#print Dumper(%levels);

# Get values
# value of expr => list of strings that evaluate to that value
# (we only record non-negative integer values)
my %exprs_by_val = ();
while (my($level,$exprsref) = each %levels) {
	foreach my $expr (@{$exprsref}) {
		my $val = eval($expr);
		if ($@) { 
			debug_print("eval failed: $@");
			next;
		}
		push @{$exprs_by_val{$val}}, $expr unless "$val" =~ /[\.-]/;
	}	
}

#print '-' x 70, "\n";
#print Dumper(%exprs_by_val);

# Print Results
open(OUT, ">$outfile") or die ("Could not open '$outfile'");

my $spacer = " " x 4;
printf OUT "%-7s%s%s\n", ("Value:", $spacer, "Number of Expressions:");

my @vals = sort {int $a <=> int $b} keys %exprs_by_val;
foreach my $val (@vals) {
	printf OUT "%7d%s%d\n", ($val, $spacer, scalar @{$exprs_by_val{$val}});
}

print OUT "\n", "-" x 70, "\nItems of interest:\n\n";

foreach my $val (@vals) {
	if (@{$exprs_by_val{$val}} > $threshold) { next; }
	print OUT "value: $val\n";
	foreach my $expr (@{$exprs_by_val{$val}}) {
		printf OUT "\t$expr\n";
	}
	print OUT "\n";
}

print OUT "\n", "-" x 70, "\nEverything:\n\n";

foreach my $val (@vals) {
	print OUT "value: $val\n";
	foreach my $expr (@{$exprs_by_val{$val}}) {
		printf OUT "\t$expr\n";
	}
	print OUT "\n";
}

###############################################################################
#
# Functions
#
###############################################################################

sub apply_bis {
	my ($left_vals, $right_vals) = @_;
	my @results;
	
	# Apply binary ops
	foreach my $left_val (@{$left_vals}) {
		foreach my $right_val (@{$right_vals}) {
			while (my($name,$op) = each %bi_ops) {
				push @results, "$left_val $op $right_val";
				push @results, "$right_val $op $left_val";
			}
		}
	}
	#return @results;
	
	# Add unary ops to each result
	return apply_unis(@results);
}

sub apply_unis {
	my @orig_vals = @_;
	my @results;
	foreach my $val (@orig_vals) {
		while (my($name,$op) = each %uni_ops) {
			push @results, "$op($val)";
		}
	}
	return @results;
}

sub remove_dups {
	my %seen = ();
	return grep { ! $seen{$_} ++ } @_;
}

sub debug_print {
	print "\t$_[0]\n" if ($debug);	
}