Games-Tournament-Swiss
view release on metacpan or search on metacpan
lib/Games/Tournament/Swiss/Procedure/FIDE.pm view on Meta::CPAN
my @thisMemberIds = map { $_->pairingNumber } @evacuees;
my @nextMemberIds = map { $_->pairingNumber } @{$nextgroup->members};
$self->log( "Moving down all Bracket $number($next), to $nextNumber." );
$self->log( "@thisMemberIds => Bracket $nextNumber: @nextMemberIds" );
$self->thisBracket($next);
$nextgroup->resetShuffler;
$group->dissolved(1);
return C1;
}
}
=head2 colors
$next = $pairing->c7
while ( my @s2 = &$next )
{
create match cards unless this permutation is incompatible;
}
After an acceptable pairing is achieved that doesn't violate the one-time match only principle (B1) and the 2-game maximum on difference between play in one role over that in the other role (B2), roles are allocated so as to grant the preferences of ...
=cut
sub colors {
my $self = shift;
my %args = @_;
my $groups = $self->brackets;
my $round = $self->round;
my $thisGroup = $self->thisBracket;
my $group = $groups->{$thisGroup};
my $number = $group->number;
my $pairs = $args{paired};
my ($message, @bracketMatches);
for my $pair ( @$pairs ) {
my @pair = @$pair;
my @rolehistory = ( map { $pair[$_]->rolesPlayedList } 0, 1 );
my @lastdiff;
for my $lookback ( 1 .. $round - FIRSTROUND )
{
last if notall { $_->firstround <= $round-$lookback } @pair;
my $s1role = $rolehistory[0]->[-$lookback];
my $s2role = $rolehistory[1]->[-$lookback];
my @ids = map {$_->id} @pair;
# die "Missing roles for Players @ids in Round " . ($round-$lookback)
last
unless $s1role and $s2role;
next if $s1role eq $s2role;
next unless 2 == grep { $_ eq (ROLES)[0] or $_ eq (ROLES)[1] }
($s1role, $s2role);
@lastdiff = ($s1role, $s2role);
last;
}
my ( $contestants, $stronger, $diff );
my @roles = map { $_->preference->role } @pair;
my @strengths = map { $_->preference->strength } @pair;
my $rule;
if ( not $roles[0] and not $roles[1] ) {
( $roles[0], $roles[1] ) = $self->randomRole;
$rule = 'No prefs';
}
if ( not $roles[0] ) {
$roles[0] =
( $roles[1] eq (ROLES)[1] )
? (ROLES)[0]
: (ROLES)[1];
$rule = 'No S1 pref';
}
if ( not $roles[1] ) {
$roles[1] =
( $roles[0] eq (ROLES)[1] )
? (ROLES)[0]
: (ROLES)[1];
$rule = 'No S2 pref';
}
if ( $roles[0] ne $roles[1] ) {
$contestants = { $roles[0] => $pair[0], $roles[1] => $pair[1] };
$rule = 'E1';
}
elsif ( $strengths[0] ne $strengths[1] ) {
if (
defined(
$stronger = (
grep { $pair[$_]->preference->strength eq 'Absolute' }
0 .. 1
)[0]
)
)
{
1;
}
elsif (
defined(
$stronger = (
grep { $pair[$_]->preference->strength eq 'Strong' }
0 .. 1
)[0]
)
)
{
1;
}
elsif (
defined(
$stronger = (
grep { $pair[$_]->preference->strength eq 'Mild' }
0 .. 1
)[0]
)
)
{
1;
}
my $strongerRole = $pair[$stronger]->preference->role;
my $weaker = $stronger == 0 ? 1 : 0;
my $weakerRole = ( grep { $_ ne $strongerRole } ROLES )[0];
$contestants = {
$strongerRole => $pair[$stronger],
$weakerRole => $pair[$weaker]
};
( run in 1.342 second using v1.01-cache-2.11-cpan-bbb979687b5 )