Großartig.
Ich erstelle die Spielpläne immer mit der fertigen Tabellen, die ich irgendwo gefunden habe. Aber mit deinem Hinweis bin ich auf den Berger Algorithmus gestossen. Ich hab den mal umgesetzt, leider in Perl, da ich es für ein fertiges Perlskript brauche.
[code]package RoundBerger;
sub new {
my $self = bless {}, shift;
$self->{teams} = shift || 0;
$self->{data} = ;
$self->{onstart} = sub {};
$self->{onend} = sub {};
$self->{onrow_start} = sub {};
$self->{onrow_end} = sub {};
$self->{ongame} = sub {};
return $self;
}
helper function
sub _x{
my $self = shift;
my $num = int($self->{teams} / 2);
my $null;
if($self->{teams} % 2) {
$num++;
$null++;
}
return ($num, $num *2, $null);
}
events
sub onstart{
my $self = shift;
$self->{onstart} = shift if ref $[0] eq ‚CODE‘;
}
sub onend{
my $self = shift;
$self->{onend} = shift if ref $[0] eq ‚CODE‘;
}
sub onrow_start{
my $self = shift;
$self->{onrow_start} = shift if ref $[0] eq ‚CODE‘;
}
sub onrow_end{
my $self = shift;
$self->{onrow_end} = shift if ref $[0] eq ‚CODE‘;
}
sub ongame{
my $self = shift;
$self->{ongame} = shift if ref $_[0] eq ‚CODE‘;
}
properties
sub num_games{
my $self = shift;
my $reverse = scalar @{$self->{data}} > $self->num_rounds;
return ($self->{teams} / 2) * ($self->{teams} - 1) * ($reverse ? 2 : 1)
}
sub num_rounds{
my $self = shift;
return int($self->{teams} - 1 + .5)
}
sub num_teams{
return shift->{teams};
}
sub round{
my $self = shift;
my $d = shift || 0;
die „$d is out of range (0…“ . $self->num_rounds.„).“ if($d < 0 or $d > $self->num_rounds);
return $self->{data}->[$d];
}
calculate berger tournament
sub berger{
my $self = shift;
my $rev = shift;
my($num, $max, $null) = $self->x();
return unless($num);
my @t;
$t[0] = [grep $, (1…$num)];
$t[1] = [grep $_, reverse($num+1…$max)];
my @arr;
my $switch = 1;
my $r = 0;
for (1…$self->num_rounds) {
my @tmp;
my @tmp1;
for my $c2(0…$num-1) {
my $t1 = $t[0]->[$c2];
my $t2 = $t[1]->[$c2];
if($null && ($t1 == $max || $t2 == $max)){
$null = $t1 == $max ? $t2 : $t1;
next;
}
push @tmp, [$t1, $t2];
push @tmp1, [$t2, $t1];
}
push @tmp, [$null] if $null;
$arr[$r] = @tmp;
$arr[$r + $self->num_rounds] = @tmp1 if $rev;
++$r;
my $tmp0 = shift @{$t[$switch]};
my $not = $switch ? 0 : 1;
if(!$switch) {
unshift @{$t[0]}, shift @{$t[1]};
}else{
push @{$t[1]}, pop @{$t[0]};
}
for(2..$num-$switch) {
unshift @{$t[0]}, shift @{$t[1]};
push @{$t[1]}, pop @{$t[0]};
}
unshift @{$t[$not]}, $tmp0;
$switch = $not;
}
$self->{_data_} = \@arr;
}
sub out{
my $self = shift;
my $param = shift;
my $data = $param->{sortByTeam} ? $self->sortByTeam() : $self->{data};
$self->onstart($param->{onstart});
$self->onend($param->{onend});
$self->onrow_start($param->{onrow_start});
$self->onrow_end($param->{onrow_end});
$self->ongame($param->{ongame});
$self->{_onstart_}->($self);
my $r = 0;
foreach my $rounds(@$data){
$r++;
$self->{_onrow_start_}->($self, $r);
foreach my $round(@$rounds) {
$self->{_ongame_}->($self, $round);
}
$self->{_onrow_end_}->($self, $r);
}
$self->{_onend_}->($self);
}
sub sortByTeam {
my $self = shift;
my($num, $max, $null) = $self->x();
# Ein zweidimensonales Array mit allen Spielen
my $arr = [];
# füllen mit einem defaultwert
for my $c(0…$max-1) {
$arr->[$c] = [];
for (0…$max-1) {
$arr->[$c]->[$] = $c == $_ ? ‚*‘ : ‚-‘;
}
}
my $r = 0;
my $swap = scalar @{$self->{data}} < $max;
foreach my $rounds(@{$self->{data}}){
++$r;
foreach my $round(@$rounds) {
next if ref $round ne ‚ARRAY‘;
my $idx_1 = $round->[0] -1;
my $idx_2 = $round->[1]-1;
if($swap && $idx_1 > $idx_2) {
my $tmp = $idx_2;
$idx_2 = $idx_1;
$idx_1 = $tmp;
}
$arr->[$idx_1]->[$idx_2] = $r;
}
}
return $arr;
}
[/code]
Ein Beispiel:
[code]#!/usr/bin/perl -w
use strict;
use RoundBerger;
my $num = $ARGV[0];
my $r = RoundBerger->new($num);
my $teams = [qw(a b c d e f g h i )];
unshift @$teams, 0; # index starts with 1
$r->berger();
$r->onrow_end(sub{ print „\n“;});
$r->out({
onrow_start => sub{ printf ‚Runde %2s:‘, $[1];},
ongame => sub{
printf ‚[%2s-%2s]‘,team($[1]->[0]), team($[1]->[1]);
},
sortByTeam => 0
});
print „Kreuztabelle:\n“;
$r->out({
onrow_start => sub{ print 'Team: ', team($[1]);},
ongame => sub{
printf ‚[%2s]‘, $[1];
},
onstart => sub {
print "\nTeam: ";
my $self = shift;
printf ’ %2s ', team($) for(1…$self->num_teams) ;
print „\n“;
},
sortByTeam => 1
});
printf „games: %s\ndays: %s\n“, $r->num_games(), $r->num_rounds();
sub team {
return $teams->[shift];
}
[/code]
Ausgabe:
[code]struppi@struppi-desktop:~/projekte/perl$ perl test.pl 8
Runde 1:[ a- h][ b- g][ c- f][ d- e]
Runde 2:[ h- e][ f- d][ g- c][ a- b]
Runde 3:[ b- h][ c- a][ d- g][ e- f]
Runde 4:[ h- f][ g- e][ a- d][ b- c]
Runde 5:[ c- h][ d- b][ e- a][ f- g]
Runde 6:[ h- g][ a- f][ b- e][ c- d]
Runde 7:[ d- h][ e- c][ f- b][ g- a]
Kreuztabelle:
Team: a b c d e f g h
Team: a[ *][ 2][ 3][ 4][ 5][ 6][ 7][ 1]
Team: b[ -][ *][ 4][ 5][ 6][ 7][ 1][ 3]
Team: c[ -][ -][ *][ 6][ 7][ 1][ 2][ 5]
Team: d[ -][ -][ -][ *][ 1][ 2][ 3][ 7]
Team: e[ -][ -][ -][ -][ *][ 3][ 4][ 2]
Team: f[ -][ -][ -][ -][ -][ *][ 5][ 4]
Team: g[ -][ -][ -][ -][ -][ -][ *][ 6]
Team: h[ -][ -][ -][ -][ -][ -][ -][ *]
games: 28
days: 7
[/code]