#!/usr/bin/perl 
#
# I unproudly present to you ..... the .....
#
# Tournement Bruteforce Tool
#
# Some friends and I were organising a tournement. We had to make a scheme.
#
# The 'input' to our issue:
#  - Team C1 and D2 had the wish not to play in the same round
#  - Team C4 had the wish the skip the first 5 rounds
#  - Teams should not have to wait too long between matches
#  - There are two playfields
#  - We already know which matches will be played. We created that scheme in some MS-tool.
#  		Poule A+B : 4 teams, plays cross finals (1st of A plays against 1st of B, etc).
#  		Poule C+D : 5 teams
# The 'output' should be:
#  - A scheme that fits :)
#
# This tool tries to 'brute force' such a scheme in a really dump and inefficient way.
# ..... But it will get the job done :)
#
# You may use this tool, but i won't stand in for the concequences :)
# The code is bad and ugly, should rewrite it once ...
#
# By Pet (painfullscratch.nl)
 
use strict;
use warnings;

if(scalar(@ARGV) != 1) { 
	print STDERR "Usage: $0 <waittime>\n";
	print STDERR " i.e.: $0 8\n";
	exit(1);
} 

my $verbose = 0;
my $waittime = $ARGV[0];
my $number_of_fields = 2;
my @matches = (
	[qw/A1 A2/], [qw/A3 A4/], [qw/C1 C2/], [qw/C5 C3/], [qw/B2 B4/], [qw/A1 A4/],
	[qw/D3 D4/], [qw/C1 C3/], [qw/C2 C4/], [qw/D2 D3/], [qw/C5 C1/], [qw/D1 D3/],
	[qw/B1 B4/], [qw/B2 B3/], [qw/D4 D1/], [qw/C4 C5/], [qw/D4 D5/], [qw/B3 B4/],
	[qw/D5 D3/], [qw/D1 D2/], [qw/B1 B3/], [qw/A2 A3/], [qw/C2 C5/], [qw/D5 D1/],
	[qw/D2 D4/], [qw/B1 B2/], [qw/C2 C3/], [qw/A2 A4/], [qw/C3 C4/], [qw/A1 A3/],
	[qw/D2 D5/], # [qw/C4 C1/], # See below
);

my $data; 				# placeholder for the result

OUTER: while(1) { 		# infinite loop

	$data = undef; 		# clear placeholder
	my $rounds = {}; 	# hashref containing all rounds
 
	# Default matches ..
	push(@{$rounds->{'16'} ||= []},[qw/4A 4B/]); # 4th of A against 4th of B
	push(@{$rounds->{'17'} ||= []},[qw/2A 2B/]); # 2nd of A against 2nd of B
	push(@{$rounds->{'17'} ||= []},[qw/3A 3B/]); # 3th of A against 3th of B
	push(@{$rounds->{'18'} ||= []},[qw/1A 1B/]); # 1st of A against 1st of B
	push(@{$rounds->{'18'} ||= []},[qw/C4 C1/]); # I want these guys to play the last round

	my $round = 1; 
	foreach my $match (sort { (-1,1)[rand 2] } @matches) {
		push(@{$rounds->{$round} ||= []},$match);
		if(scalar(@{$rounds->{$round}}) == $number_of_fields) { 
			$round++;
		} 
	} 

	my $hist = {}; # hashref that will keep track of the team's last playround

INNER: foreach my $round (sort { $a <=> $b } keys %$rounds) { 

		# Some shortcuts to increase readability
		my $a = $rounds->{$round}[0][0];
		my $b = $rounds->{$round}[0][1];
		my $c = $rounds->{$round}[1][0];
		my $d = $rounds->{$round}[1][1];
	
		$data .= $round."\t".$a."-".$b."\t".$c."-".$d."\n";

		# A team can't play in the same round on different fields
		if($a eq $c || $a eq $d || $b eq $c || $b eq $d) {
			$verbose && print STDERR "A team can't play in the same round on different fields\n";
			next OUTER;
		} 

		# C1&D2 have the wish not to play in the same round
		if( ($a eq 'C1' && ($c eq 'D2' || $d eq 'D2')) ||
			($b eq 'C1' && ($c eq 'D2' || $d eq 'D2')) ||
			($c eq 'C1' && ($a eq 'D2' || $b eq 'D2')) ||
			($d eq 'C1' && ($a eq 'D2' || $b eq 'D2'))) { 
			$verbose && print STDERR "C1&D2 have the wish not to play in the same round!\n"; 
			next OUTER;
		} 

		# C4 has the wish to play after round 5
		if($round <= 5 && ($a eq 'C4' || $b eq 'C4' || $c eq 'C4' || $d eq 'C4')) { 
			$verbose && print STDERR "C4 has the wish to play after round 5\n"; 
			next OUTER;
		} 

		if( ( $a =~ /^[A-Z]\d{1}$/ && abs($round - ($hist->{$a} || 1)) > $waittime && $a ne 'C4')||
			( $b =~ /^[A-Z]\d{1}$/ && abs($round - ($hist->{$b} || 1)) > $waittime && $b ne 'C4')||
			( $c =~ /^[A-Z]\d{1}$/ && abs($round - ($hist->{$c} || 1)) > $waittime && $c ne 'C4')||
			( $d =~ /^[A-Z]\d{1}$/ && abs($round - ($hist->{$d} || 1)) > $waittime && $d ne 'C4')) { 
				# I don't care if C4 has to wait for a while
				$verbose && print STDERR "One of the teams has to wait too long\n";
				next OUTER;
		} 

		if( ( $a =~ /^[A-Z]\d{1}$/ && defined($hist->{$a}) && $hist->{$a} == ($round - 1) && $a ne 'C4')||
	   	    ( $b =~ /^[A-Z]\d{1}$/ && defined($hist->{$b}) && $hist->{$b} == ($round - 1) && $b ne 'C4')||
	   	    ( $c =~ /^[A-Z]\d{1}$/ && defined($hist->{$c}) && $hist->{$c} == ($round - 1) && $c ne 'C4')||
	   	    ( $d =~ /^[A-Z]\d{1}$/ && defined($hist->{$d}) && $hist->{$d} == ($round - 1) && $d ne 'C4')) { 
				# I don't care if C4 has to play two rows right next after each other
				$verbose && print STDERR "One of the teams plays two times in a row\n";
				next OUTER;
		} 

		# Update hist information
		if( $a =~ /^[A-Z]\d{1}$/) { $hist->{$a} = $round } ;
		if( $b =~ /^[A-Z]\d{1}$/) { $hist->{$b} = $round } ;
		if( $c =~ /^[A-Z]\d{1}$/) { $hist->{$c} = $round } ;
		if( $d =~ /^[A-Z]\d{1}$/) { $hist->{$d} = $round } ;
	} 

	# Teams in poule A and B cannot have their last round before round 11 
	# Teams in poule C and D cannot have their last round before round 12 
	foreach my $team (keys %$hist) { 
		if($team =~ /^[AB]\d{1}$/ && $hist->{$team} < 11) { 
			$verbose && print STDERR "Team $team finished in round $round. That is too early.\n"; 
			next OUTER;
		} 
		if($team =~ /^[CD]\d{1}$/ && $hist->{$team} < 12) { 
			$verbose && print STDERR "Team $team finished in round $round. That is too early.\n"; 
			next OUTER;
		} 
	} 
	last OUTER;
}

print "Result with max waittime $waittime\n";
print $data;
print "Success!\n";