package Schedule::RoundRobin;
######################################################################
+#########
# implements a round robin scheduling algorithm as described in
# http://forum.swarthmore.edu/dr.math/problems/kinley.3.31.00.html
######################################################################
+#########

# takes an array and returns a reference to a list of pairs
sub schedule
{
    my(@teams) = @_;
    
    # get the size of the array
    my $size = scalar @teams;

    # If it is even, pop off one item and maintain it as a central poi
+nt
    # and proceed as with an odd number
    return undef unless ($size > 0);

    my $pivot = undef;
    my $even = 0;
    my $end_point_a = 0;
    my $end_point_b = $size-1;
    if($size%2 == 0)
    {
    # $pivot = pop @teams;
    $pivot = $#teams;
    $even = 1;
    $end_point_b--;
    }

    # Create a list of the "stripes" of the polygon, the stripes will 
+be
    # pairs of indices into the array
    my @stripes;

    # Assume that each element in the array is a vertex of the polygon
    # and the vertices are listed in order, stripes are created
    
    for (1..int(($size-1)/2))
    {
    push(@stripes, [$end_point_a, $end_point_b]);
    $end_point_a++;
    $end_point_b--;
    }

    # Upon falling out of the loop, the middle point will be in both
    # end_point_a and end_point_b
    if($even)
    {
    push(@stripes, [$end_point_a, $pivot]);
    }

    # Each element of the games array is a play date's worth of games
    # so it is an array of pairs
    my @games;
    
    for(1..($size-$even))
    {
    my @this_week;
    # push the weeks worth of games onto @games
    foreach my $sched_ref (@stripes)
    {
        push (@this_week, [$teams[$sched_ref->[0]], $teams[$sched_ref-
+>[1]]]);
    }
    push(@games, \@this_week);

    # Now rotate the @teams array
    my $last_team_save = undef;
    # Save the last team as the pivot for the polygon
    if($even)
    {
        $last_team_save = pop(@teams);
    }
    my $last_team = pop(@teams);
    unshift(@teams, $last_team);
    if($even)
    {
        push(@teams, $last_team_save);
    }
    }
    return \@games;
}



1;
[download]