#!/usr/bin/perl
use strict;
use warnings;

# use List::Util qw(min);
use List::MoreUtils qw(first_index each_arrayref);
# use Data::Dumper;

my %queue;
my %occupied;
my %report;
my %monitor;

my $limit = 540;
my $nr_facilities = 3;
my $probability = 4/540;
my $duration = 1; 

for ( my $y = 10; $y <= 300; $y += 10)
{
	my @clients = ( 1 .. $y );
	for my $actual_time ( 1 .. $limit )
	{
		push @{ $monitor{$y} }, scalar keys %{ $queue{$y} };
		
		# correction: purge the specific person.
		for my $id ( @clients )
		{
			my $chance = rand;
			if ( $chance < $probability )
			{
				# my $id = shift @clients;
				purge_this_one( \@clients, $id ); # This very person leaves the team.
				push @{ $queue{$y}{$id} }, $actual_time; # Start waiting ("timestamp").
			}
		}	
		for my $occ_nr ( keys %{ $occupied{$y} } )
		{
			if ( ( $actual_time - $occupied{$y}{$occ_nr}->[1] ) > $duration )
			{
				delete $occupied{$y}{$occ_nr}; # Free the facility.
				push @clients, $occ_nr; # Back in the team.
			}
		}	

		while ( scalar keys %{ $queue{$y} } > 0 and  # if there is a queue already...
			 scalar keys %{ $occupied{$y} } <= $nr_facilities ) # 
			 # three facilities, if any is not occupied, then ... 
		{
				# who waited long?
				my @key_waiting = 
					map { $_->[0] }
					sort { $a->[1] <=> $b->[1] } 
					map { [ $_, $queue{$y}{$_}->[0] ] } 
					keys %{ $queue{$y} };
				my $turn = shift @key_waiting;
				# my $turn = min keys %{ $queue{$y} }; # old version of $turn.
								
				push @{ $queue{$y}{$turn} }, $actual_time; # End waiting ("timestamp").
				@{ $occupied{$y}{$turn} } = @{ $queue{$y}{$turn} }; # Facility occupied.
				@{ $report{$y}{$turn} } = @{ $queue{$y}{$turn} }; # Reporting (who waited from .. to).
				delete $queue{$y}{$turn}; # Purge from queue;
		}		
	}
}

my @keys = sort {$a <=> $b} keys %monitor;
my @AoA = @monitor{@keys};
my @transpose = pivot ( @AoA );

my $outfile = "output.txt";
open my $out, ">", $outfile or die "$!";
print {$out} join(';', @keys ), "\n";

print {$out} join(';', @$_ ), "\n" for @transpose;

system q["C:/Program Files/R/R-2.13.0/bin/R.exe" CMD BATCH R_script.r];

sub purge_this_one
{
	my $idx = first_index { $_ == $_[1] } @{$_[0]};
	splice( @{$_[0]}, $idx, 1 ); 
	return @{$_[0]};
}

sub pivot
{
	my @arr = @_;
	my $iter = each_arrayref(@arr);
	my @pivot;
	while ( my @tuple = $iter->() )
	{
    	push @pivot, [@tuple];
	}
	return @pivot;
}
# In case somebody is curious:
printf "%-5s %-5s %-5s %-5s %-5s\n", 'Group', 'Nr', 'Start', 'End', 'Wait';
for my $group ( sort {$a <=> $b} keys %report )
{
	for my $nr ( sort {$a <=> $b} keys %{ $report{$group} } )
	{
	printf "%-5s %-5s %-5s %-5s %-5s\n", 
		$group, 
		$nr, 
		$report{$group}{$nr}->[0], 
		$report{$group}{$nr}->[1], 
		$report{$group}{$nr}->[1] - $report{$group}{$nr}->[0];
	}
	for my $nr ( sort {$a <=> $b} keys %{ $queue{$group} } )
	{
		printf "%-5s %-5s %-5s %-5s %-5s\n", $group, $nr, $queue{$group}{$nr}->[0], '', '';
	}
	
}