Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Round Robin Scheduling

by modred (Pilgrim)
on Jun 20, 2001 at 22:46 UTC ( [id://90132]=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info modred
Description: Given a list of teams creates a round robin schedule (a schedule where each team plays each of the other teams exactly once.)
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;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://90132]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (3)
As of 2025-06-20 22:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.