Hello wise monks,

I have more an algorithm problem as a perl problem. I'm not really sure how to do it. Here the description of the problem:

I have a group of players. Every player in this group has to play against all other players in this group.

Let's say we have a group of 4 players. The best player in this group is titled with 1, the second best with 2, the third best with 3 and the worst player with 4. The goal is it that the good players play in the early round against the bad players. And the best players shall play against each other as late as possible. The same for the bad players. They shall play against each other as late as possible.

Here a possible result for this group

1-4 1-3 1-2
2-3 2-4 3-4
[download]

This means in the first round the best player (1) is playing against the worst player (4) and number 2 is playing versus number 3. In the second round player 1 is playing against player 3 and player 2 versus player 4. And in the last round the best 2 players play against each other and the bad players 3 and 4 play against each other.

But what am I doing if the group has 6 players, or 8 players or even 12 players?

The goal is it to find an algorithm so that all players in a group play against each other. And which assures that in the early rounds, the difference (e.g. first round best player should play versus worst player) between the players should be as big as possible and then in the late rounds the players with only small difference should play against each other.

The following code is working with 1, 2, 3, 4, 7 and 8 players. But I have massive problems to find a correct algorithm with for example a group of 6 players. My algorithm is then getting into an endless loop. I understand why, but I don't know how to prevent it. The problem is that at the end only combinations are available which cannot match. So the mistake was done in the early rounds.

use strict;
use warnings;

use Data::Dumper;

my @matches;
my $nb_players = 6;
my @rounds;
exit(-1) unless get_matches( $nb_players, \@matches );
exit(-1) unless get_rounds( $nb_players, \@matches, " - ", \@rounds );

print Dumper(\@rounds);

sub get_matches
{
    my ( $nb_players, $ref_matches ) = @_;

    my $odd_nb_players = 0;
    $odd_nb_players = 1 if( $nb_players % 2 );

    $nb_players += 1 if( $odd_nb_players );

    for (my $left_player = 1; $left_player < $nb_players; $left_player
+ += 1 )
    {
        for (my $right_player = ($left_player+1); $right_player <= $nb
+_players; $right_player += 1 )
        {
            push(@$ref_matches, {'left_player' => $left_player,
                                 'right_player' => $right_player,
                                 'diff' => $right_player - $left_playe
+r} );
        }
    }

    # replace not existing player with "bye" if group has an odd numbe
+r of players
    map { $_->{'right_player'} = 'bye' if( $_->{'right_player'} == $nb
+_players ) } @$ref_matches if( $odd_nb_players );

    return 1;
}

sub get_rounds
{
    my ( $nb_players, $ref_matches, $sep, $ref_rounds ) = @_;

    # handle 'bye' as a real player
    $nb_players += 1 if( $nb_players % 2 );

    my $nb_matches_per_round = $nb_players / 2;
    my $nb_rounds = $nb_players - 1;

    my @matches_sorted_by_diff = sort { $b->{'diff'} <=> $a->{'diff'} 
+} @$ref_matches;

    for( my $round_idx = 0; $round_idx < $nb_rounds; $round_idx += 1 )
    {
        my @players;
        my @forbidden_matches;
        my $found_idx;
        my $found_match;
        my $found_match_str;

        for( my $match_idx = 0; $match_idx < $nb_matches_per_round; $m
+atch_idx += 1 )
        {
            my $found;
            my $i = -1;
            for my $ref_match ( @matches_sorted_by_diff )
            {
                $i += 1;

                next if( ("$ref_match->{'left_player'}" ~~ @players) |
+|
                         ("$ref_match->{'right_player'}" ~~ @players) 
+);

                my $match_str = $ref_match->{'left_player'} . $sep . $
+ref_match->{'right_player'};
                next if( $match_str ~~ @forbidden_matches );

                $found = 1;
                $found_idx = $i;
                $found_match = $ref_match;
                $found_match_str = $match_str;
                push(@players, "$ref_match->{'left_player'}", "$ref_ma
+tch->{'right_player'}");
                splice(@matches_sorted_by_diff, $i, 1);
                push(@{ $ref_rounds->[$round_idx] },
                     $found_match_str);
                last;
            }

            unless( $found )
            {
                push(@forbidden_matches, $found_match_str);

                pop(@players);
                pop(@players);
                splice(@matches_sorted_by_diff, $found_idx, 0, $found_
+match);
                pop(@{ $ref_rounds->[$round_idx] });
                $match_idx -= 1;
                redo;
            }
        }
    }

    return 1;
}
[download]

Thank you very much for your help.

Greetings,

Dirk

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.