#!/usr/bin/perl

# This is a countdown brute force solver, by Alex Rea.
# Not strictly limited to Countdown rules - irrational fractions as intermediate steps are allowed.
# Start as ./countdown.pl target number1 number2 number3 ... up to numberN.
# More efficient implementations exist, but, as usual, I didn't think too hard before I started typing

use Math::Combinatorics;
use Data::Dumper;

sub dec($) {
	$_[0] ? $_[0]--
	: 0
};

sub count_unique {
	my @array = @_;
	my %count;
	my @chars;
	my @freqs;
	map { $count{$_}++ } @array;
	map {push(@chars, $_)} sort keys(%count);
	map {push(@freqs, ${count{$_}})} sort keys(%count);
	return(\@chars,\@freqs);
	#Need to return references otherwise perl lumps everything together
}

sub find_nuggets {
	my (@numbersorig) = @_;
	my @nuggets;
	my @numbersleft;
	my $chosennumber;
	my $elementid;
	my @new_nuggets;
	
	@numbersleft = @numbersorig;
	if (scalar @numbersorig == 2)
	{
		#Then supply nuggets
		push(@nuggets, "($numbersorig[0] + $numbersorig[1])");
		push(@nuggets, "($numbersorig[0] - $numbersorig[1])");
		push(@nuggets, "($numbersorig[1] - $numbersorig[0])");
		push(@nuggets, "($numbersorig[0] * $numbersorig[1])");
		push(@nuggets, "($numbersorig[0] / $numbersorig[1])");
		push(@nuggets, "($numbersorig[1] / $numbersorig[0])");
		
		
		return @nuggets;
		
		}elsif(scalar @numbersorig==1){
		
		return @numbersorig;
		
		
		
		}else{
		
		foreach $elementid ( 0 .. scalar @numbersorig -1)
		{
			@numbersleft = @numbersorig;
			$chosennumber = @numbersorig[$elementid];
			
			#extract this element from the list
			
			splice(@numbersleft,$elementid,1);
			#		print "Extracted: $chosennumber ----- Remaining: @numbersleft\n";
			
			@nuggets = find_nuggets(@numbersleft);
			foreach $elementid (0 .. scalar @nuggets -1)
			{
				push(@new_nuggets, "($chosennumber + $nuggets[$elementid])");
				push(@new_nuggets, "($chosennumber - $nuggets[$elementid])");
				push(@new_nuggets, "($nuggets[$elementid] - $chosennumber)");
				push(@new_nuggets, "($chosennumber * $nuggets[$elementid])");
				push(@new_nuggets, "($chosennumber / $nuggets[$elementid])");
				push(@new_nuggets, "($nuggets[$elementid] / $chosennumber)");
				
			}
			#						print Dumper(@new_nuggets);
			
		}
		
		return @new_nuggets;
		
	}
	
}

sub split_up {
	my @new_nuggets;
	my (@numbers_to_split) = @_;
	if (scalar @numbers_to_split >= 4) {
		
		
		
		#We can split off between 1 and N-1 elements, where N is how many elements are left in @numbersorig
		
		
		
		my ($chars_ref_sub, $freqs_ref_sub) = count_unique(@numbers_to_split);
		my @chars_sub =@$chars_ref_sub;
		my @freqs_sub =@$freqs_ref_sub;
		
		
		
		for ($j =1; $j <= (scalar @numbers_to_split)/2; $j++){
			my $combinat = Math::Combinatorics->new(count => $j,
			data => [@chars_sub],
			frequency =>[@freqs_sub]
			);
			while(my @combo = $combinat->next_multiset){ #So while there is still a distinct selection of this length....
				
				
				#This along with the dec function above is simply code I've copied / pasted from a source long lost.
				my %combo;
				$combo{$_}++
				for (@combo);
				my @only_numbers_to_split = map { dec $combo{$_} ? () : $_ } @numbers_to_split;
				
				#print "Split into @only_numbers_to_split and @combo \n";
				
				#So now find all the combinations we can make from these two.
				
				@nuggets1 = split_up(@only_numbers_to_split);
				@nuggets2 = split_up(@combo);
				foreach $elementid1 (0 .. scalar @nuggets1 -1)
				{
					foreach $elementid2 (0 .. scalar @nuggets2 -1)
					{
						push(@new_nuggets, "($nuggets1[$elementid1] + $nuggets2[$elementid2])");
						push(@new_nuggets, "($nuggets2[$elementid2] - $nuggets1[$elementid1])");
						push(@new_nuggets, "($nuggets1[$elementid1] - $nuggets2[$elementid2])");
						push(@new_nuggets, "($nuggets1[$elementid1] * $nuggets2[$elementid2])");
						push(@new_nuggets, "($nuggets2[$elementid2] / $nuggets1[$elementid1])");
						push(@new_nuggets, "($nuggets1[$elementid1] / $nuggets2[$elementid2])");
						
					}
				}
				
				
			}
			
		}
		return @new_nuggets;
		
		}else{
		
		return find_nuggets(@numbers_to_split);
		
	}
	
}


$numArgs = $#ARGV + 1;

$target = $ARGV[0];


foreach $argnum (1 .. $#ARGV)
{
	push(@numbers, $ARGV[$argnum]);
}


my @n = @numbers;


my ($chars_ref, $freqs_ref) = count_unique(@n);
my @chars =@$chars_ref;
my @freqs =@$freqs_ref;

#So now we're all squared up - arrays are arrays, men are men...


#Try using any number of digits, from 1 up to all of them.

for ($i=1;$i<=$#ARGV;$i++){
	
	my $combinat = Math::Combinatorics->new(count => $i,
	data => [@chars],
	frequency =>[@freqs]
	);
	
	
	
	while(my @combo = $combinat->next_multiset){ #So while there is still a distinct selection of this length....
		
		@potentialsolutions = split_up(@combo);
		foreach $elementid (0 .. scalar @potentialsolutions -1) {
			
			$calc = eval @potentialsolutions[$elementid];
			if ( $target == sprintf("%.5f", $calc)) {
				#Ugly hack, but necessary. If we were playing strict Countdown rules, where non-integer intermediate steps
				#weren't allowed, it wouldn't be needed. But we're better than that... we hope...
				#Demonstration of why necessary: ask for 24 out of 3, 3, 8, 8. 3*8 is obvious, but there's a unique solution 
				#using all four numbers. If this hack isn't here, it's not found.
				print "@potentialsolutions[$elementid]";
				print " = ". eval @potentialsolutions[$elementid] ;
				print "\n";
			}
		}
	}
}