[SPOILER] Perl 'Medium' QOTW - Tournament Schedule

!/usr/bin/perl

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

# Imagine it like this...
#
# We have (N/2) - 1 adjacent playing fields in front of us, each with a
# near side and a far side, stretching into the distance to our left and
# right.  Off on our left, beyond the farthest playing field, is a
# stadium, with comfortable seats observing one more playing field.
#
# Our planning strategy is to have one team (say, the previous
# champions) always play in the stadium.  For convenience, let's say
# that's team 0.
#
# On the first day, team 1 is also in the stadium (playing team 0).
# Then teams 2 through N/2 are lined up on the near sides of the playing
# fields, from left to right.  Then the numbers wrap around, so teams
# (N/2) + 1 through N - 1 are on the far sides of the playing fields,
# but from right to left.  In other words, on the first day, team 2
# plays team N - 1 on the leftmost field, team 3 plays team N - 2 on the
# next field, and so on, ending with team N/2 playing (N/2) + 1 on the
# rightmost field.
#
# For the second day, team 1 comes out of the stadium and goes on the
# far side of the leftmost field.  This displaces team N - 1, which
# moves to the far side of the next field, displacing team N - 2 to the
# right, and so on.  The team that was on the far side of the rightmost
# field moves to the near side of the rightmost field.  This displaces
# all the teams on the near sides of the fields to the left, leaving the
# team that had been on the near side of the leftmost field to move into
# the stadium and play the champions.
#
# The same rotations occur each day, always leaving team 0 in the
# stadium.  After N - 1 days, each team has played each other team.
# Proof of this fact is left as an exercise for the reader.
#
# The implementation can follow straightforwardly from the above.  It
# also can be done without any intermediate data structures to track
# which team is located where, but it's more readable this way.  Try
# uncommenting the two debugging lines to watch the teams move about the
# field.

$Data::Dumper::Terse  = 1;
$Data::Dumper::Indent = 0;

sub allocate_schedule {
   my $n = shift;
   return undef unless( defined $n && $n >= 2 && $n % 2 == 0 );

   my $stadium = 1;
   my @nears   = (2 .. ($n/2));
   my @fars    = reverse(($n/2 + 1) .. ($n-1));

   my @result = ();
   $#result = $n - 2;

   foreach my $day (1 .. $n - 1) {
     #print "Day $day\tfars:  ", Dumper(\@fars),  "\tStadium: 
$stadium\n";
     #print "Day $day\tnears: ", Dumper(\@nears), "\n\n";

     my @today = ();
     $#today = $n - 1;
     $today[0] = $stadium;
     $today[$stadium] = 0;

     foreach my $field (0 .. ($n/2 - 2)) {
       $today[$nears[$field]] = $fars[$field];
       $today[$fars[$field]] = $nears[$field];
     }

     $result[$day - 1] = \@today;

     unshift @fars, $stadium;
     push @nears, (pop @fars);
     $stadium = shift @nears;
   }

   return \@result;
}

if (@ARGV) {
   print Dumper(allocate_schedule(shift)), "\n";
}


-- 
Jeffrey M. Vinocur
[email protected]