line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Games::Tournament::Swiss::Procedure::FIDE; |
2
|
|
|
|
|
|
|
$Games::Tournament::Swiss::Procedure::FIDE::VERSION = '0.20'; |
3
|
|
|
|
|
|
|
# Last Edit: 2016 Jan 01, 13:44:53 |
4
|
|
|
|
|
|
|
# $Id: /swiss/trunk/lib/Games/Tournament/Swiss/Procedure/FIDE.pm 1657 2007-11-28T09:30:59.935029Z dv $ |
5
|
|
|
|
|
|
|
|
6
|
19
|
|
|
19
|
|
4914
|
use warnings; |
|
19
|
|
|
|
|
35
|
|
|
19
|
|
|
|
|
521
|
|
7
|
19
|
|
|
19
|
|
89
|
use strict; |
|
19
|
|
|
|
|
30
|
|
|
19
|
|
|
|
|
362
|
|
8
|
19
|
|
|
19
|
|
84
|
use Carp; |
|
19
|
|
|
|
|
33
|
|
|
19
|
|
|
|
|
1147
|
|
9
|
|
|
|
|
|
|
|
10
|
19
|
|
|
19
|
|
105
|
use List::Util qw/first/; |
|
19
|
|
|
|
|
34
|
|
|
19
|
|
|
|
|
1141
|
|
11
|
19
|
|
|
19
|
|
111
|
use List::MoreUtils qw/any all notall/; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
131
|
|
12
|
|
|
|
|
|
|
|
13
|
19
|
|
|
19
|
|
10476
|
use constant ROLES => @Games::Tournament::Swiss::Config::roles; |
|
19
|
|
|
|
|
34
|
|
|
19
|
|
|
|
|
1235
|
|
14
|
19
|
|
|
19
|
|
157
|
use constant FIRSTROUND => $Games::Tournament::Swiss::Config::firstround; |
|
19
|
|
|
|
|
33
|
|
|
19
|
|
|
|
|
1082
|
|
15
|
|
|
|
|
|
|
|
16
|
19
|
|
|
19
|
|
90
|
use base qw/Games::Tournament::Swiss/; |
|
19
|
|
|
|
|
33
|
|
|
19
|
|
|
|
|
1893
|
|
17
|
19
|
|
|
19
|
|
446
|
use Games::Tournament::Contestant::Swiss; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
504
|
|
18
|
|
|
|
|
|
|
|
19
|
19
|
|
|
19
|
|
88
|
use constant C1 => 'C1'; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
1068
|
|
20
|
19
|
|
|
19
|
|
93
|
use constant C2 => 'C2'; |
|
19
|
|
|
|
|
30
|
|
|
19
|
|
|
|
|
883
|
|
21
|
19
|
|
|
19
|
|
87
|
use constant C3 => 'C3'; |
|
19
|
|
|
|
|
33
|
|
|
19
|
|
|
|
|
846
|
|
22
|
19
|
|
|
19
|
|
86
|
use constant C4 => 'C4'; |
|
19
|
|
|
|
|
29
|
|
|
19
|
|
|
|
|
869
|
|
23
|
19
|
|
|
19
|
|
90
|
use constant C5 => 'C5'; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
874
|
|
24
|
19
|
|
|
19
|
|
90
|
use constant C6PAIRS => 'C6PAIRS'; |
|
19
|
|
|
|
|
30
|
|
|
19
|
|
|
|
|
885
|
|
25
|
19
|
|
|
19
|
|
94
|
use constant C6OTHERS => 'C6OTHERS'; |
|
19
|
|
|
|
|
42
|
|
|
19
|
|
|
|
|
859
|
|
26
|
19
|
|
|
19
|
|
93
|
use constant C7 => 'C7'; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
858
|
|
27
|
19
|
|
|
19
|
|
88
|
use constant C8 => 'C8'; |
|
19
|
|
|
|
|
35
|
|
|
19
|
|
|
|
|
816
|
|
28
|
19
|
|
|
19
|
|
91
|
use constant C9 => 'C9'; |
|
19
|
|
|
|
|
67
|
|
|
19
|
|
|
|
|
933
|
|
29
|
19
|
|
|
19
|
|
87
|
use constant C10 => 'C10'; |
|
19
|
|
|
|
|
33
|
|
|
19
|
|
|
|
|
863
|
|
30
|
19
|
|
|
19
|
|
91
|
use constant C11 => 'C11'; |
|
19
|
|
|
|
|
33
|
|
|
19
|
|
|
|
|
861
|
|
31
|
19
|
|
|
19
|
|
94
|
use constant C12 => 'C12'; |
|
19
|
|
|
|
|
31
|
|
|
19
|
|
|
|
|
897
|
|
32
|
19
|
|
|
19
|
|
153
|
use constant C13 => 'C13'; |
|
19
|
|
|
|
|
35
|
|
|
19
|
|
|
|
|
860
|
|
33
|
19
|
|
|
19
|
|
99
|
use constant BYE => 'bye'; |
|
19
|
|
|
|
|
528
|
|
|
19
|
|
|
|
|
902
|
|
34
|
19
|
|
|
19
|
|
90
|
use constant C14 => 'C14'; |
|
19
|
|
|
|
|
38
|
|
|
19
|
|
|
|
|
834
|
|
35
|
19
|
|
|
19
|
|
87
|
use constant FLOAT => "FLOAT"; |
|
19
|
|
|
|
|
35
|
|
|
19
|
|
|
|
|
892
|
|
36
|
19
|
|
|
19
|
|
177
|
use constant START => "START"; |
|
19
|
|
|
|
|
30
|
|
|
19
|
|
|
|
|
872
|
|
37
|
19
|
|
|
19
|
|
93
|
use constant LAST => "LAST"; |
|
19
|
|
|
|
|
28
|
|
|
19
|
|
|
|
|
823
|
|
38
|
19
|
|
|
19
|
|
89
|
use constant ERROR => "ERROR"; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
831
|
|
39
|
19
|
|
|
19
|
|
89
|
use constant MATCH => "MATCH"; |
|
19
|
|
|
|
|
36
|
|
|
19
|
|
|
|
|
902
|
|
40
|
19
|
|
|
19
|
|
90
|
use constant NEXT => "NEXT"; |
|
19
|
|
|
|
|
28
|
|
|
19
|
|
|
|
|
831
|
|
41
|
19
|
|
|
19
|
|
89
|
use constant PREV => "PREV"; |
|
19
|
|
|
|
|
34
|
|
|
19
|
|
|
|
|
272859
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 NAME |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure::FIDE - FIDE Swiss Rules Based on Rating 04.1 |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 SYNOPSIS |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
$tourney = Games::Tournament::Swiss->new( rounds => 2, entrants => [ $a, $b, $c ] ); |
52
|
|
|
|
|
|
|
%groups = $tourney->formBrackets; |
53
|
|
|
|
|
|
|
$pairing = $tourney->pairing( \%groups ); |
54
|
|
|
|
|
|
|
@pairs = $pairing->matchPlayers; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
... |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 DESCRIPTION |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
FIDE Swiss Rules C 04.1 Based on Rating describes an algorithm to pair players. The algorithm starts with the highest bracket, and then pairs each bracket in turn. ending with the lowest bracket, floating players up and down to find acceptable matches, but also undoing pairings in higher score groups, if this will help the pairing of lower score groups. This module pairs players on the basis of that algorithm. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head1 METHODS |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 new |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
$pairing = Games::Tournament::Swiss::Procedure->new( \@groups ); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
Creates a FIDE C 04.1 algorithm object on a reference to a list of scoregroups ordered by score, the group with highest score first, the one with lowest score last. This object has a matches accessor to the games (cards) the algorithm has made, an incompatibles accessor to previous matches ofthe players, a stack of groups previous to this one at this point in the pairing to which we can go back and XXX. This constructor is called in the Games::Tournament::Swiss::pairing method. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub new { |
74
|
47
|
|
|
47
|
1
|
78
|
my $self = shift; |
75
|
47
|
|
|
|
|
255
|
my %args = @_; |
76
|
|
|
|
|
|
|
return bless { |
77
|
|
|
|
|
|
|
round => $args{round}, |
78
|
|
|
|
|
|
|
brackets => $args{brackets}, |
79
|
|
|
|
|
|
|
whoPlayedWho => $args{whoPlayedWho}, |
80
|
|
|
|
|
|
|
colorClashes => $args{colorClashes}, |
81
|
|
|
|
|
|
|
badpair => undef, |
82
|
|
|
|
|
|
|
byes => $args{byes}, |
83
|
47
|
|
|
|
|
620
|
matches => {}, |
84
|
|
|
|
|
|
|
previousBracket => [], |
85
|
|
|
|
|
|
|
logged => {} |
86
|
|
|
|
|
|
|
}, |
87
|
|
|
|
|
|
|
"Games::Tournament::Swiss::Procedure"; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head2 matchPlayers |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
@pairs = $pairing->matchPlayers; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Run the FIDE C 04.1 algorithm adding matches to $pairing->matches. NOTE: At one point in deveopment of this module, I was passing round the args, rather than storing them in the object, because of problems with storing. What were those problems? What does matchPlayers return? Is it a hash or the matches or what? |
95
|
|
|
|
|
|
|
=cut |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub matchPlayers { |
98
|
47
|
|
|
47
|
1
|
207
|
my $self = shift; |
99
|
47
|
|
|
|
|
1800
|
my %machine = ( |
100
|
|
|
|
|
|
|
START, [ \&start, NEXT ], |
101
|
|
|
|
|
|
|
C1, [ \&c1, C2, NEXT, C13, C12, C1 ], |
102
|
|
|
|
|
|
|
C2, [ \&c2, C3 ], |
103
|
|
|
|
|
|
|
C3, [ \&c3, C4 ], |
104
|
|
|
|
|
|
|
C4, [ \&c4, C5 ], |
105
|
|
|
|
|
|
|
C5, [ \&c5, C6PAIRS ], |
106
|
|
|
|
|
|
|
C6PAIRS, [ \&c6pairs, C6OTHERS, C7, NEXT ], |
107
|
|
|
|
|
|
|
C6OTHERS, [ \&c6others, NEXT, C1, C2, C10, C13 ], |
108
|
|
|
|
|
|
|
C7, [ \&c7, C6PAIRS, C8, C9, C10, C11 ], |
109
|
|
|
|
|
|
|
C8, [ \&c8, C5, C9, C10 ], |
110
|
|
|
|
|
|
|
C9, [ \&c9, C4, C10 ], |
111
|
|
|
|
|
|
|
C10, [ \&c10, C7, C4, C11 ], |
112
|
|
|
|
|
|
|
C11, [ \&c11, C12, C4, C7 ], |
113
|
|
|
|
|
|
|
C12, [ \&c12, C13, C7, ], |
114
|
|
|
|
|
|
|
C13, [ \&c13, C14, C7, C1, BYE ], |
115
|
|
|
|
|
|
|
C14, [ \&c14, NEXT, C4, C13 ], |
116
|
|
|
|
|
|
|
BYE, [ \&bye, LAST, C13 ], |
117
|
|
|
|
|
|
|
NEXT, [ \&next, C1, LAST ], |
118
|
|
|
|
|
|
|
PREV, [ \&prev, C1, LAST ], |
119
|
|
|
|
|
|
|
LAST, [ undef, LAST ], |
120
|
|
|
|
|
|
|
ERROR, [ undef, ERROR ], |
121
|
|
|
|
|
|
|
); |
122
|
47
|
|
|
|
|
139
|
my $state = START; |
123
|
47
|
|
|
|
|
102
|
my $oldState = $state; |
124
|
47
|
|
|
|
|
347
|
my %args = %$self; |
125
|
47
|
|
|
|
|
107
|
for ( ; ; ) { |
126
|
5605
|
|
|
|
|
10233
|
my $transitions = $machine{$state}; |
127
|
5605
|
50
|
33
|
|
|
27586
|
die "$oldState, $state, $transitions" unless $transitions and ref($transitions) eq 'ARRAY'; |
128
|
5605
|
|
|
|
|
14302
|
my ( $action, @alterStates ) = @$transitions; |
129
|
5605
|
|
|
|
|
7390
|
$oldState = $state; |
130
|
5605
|
50
|
|
|
|
19020
|
( $state, %args ) = $action->( $self, %args ) if $action; |
131
|
5605
|
100
|
|
1537
|
|
25976
|
if ( any { $_ eq $oldState } $self->loggedProcedures ) |
|
1537
|
|
|
|
|
1935
|
|
132
|
|
|
|
|
|
|
{ |
133
|
133
|
|
|
|
|
330
|
my %log = $self->tailLog($oldState); |
134
|
133
|
50
|
|
|
|
615
|
$self->logreport( $oldState . "," . $log{$oldState} ) if %log; |
135
|
|
|
|
|
|
|
} |
136
|
5605
|
50
|
|
|
|
20113
|
if ( $state eq ERROR ) { |
137
|
0
|
|
|
|
|
0
|
die |
138
|
|
|
|
|
|
|
qq/Pairing error: $args{msg}. Pairing NOT complete\n/; |
139
|
|
|
|
|
|
|
} |
140
|
5605
|
100
|
|
|
|
11406
|
if ( $state eq LAST ) { |
141
|
47
|
|
|
|
|
244
|
$self->message( $args{msg} ); |
142
|
47
|
|
|
|
|
643
|
return $self; } |
143
|
5558
|
50
|
|
|
|
78194
|
die "No transition defined from $oldState to $state" |
144
|
|
|
|
|
|
|
unless grep m/$state/, @alterStates; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head2 message |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
$pairing->message; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Something about the success or failure of the pairing procedure as far as it concerns the user. This is not a message about the success or failure of the Games::Tournament::Swiss::Procedure::FIDE code as in 'warn', or a logging of the progress of the players in their brackets through the FIDE pairing procedure as in 'log', or a message about a problem coding the FIDE algorithm, as in 'ERROR'. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub message { |
158
|
47
|
|
|
47
|
1
|
75
|
my $self = shift; |
159
|
47
|
|
|
|
|
113
|
my $message = shift; |
160
|
47
|
100
|
|
|
|
218
|
if ( defined $message ) { $self->{message} .= $message; } |
|
1
|
50
|
|
|
|
5
|
|
161
|
0
|
|
|
|
|
0
|
elsif ( $self->{message} ) { return $self->{message}; } |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 logreport |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
$pairing->logreport('C6: Pairing S1 and S2'); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Accumulates a log in string form, of the progress of the players in their brackets through the FIDE pairing procedure, using the logging methods of Games::Tournament, and returning the log accumulated if no arguments are passed. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=cut |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub logreport { |
174
|
133
|
|
|
133
|
1
|
176
|
my $self = shift; |
175
|
133
|
|
|
|
|
184
|
my $logreport = shift; |
176
|
133
|
50
|
|
|
|
255
|
if ( defined $logreport ) { $self->{logreport} .= $logreport; } |
|
133
|
0
|
|
|
|
533
|
|
177
|
0
|
|
|
|
|
0
|
elsif ( $self->{logreport} ) { return $self->{logreport}; } |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head2 start |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
$pairing->start; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Start at the start before the first bracket. Go to the next bracket. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub start { |
190
|
47
|
|
|
47
|
1
|
74
|
my $self = shift; |
191
|
47
|
|
|
|
|
199
|
my $index = $self->thisBracket; |
192
|
47
|
|
|
|
|
200
|
my $groups = $self->brackets; |
193
|
47
|
50
|
|
|
|
132
|
die "Can't start. Already started." if defined $index; |
194
|
47
|
|
|
|
|
125
|
$self->thisBracket('START'); |
195
|
47
|
|
|
|
|
152
|
my $round = $self->round; |
196
|
47
|
|
|
|
|
113
|
my $brackets = $self->brackets; |
197
|
47
|
|
|
|
|
158
|
my $banner = "Round $round: "; |
198
|
47
|
|
|
|
|
233
|
for my $bracket ( reverse sort keys %$brackets ) { |
199
|
117
|
|
|
|
|
425
|
my $members = $brackets->{$bracket}->members; |
200
|
117
|
|
|
|
|
388
|
my $score = $brackets->{$bracket}->score; |
201
|
117
|
|
|
|
|
194
|
$banner .= "@{[map { $_->pairingNumber } @$members]} ($score), "; |
|
117
|
|
|
|
|
215
|
|
|
329
|
|
|
|
|
801
|
|
202
|
|
|
|
|
|
|
} |
203
|
47
|
|
|
|
|
227
|
$self->log( $banner ); |
204
|
47
|
|
|
|
|
190
|
return NEXT; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head2 next |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
$pairing->next; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Pair the next bracket. End if this is the last bracket. Die if we are not pairing any bracket now. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=cut |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub next { |
217
|
219
|
|
|
219
|
1
|
314
|
my $self = shift; |
218
|
219
|
|
|
|
|
564
|
my $index = $self->thisBracket; |
219
|
219
|
50
|
|
|
|
535
|
die "No bracket being paired" unless defined $index; |
220
|
219
|
100
|
66
|
|
|
865
|
return LAST if defined $index and $index eq $self->lastBracket; |
221
|
203
|
|
|
|
|
593
|
my $next = $self->nextBracket; |
222
|
203
|
50
|
|
|
|
498
|
die "No next bracket to $index-Bracket" unless defined $next; |
223
|
203
|
|
|
|
|
467
|
my $groups = $self->brackets; |
224
|
203
|
|
|
|
|
368
|
my $nextBracket = $groups->{$next}; |
225
|
203
|
50
|
33
|
|
|
1425
|
die "Next bracket is: $next Bracket?" unless defined $nextBracket |
226
|
|
|
|
|
|
|
and $nextBracket->isa('Games::Tournament::Swiss::Bracket'); |
227
|
203
|
|
|
|
|
595
|
my $members = $nextBracket->members; |
228
|
203
|
|
|
|
|
480
|
my @ids = map {$_->pairingNumber} @$members; |
|
616
|
|
|
|
|
1486
|
|
229
|
203
|
|
|
|
|
580
|
my $number = $nextBracket->number; |
230
|
203
|
|
|
|
|
476
|
$self->thisBracket($next); |
231
|
203
|
|
|
|
|
1134
|
$self->log( "$next-Bracket [$number]: @ids" ); |
232
|
203
|
|
|
|
|
767
|
return C1; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head2 prev |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
$pairing->prev; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
Pair the previous bracket. End if this is the first bracket. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub prev { |
245
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
246
|
0
|
|
|
|
|
0
|
my $brackets = $self->brackets; |
247
|
0
|
|
|
|
|
0
|
my $index = $self->thisBracket; |
248
|
0
|
|
|
|
|
0
|
my $bracket = $brackets->{$index}; |
249
|
0
|
0
|
0
|
|
|
0
|
return LAST if defined $index and $index eq $self->firstBracket; |
250
|
0
|
|
|
|
|
0
|
my $prevIndex = $self->previousBracket; |
251
|
0
|
|
|
|
|
0
|
my $prevBracket = $brackets->{$prevIndex}; |
252
|
0
|
|
|
|
|
0
|
my $members = $prevBracket->members; |
253
|
0
|
|
|
|
|
0
|
my $number = $prevBracket->number; |
254
|
0
|
|
|
|
|
0
|
$self->thisBracket($prevIndex); |
255
|
0
|
|
|
|
|
0
|
my @ids = map {$_->pairingNumber} @$members; |
|
0
|
|
|
|
|
0
|
|
256
|
0
|
|
|
|
|
0
|
$self->log( "Previous, Bracket $number ($prevIndex): @ids"); |
257
|
0
|
|
|
|
|
0
|
return C1; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head2 c1 |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
$pairing->c1; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
If the score group contains a player for whom no opponent can be found (B1,B2), and if this player is a downfloater, go to C12 to find another player to downfloat instead. Or if this is the last group, go to C13. Otherwise, downfloat the unpairable player. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=cut |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub c1 { |
270
|
206
|
|
|
206
|
1
|
332
|
my $self = shift; |
271
|
206
|
|
|
|
|
500
|
my $groups = $self->brackets; |
272
|
206
|
|
|
|
|
564
|
my $alreadyPlayed = $self->whoPlayedWho; |
273
|
206
|
|
|
|
|
498
|
my $colorClashes = $self->colorClashes; |
274
|
206
|
|
|
|
|
440
|
my $index = $self->thisBracket; |
275
|
206
|
|
|
|
|
383
|
my $group = $groups->{$index}; |
276
|
206
|
|
|
|
|
614
|
my $number = $group->number; |
277
|
206
|
|
|
|
|
613
|
my $members = $group->residents; |
278
|
206
|
|
|
|
|
295
|
my @unpairables; |
279
|
206
|
|
|
|
|
295
|
my $nokmessage = 'NOK.'; |
280
|
206
|
100
|
|
|
|
462
|
if ( @$members == 1 ) { |
281
|
49
|
|
|
|
|
93
|
my $member = $members->[0]; |
282
|
49
|
|
|
|
|
84
|
push @unpairables, $member; |
283
|
49
|
|
|
|
|
142
|
my $id = $member->pairingNumber; |
284
|
49
|
|
|
|
|
129
|
$nokmessage .= " $id"; |
285
|
49
|
|
|
|
|
218
|
$self->log( $nokmessage . " only member in $index-Bracket [$number]" ); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
else { |
288
|
157
|
|
|
|
|
332
|
for my $player (@$members) { |
289
|
583
|
|
|
|
|
1574
|
my $id = $player->id; |
290
|
583
|
|
|
|
|
1544
|
my $pairingNumber = $player->pairingNumber; |
291
|
583
|
|
|
|
|
892
|
my $rejections = 0; |
292
|
583
|
|
|
|
|
937
|
my @candidates = grep { $_ != $player } @$members; |
|
2649
|
|
|
|
|
5659
|
|
293
|
583
|
|
|
|
|
839
|
my @ids = map { $_->id } @candidates; |
|
2066
|
|
|
|
|
4753
|
|
294
|
583
|
|
|
|
|
1074
|
foreach my $candidate (@ids) { |
295
|
2066
|
100
|
|
|
|
6825
|
if ( $alreadyPlayed->{$id}->{$candidate} ) { $rejections++; } |
|
612
|
100
|
|
|
|
971
|
|
296
|
30
|
|
|
|
|
53
|
elsif ( $colorClashes->{$id}->{$candidate} ) { $rejections++; } |
297
|
|
|
|
|
|
|
} |
298
|
583
|
100
|
66
|
|
|
3314
|
if ( $rejections >= @candidates or @candidates == 0 ) { |
299
|
92
|
|
|
|
|
178
|
$nokmessage .= " $pairingNumber"; |
300
|
92
|
|
|
|
|
264
|
push @unpairables, $player; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
157
|
100
|
|
|
|
446
|
if (@unpairables) { |
304
|
72
|
|
|
|
|
126
|
my @ids = map { $_->pairingNumber } @unpairables; |
|
92
|
|
|
|
|
252
|
|
305
|
72
|
|
|
|
|
431
|
$self->log( |
306
|
|
|
|
|
|
|
"$nokmessage: @ids B1a/B2a incompatible in $number ($index)"); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
} |
309
|
206
|
|
|
|
|
473
|
my @unpairableIds = map {$_->pairingNumber} @unpairables; |
|
141
|
|
|
|
|
470
|
|
310
|
206
|
|
|
|
|
309
|
my ($previousIndex, $previousBracket, $previousMembers, $previousNumber); |
311
|
206
|
|
|
|
|
556
|
$previousIndex = $self->previousBracket; |
312
|
206
|
100
|
|
|
|
611
|
$previousBracket = $groups->{$previousIndex} if $previousIndex; |
313
|
206
|
100
|
|
|
|
682
|
$previousMembers = $previousBracket->members if $previousBracket; |
314
|
206
|
100
|
|
|
|
654
|
$previousNumber = $previousBracket->number if $previousBracket; |
315
|
206
|
100
|
|
|
|
477
|
if (@unpairables) { |
316
|
121
|
100
|
100
|
|
|
291
|
if ( $index eq $self->lastBracket and $index ne $self->firstBracket ) |
|
|
50
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
317
|
|
|
|
|
|
|
{ |
318
|
89
|
|
|
|
|
474
|
$self->log( "@unpairableIds in last bracket, $number ($index)." ); |
319
|
89
|
|
|
|
|
439
|
return C13; |
320
|
|
|
|
|
|
|
} |
321
|
40
|
100
|
|
|
|
185
|
elsif ((grep {$_->floating and $_->floating eq 'Down'} @unpairables) |
322
|
|
|
|
|
|
|
and $previousIndex and $previousMembers ) |
323
|
|
|
|
|
|
|
{ |
324
|
0
|
|
|
|
|
0
|
$self->log( |
325
|
|
|
|
|
|
|
"@unpairableIds floaters from $previousNumber ($previousIndex)" ); |
326
|
0
|
|
|
|
|
0
|
return C12; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
elsif (defined $self->nextBracket) |
329
|
|
|
|
|
|
|
{ |
330
|
27
|
|
|
|
|
76
|
my $next = $self->nextBracket; |
331
|
27
|
|
|
|
|
70
|
my $nextBracket = $groups->{$next}; |
332
|
27
|
|
|
|
|
89
|
my $nextNumber = $nextBracket->number; |
333
|
27
|
|
|
|
|
170
|
$self->log( |
334
|
|
|
|
|
|
|
"Floating @unpairableIds down to $next-Bracket [$nextNumber]" ); |
335
|
27
|
|
|
|
|
150
|
$group->exit($_) for @unpairables; |
336
|
27
|
|
|
|
|
118
|
$_->floating('Down') for @unpairables; |
337
|
27
|
|
|
|
|
127
|
$nextBracket->entry($_) for @unpairables; |
338
|
27
|
|
|
|
|
329
|
my @originals = map {$_->pairingNumber} @{$group->members}; |
|
4
|
|
|
|
|
12
|
|
|
27
|
|
|
|
|
99
|
|
339
|
27
|
|
|
|
|
53
|
my @new = map {$_->pairingNumber} @{$nextBracket->members}; |
|
111
|
|
|
|
|
264
|
|
|
27
|
|
|
|
|
82
|
|
340
|
27
|
|
|
|
|
205
|
$self->log( "[$number] @originals & [$nextNumber] @new" ); |
341
|
27
|
100
|
|
|
|
104
|
if ( @unpairables == @$members ) { |
342
|
25
|
|
|
|
|
68
|
my $previous = $self->previousBracket; |
343
|
25
|
|
|
|
|
133
|
$self->log( "$index-Bracket [$number] dissolved" ); |
344
|
25
|
|
|
|
|
234
|
$self->thisBracket($previous); |
345
|
25
|
|
|
|
|
85
|
$group->dissolved(1); |
346
|
25
|
|
|
|
|
339
|
return NEXT; |
347
|
|
|
|
|
|
|
} |
348
|
2
|
|
|
|
|
11
|
else { return C2; } |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
else { |
351
|
5
|
|
|
|
|
26
|
$self->log( |
352
|
|
|
|
|
|
|
"No destination for unpairable @unpairableIds. Go to C2" ); |
353
|
5
|
|
|
|
|
27
|
return C2; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
else { |
357
|
85
|
|
|
|
|
271
|
$self->log( "B1,2 test: OK, no unpairables" ); |
358
|
85
|
|
|
|
|
437
|
return C2; |
359
|
|
|
|
|
|
|
} |
360
|
0
|
|
|
|
|
0
|
return ERROR, msg => "Fell through C1 in $number ($index)"; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=head2 rejectionTest |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
($message, @unpairables) = $pairing->rejectionTest(@members) |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Returns the unpairable players in a score bracket, if it contains players for whom no opponent can be found (B1,B2). This is useful in C1, but it is also useful in pairing a remainder group, where we want to know the same thing but don't want to take the same action as in C1. It would be convenient to know that the group is unpairable as-is, without going through all the C6,7,8,9,10 computations. |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=cut |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub rejectionTest { |
373
|
45
|
|
|
45
|
1
|
72
|
my $self = shift; |
374
|
45
|
|
|
|
|
107
|
my @members = @_; |
375
|
45
|
|
|
|
|
107
|
my $alreadyPlayed = $self->whoPlayedWho; |
376
|
45
|
|
|
|
|
109
|
my $colorClashes = $self->colorClashes; |
377
|
45
|
|
|
|
|
64
|
my @unpairables; |
378
|
45
|
|
|
|
|
83
|
my $nokmessage = 'NOK.'; |
379
|
45
|
50
|
|
|
|
154
|
if ( @members == 1 ) { |
380
|
0
|
|
|
|
|
0
|
my $member = $members[0]; |
381
|
0
|
|
|
|
|
0
|
push @unpairables, $member; |
382
|
0
|
|
|
|
|
0
|
my $id = $member->pairingNumber; |
383
|
0
|
|
|
|
|
0
|
$nokmessage .= " $id only member"; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
else { |
386
|
45
|
|
|
|
|
103
|
for my $player (@members) { |
387
|
168
|
|
|
|
|
447
|
my $id = $player->id; |
388
|
168
|
|
|
|
|
243
|
my $rejections = 0; |
389
|
168
|
|
|
|
|
259
|
my @candidates = grep { $_ != $player } @members; |
|
654
|
|
|
|
|
1436
|
|
390
|
168
|
|
|
|
|
245
|
my @ids = map { $_->id } @candidates;; |
|
486
|
|
|
|
|
1100
|
|
391
|
168
|
|
|
|
|
329
|
foreach my $candidate ( @ids ) { |
392
|
486
|
100
|
|
|
|
1527
|
if ( $alreadyPlayed->{$id}->{$candidate} ) { $rejections++; } |
|
210
|
50
|
|
|
|
322
|
|
393
|
0
|
|
|
|
|
0
|
elsif ( $colorClashes->{$id}->{$candidate} ) { $rejections++; } |
394
|
|
|
|
|
|
|
} |
395
|
168
|
100
|
66
|
|
|
934
|
if ( $rejections >= @candidates or @candidates == 0 ) { |
396
|
20
|
|
|
|
|
63
|
push @unpairables, $player; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
} |
399
|
45
|
100
|
|
|
|
131
|
if ( @unpairables ) |
400
|
|
|
|
|
|
|
{ |
401
|
20
|
|
|
|
|
37
|
my @ids = map { $_->pairingNumber } @unpairables; |
|
20
|
|
|
|
|
56
|
|
402
|
20
|
|
|
|
|
94
|
$nokmessage .= " @ids B1a/B2a incompatible"; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
} |
405
|
45
|
100
|
|
|
|
107
|
if ( @unpairables ) { return $nokmessage, @unpairables; } |
|
20
|
|
|
|
|
90
|
|
406
|
25
|
|
|
|
|
88
|
else { return "B1,2 test: OK, no unpairables"; } |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=head2 c2 |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
$pairing->c2 |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Determine x according to A8. But only if xprime has not been defined for the bracket (remainder group) by C11. See B4 and http://chesschat.org/showthread.php?p=173273#post173273 |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=cut |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub c2 { |
419
|
131
|
|
|
131
|
1
|
199
|
my $self = shift; |
420
|
131
|
|
|
|
|
329
|
my $groups = $self->brackets; |
421
|
131
|
|
|
|
|
332
|
my $this = $self->thisBracket; |
422
|
131
|
|
|
|
|
252
|
my $group = $groups->{$this}; |
423
|
131
|
|
|
|
|
437
|
my $number = $group->number; |
424
|
131
|
|
|
|
|
522
|
my $x = $group->x; |
425
|
131
|
50
|
|
|
|
447
|
$group->xprime( $group->x ) unless defined $group->xprime; |
426
|
131
|
|
|
|
|
389
|
my $xprime = $group->xprime; |
427
|
131
|
|
|
|
|
545
|
$self->log( "x=$xprime" ); |
428
|
131
|
|
|
|
|
625
|
return C3; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head2 c3 |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
$pairing->c3 |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
Determine p according to A6. |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=cut |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
sub c3 { |
441
|
131
|
|
|
131
|
1
|
204
|
my $self = shift; |
442
|
131
|
|
|
|
|
372
|
my $groups = $self->brackets; |
443
|
131
|
|
|
|
|
318
|
my $this = $self->thisBracket; |
444
|
131
|
|
|
|
|
267
|
my $group = $groups->{$this}; |
445
|
131
|
|
|
|
|
409
|
my $number = $group->number; |
446
|
131
|
|
|
|
|
470
|
my $p = $group->p; |
447
|
131
|
|
|
|
|
384
|
$group->pprime( $group->p ); |
448
|
131
|
100
|
|
|
|
399
|
if ( $group->hetero ) { $self->log( "p=$p. Heterogeneous."); } |
|
28
|
|
|
|
|
141
|
|
449
|
103
|
|
|
|
|
454
|
else { $self->log( "p=$p. Homogeneous."); } |
450
|
131
|
|
|
|
|
461
|
return C4; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=head2 c4 |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
$pairing->c4 |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
The highest players in S1, the others in S2. |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=cut |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
sub c4 { |
463
|
330
|
|
|
330
|
1
|
496
|
my $self = shift; |
464
|
330
|
|
|
|
|
795
|
my $groups = $self->brackets; |
465
|
330
|
|
|
|
|
831
|
my $group = $groups->{$self->thisBracket}; |
466
|
330
|
|
|
|
|
1023
|
my $members = $group->members; |
467
|
330
|
|
|
|
|
756
|
my $index = $self->thisBracket; |
468
|
330
|
|
|
|
|
901
|
my $number = $group->number; |
469
|
330
|
|
|
|
|
998
|
$group->resetS12; |
470
|
330
|
|
|
|
|
908
|
my $s1 = $group->s1; |
471
|
330
|
|
|
|
|
841
|
my $s2 = $group->s2; |
472
|
330
|
|
|
|
|
705
|
my @s1ids = map {$_->pairingNumber} @$s1; |
|
506
|
|
|
|
|
1247
|
|
473
|
330
|
|
|
|
|
650
|
my @s2ids = map {$_->pairingNumber} @$s2; |
|
794
|
|
|
|
|
1847
|
|
474
|
330
|
|
|
|
|
2061
|
$self->log( "S1: @s1ids & S2: @s2ids" ); |
475
|
330
|
50
|
|
|
|
913
|
die "Empty S1 in $index-Bracket ($number) with S2: @s2ids." unless @$s1; |
476
|
330
|
50
|
|
|
|
755
|
die "Empty $index-Bracket ($number) with S1: @s1ids." unless @$s2; |
477
|
330
|
|
|
|
|
1329
|
return C5; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head2 c5 |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
$pairing->c5 |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
Order the players in S1 and S2 according to A2. |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=cut |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
sub c5 { |
490
|
564
|
|
|
564
|
1
|
918
|
my $self = shift; |
491
|
564
|
|
|
|
|
1551
|
my $groups = $self->brackets; |
492
|
564
|
|
|
|
|
1445
|
my $group = $groups->{ $self->thisBracket }; |
493
|
564
|
|
|
|
|
1828
|
my $number = $group->number; |
494
|
564
|
|
|
|
|
1527
|
my $members = $group->members; |
495
|
564
|
|
|
|
|
1665
|
my $x = $group->xprime; |
496
|
564
|
|
|
|
|
1465
|
my $s1 = $group->s1; |
497
|
564
|
|
|
|
|
1446
|
my $s2 = $group->s2; |
498
|
564
|
|
|
|
|
1736
|
my @s1 = $self->rank(@$s1); |
499
|
564
|
|
|
|
|
3199
|
my @s2 = $self->rank(@$s2); |
500
|
564
|
|
|
|
|
2584
|
my @s1ids = map {$_->pairingNumber} @s1; |
|
1020
|
|
|
|
|
2723
|
|
501
|
564
|
|
|
|
|
1022
|
my @s2ids = map {$_->pairingNumber} @s2; |
|
1369
|
|
|
|
|
3258
|
|
502
|
564
|
|
|
|
|
3446
|
$self->log( "ordered: @s1ids\n\t & @s2ids" ); |
503
|
564
|
|
|
|
|
1820
|
$group->s1( \@s1 ); |
504
|
564
|
|
|
|
|
1610
|
$group->s2( \@s2 ); |
505
|
564
|
|
|
|
|
904
|
for my $member ( @{ $group->s2 } ) { |
|
564
|
|
|
|
|
1366
|
|
506
|
|
|
|
|
|
|
die "$member->{id} was in ${number}th bracket more than once" |
507
|
1369
|
50
|
|
|
|
1719
|
if ( grep { $_->id eq $member->id } @{ $group->s2 } ) > 1; |
|
3895
|
|
|
|
|
9691
|
|
|
1369
|
|
|
|
|
3376
|
|
508
|
|
|
|
|
|
|
} |
509
|
564
|
|
|
|
|
1549
|
$groups->{ $self->thisBracket } = $group; |
510
|
564
|
|
|
|
|
1435
|
$self->brackets($groups); |
511
|
564
|
|
|
|
|
2754
|
return C6PAIRS; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=head2 c6pairs |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c6pairs($group, $matches) |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
Pair the pprime players in the top half of the scoregroup in order with their counterparts in the bottom half, and return an array of tentative Games::Tournament::Card matches if B1, B2 and the relaxable B4-6 tests pass. In addition, as part of the B6,5 tests, check none of the UNpaired players in a homogeneous bracket were downfloated in the round before (B5) or the round before that (B6), or that there is not only one UNpaired, previously-downfloated player in a heterogeneous group, special-cased following Bill Gletsos' advice at http://chesschat.org/showpost.php?p=142260&postcount=158. If more than pprime tables are paired, we take the first pprime tables. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=cut |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
sub c6pairs { |
524
|
1517
|
|
|
1517
|
1
|
2220
|
my $self = shift; |
525
|
1517
|
|
|
|
|
3551
|
my $groups = $self->brackets; |
526
|
1517
|
|
|
|
|
3392
|
my $index = $self->thisBracket; |
527
|
1517
|
|
|
|
|
2783
|
my $group = $groups->{ $index }; |
528
|
1517
|
|
|
|
|
4195
|
my $number = $group->number; |
529
|
1517
|
|
|
|
|
4272
|
my $pprime = $group->pprime; |
530
|
1517
|
|
|
|
|
4082
|
my $s1 = $group->s1; |
531
|
1517
|
|
|
|
|
3812
|
my $s2 = $group->s2; |
532
|
1517
|
50
|
33
|
|
|
7314
|
return NEXT unless @$s1 and @$s2; |
533
|
1517
|
50
|
|
|
|
3600
|
die "More players in S1 than in S2 in $number($index)." if $#$s1 > $#$s2; |
534
|
1517
|
50
|
33
|
|
|
6783
|
die "zero players in S1 or S2 in $number($index)" unless @$s1 and @$s2; |
535
|
1517
|
|
|
|
|
3569
|
my $whoPlayedWho = $self->whoPlayedWho; |
536
|
1517
|
|
|
|
|
3239
|
my $colorClashes = $self->colorClashes; |
537
|
1517
|
|
|
|
|
4386
|
$group->badpair(undef); |
538
|
1517
|
|
|
|
|
1959
|
my @testee; |
539
|
1517
|
|
|
|
|
4247
|
for my $pos ( 0..$#$s1, $#$s1+1..$#$s2 ) |
540
|
|
|
|
|
|
|
{ |
541
|
4220
|
100
|
|
|
|
12972
|
$testee[$pos] = [ $s1->[$pos], $s2->[$pos] ] if $pos <= $#$s1; |
542
|
4220
|
100
|
|
|
|
12069
|
$testee[$pos] = [ undef, $s2->[$pos] ] if $pos > $#$s1; |
543
|
|
|
|
|
|
|
} |
544
|
1517
|
|
|
|
|
2342
|
my ($badpos, @B1passer, @B2passer, @Xpasser, @B56passer, $passer); |
545
|
1517
|
|
|
|
|
3534
|
B1: for my $pos (0..$#$s1) |
546
|
|
|
|
|
|
|
{ |
547
|
3140
|
|
|
|
|
3871
|
my @pair = @{$testee[$pos]}; |
|
3140
|
|
|
|
|
7311
|
|
548
|
3140
|
|
|
|
|
9887
|
my $test = not defined $whoPlayedWho->{$pair[0]->id}->{$pair[1]->id}; |
549
|
3140
|
100
|
|
|
|
7180
|
if ( $test ) { $B1passer[$pos] = \@pair; } |
|
2110
|
|
|
|
|
5283
|
|
550
|
1030
|
100
|
|
|
|
3121
|
else { $badpos = defined $badpos? $badpos: $pos; } |
551
|
|
|
|
|
|
|
} |
552
|
1517
|
100
|
|
|
|
3106
|
unless ( (grep { defined $_ } @B1passer) >= $pprime ) |
|
2482
|
|
|
|
|
6882
|
|
553
|
|
|
|
|
|
|
{ |
554
|
794
|
|
|
|
|
1241
|
my $pluspos = $badpos+1; |
555
|
794
|
|
|
|
|
3335
|
$self->log( "B1a: table $pluspos NOK" ); |
556
|
794
|
|
|
|
|
2530
|
$group->badpair($badpos); |
557
|
794
|
|
|
|
|
4192
|
return C7; |
558
|
|
|
|
|
|
|
} |
559
|
723
|
|
|
|
|
969
|
$badpos = undef; |
560
|
723
|
50
|
|
|
|
1607
|
die "no pairs after B1 test in $number($index)" unless @B1passer; |
561
|
723
|
|
|
|
|
1721
|
B2: for my $pos (0..$#$s1) |
562
|
|
|
|
|
|
|
{ |
563
|
1376
|
50
|
|
|
|
3098
|
next unless defined $B1passer[$pos]; |
564
|
1376
|
|
|
|
|
3226
|
my @pair = ( $B1passer[$pos]->[0], $B1passer[$pos]->[1] ); |
565
|
1376
|
|
|
|
|
4048
|
my $test = not defined $colorClashes->{$pair[0]->id}->{$pair[1]->id}; |
566
|
1376
|
100
|
|
|
|
3116
|
if ( $test ) { $B2passer[$pos] = \@pair; } |
|
1367
|
|
|
|
|
3360
|
|
567
|
9
|
100
|
|
|
|
31
|
else { $badpos = defined $badpos? $badpos: $pos; } |
568
|
|
|
|
|
|
|
} |
569
|
723
|
100
|
|
|
|
1345
|
unless ( (grep { defined $_ } @B2passer) >= $pprime ) |
|
1368
|
|
|
|
|
3713
|
|
570
|
|
|
|
|
|
|
{ |
571
|
8
|
|
|
|
|
13
|
my $pluspos = $badpos+1; |
572
|
8
|
|
|
|
|
34
|
$self->log( "B2a: table $pluspos NOK" ); |
573
|
8
|
|
|
|
|
24
|
$group->badpair($badpos); |
574
|
8
|
|
|
|
|
45
|
return C7; |
575
|
|
|
|
|
|
|
} |
576
|
715
|
50
|
|
|
|
1490
|
die "no pairs after B2 test in $number($index)" unless @B2passer; |
577
|
715
|
|
|
|
|
2214
|
my $x = $group->xprime; |
578
|
715
|
|
|
|
|
1082
|
my $quota = 0; |
579
|
715
|
|
|
|
|
997
|
$badpos = undef; |
580
|
715
|
|
|
|
|
1595
|
B4: for my $pos ( 0 .. $#$s1 ) { |
581
|
1066
|
50
|
|
|
|
2424
|
next unless defined $B2passer[$pos]; |
582
|
1066
|
|
|
|
|
2439
|
my @pair = ( $B2passer[$pos]->[0], $B2passer[$pos]->[1] ); |
583
|
1066
|
|
100
|
|
|
3430
|
$quota += ( defined $pair[0]->preference->role |
584
|
|
|
|
|
|
|
and defined $pair[1]->preference->role |
585
|
|
|
|
|
|
|
and $pair[0]->preference->role eq |
586
|
|
|
|
|
|
|
$pair[1]->preference->role ); |
587
|
1066
|
100
|
|
|
|
3003
|
if ( $quota <= $x ) { |
588
|
622
|
100
|
|
|
|
1830
|
$group->{xdeduction} = $quota if $group->hetero; |
589
|
622
|
|
|
|
|
1824
|
$Xpasser[$pos] = \@pair; |
590
|
|
|
|
|
|
|
} |
591
|
444
|
50
|
|
|
|
912
|
else { $badpos = defined $badpos? $badpos: $pos; last B4; } |
|
444
|
|
|
|
|
1092
|
|
592
|
|
|
|
|
|
|
} |
593
|
715
|
100
|
|
|
|
1609
|
unless ( (grep { defined $_ } @Xpasser) >= $pprime ) |
|
622
|
|
|
|
|
2202
|
|
594
|
|
|
|
|
|
|
{ |
595
|
443
|
|
|
|
|
648
|
my $pluspos = $badpos+1; |
596
|
443
|
|
|
|
|
2147
|
$self->log( "B4: x=$x, table $pluspos NOK" ); |
597
|
443
|
|
|
|
|
1519
|
$group->badpair($badpos); |
598
|
443
|
|
|
|
|
2926
|
return C7; |
599
|
|
|
|
|
|
|
} |
600
|
272
|
50
|
|
|
|
633
|
die "no pairs after B4 test in $number($index)" unless @Xpasser; |
601
|
272
|
|
|
|
|
408
|
$badpos = undef; |
602
|
|
|
|
|
|
|
# my @nonpaired = $group->_getNonPaired(@Xpasser); |
603
|
272
|
|
|
|
|
875
|
my $checkLevels = $self->floatCriteriaInForce( $group->floatCheckWaive ); |
604
|
272
|
|
|
|
|
1121
|
my %b65TestResults = $group->_floatCheck( \@Xpasser, $checkLevels ); |
605
|
272
|
|
|
|
|
619
|
$badpos = $b65TestResults{badpos}; |
606
|
272
|
|
|
|
|
898
|
$self->log( $b65TestResults{message} ); |
607
|
272
|
100
|
|
|
|
649
|
if ( defined $badpos ) |
608
|
|
|
|
|
|
|
{ |
609
|
80
|
|
|
|
|
140
|
my $pluspos = $badpos+1; |
610
|
80
|
|
|
|
|
277
|
$group->badpair($badpos); |
611
|
80
|
|
|
|
|
663
|
return C7; |
612
|
|
|
|
|
|
|
} |
613
|
192
|
|
|
|
|
331
|
$passer = $b65TestResults{passer}; |
614
|
192
|
50
|
|
|
|
542
|
die "no pairs after B65 test in $number($index)" unless @$passer; |
615
|
192
|
|
|
|
|
463
|
for my $pos ( 0 .. $#$passer ) { |
616
|
246
|
50
|
|
|
|
587
|
next unless defined $passer->[$pos]; |
617
|
246
|
|
|
|
|
291
|
my @pair = @{$passer->[$pos]}; |
|
246
|
|
|
|
|
582
|
|
618
|
246
|
100
|
|
|
|
432
|
my @score = map { defined $_->score? $_->score: 0 } @pair; |
|
492
|
|
|
|
|
1270
|
|
619
|
246
|
100
|
|
|
|
876
|
if ( $score[0] > $score[1] ) |
|
|
50
|
|
|
|
|
|
620
|
|
|
|
|
|
|
{ |
621
|
112
|
|
|
|
|
441
|
$pair[0]->floating('Down'); |
622
|
112
|
|
|
|
|
405
|
$pair[1]->floating('Up'); |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
elsif ( $score[0] == $score[1] ) |
625
|
|
|
|
|
|
|
{ |
626
|
134
|
|
|
|
|
217
|
map { $_->floating('Not') } @pair; |
|
268
|
|
|
|
|
727
|
|
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
else { |
629
|
0
|
|
|
|
|
0
|
$pair[0]->floating('Up'); |
630
|
0
|
|
|
|
|
0
|
$pair[1]->floating('Down'); |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
} |
633
|
192
|
|
|
|
|
665
|
my @nonpaired = $group->_getNonPaired(@$passer); |
634
|
192
|
|
|
|
|
401
|
my @paired = grep { defined } @$passer; |
|
246
|
|
|
|
|
688
|
|
635
|
192
|
50
|
|
|
|
559
|
if ( $#paired >= $pprime ) |
636
|
|
|
|
|
|
|
{ |
637
|
0
|
|
|
|
|
0
|
my @unrequired = @paired[ $pprime .. $#paired ]; |
638
|
0
|
|
|
|
|
0
|
splice @paired, $pprime; |
639
|
0
|
|
|
|
|
0
|
unshift @nonpaired, @unrequired; |
640
|
|
|
|
|
|
|
} |
641
|
192
|
|
|
|
|
372
|
@nonpaired = map { my $pair=$_; grep { defined } @$pair } @nonpaired; |
|
489
|
|
|
|
|
668
|
|
|
489
|
|
|
|
|
762
|
|
|
632
|
|
|
|
|
1515
|
|
642
|
192
|
|
|
|
|
497
|
my @tables = grep { defined $passer->[$_-1] } 1..@$passer; |
|
246
|
|
|
|
|
744
|
|
643
|
192
|
|
|
|
|
1114
|
$self->log( "$index-Bracket ($number) tables @tables paired. OK" ); |
644
|
192
|
100
|
|
|
|
853
|
$self->nonpaired(\@nonpaired) if @nonpaired; |
645
|
192
|
|
|
|
|
520
|
my $allMatches = $self->matches; |
646
|
192
|
50
|
|
|
|
983
|
my ($pairmessage, @matches) = $self->colors( paired => \@paired ) if @paired; |
647
|
192
|
|
|
|
|
686
|
$self->log( $pairmessage ); |
648
|
192
|
100
|
66
|
|
|
615
|
if ( $group->hetero and @nonpaired and $group->bigGroupXprime ) |
|
|
|
100
|
|
|
|
|
649
|
|
|
|
|
|
|
{ |
650
|
28
|
|
|
|
|
77
|
my $bigXprime = $group->bigGroupXprime; |
651
|
28
|
|
|
|
|
62
|
my $usedX = $group->{xdeduction}; |
652
|
28
|
|
|
|
|
40
|
my $remainingX = $bigXprime - $usedX; |
653
|
28
|
|
|
|
|
138
|
$self->log( |
654
|
|
|
|
|
|
|
"$usedX of $bigXprime X points used. $remainingX left for remainder group" ); |
655
|
|
|
|
|
|
|
} |
656
|
192
|
|
|
|
|
510
|
$allMatches->{$index} = \@matches; |
657
|
192
|
100
|
|
|
|
581
|
if (@paired) {if ( @nonpaired ) { return C6OTHERS } else { return NEXT } } |
|
192
|
50
|
|
|
|
428
|
|
|
148
|
|
|
|
|
1356
|
|
|
44
|
|
|
|
|
423
|
|
658
|
0
|
|
|
|
|
0
|
return ERROR, msg => "No paired in C6PAIRS"; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head2 c6others |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c6others($group, $matches) |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
After pairing players, if there are remaining players in a homogeneous group, float them down to the next score group and continue with C1 (NEXT). In a heterogeneous group, start at C2 with the remaining players, now a homogeneous remainder group. |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
=cut |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
sub c6others { |
671
|
148
|
|
|
148
|
1
|
234
|
my $self = shift; |
672
|
148
|
|
|
|
|
369
|
my $groups = $self->brackets; |
673
|
148
|
|
|
|
|
420
|
my $index = $self->thisBracket; |
674
|
148
|
|
|
|
|
315
|
my $group = $groups->{$index}; |
675
|
148
|
|
|
|
|
412
|
my $number = $group->number; |
676
|
148
|
|
|
|
|
354
|
my $nonpaired = $self->nonpaired; |
677
|
148
|
50
|
33
|
|
|
751
|
die "Unpaired players are: $nonpaired?" unless defined $nonpaired and |
678
|
|
|
|
|
|
|
@$nonpaired; |
679
|
148
|
|
|
|
|
394
|
my $islastBracket = ( $index eq $self->lastBracket ); |
680
|
148
|
100
|
100
|
|
|
485
|
unless ( $group->hetero and @$nonpaired > 1 or $islastBracket ) { |
681
|
60
|
|
|
|
|
162
|
my $next = $self->nextBracket; |
682
|
60
|
|
|
|
|
122
|
my $nextBracket = $groups->{$next}; |
683
|
60
|
|
|
|
|
188
|
my $nextNumber = $nextBracket->number; |
684
|
60
|
|
|
|
|
110
|
my @nextMembers = map {$_->pairingNumber} @{$nextBracket->members}; |
|
150
|
|
|
|
|
382
|
|
|
60
|
|
|
|
|
164
|
|
685
|
60
|
|
|
|
|
147
|
for my $evacuee (@$nonpaired) { |
686
|
61
|
|
|
|
|
208
|
$group->exit($evacuee); |
687
|
61
|
|
|
|
|
178
|
$evacuee->floating('Down'); |
688
|
61
|
|
|
|
|
185
|
$nextBracket->entry($evacuee); |
689
|
|
|
|
|
|
|
} |
690
|
60
|
|
|
|
|
126
|
my @floaters = map {$_->pairingNumber} @$nonpaired; |
|
61
|
|
|
|
|
170
|
|
691
|
60
|
|
|
|
|
109
|
my @pairIds = map {$_->pairingNumber} @{$group->members}; |
|
148
|
|
|
|
|
374
|
|
|
60
|
|
|
|
|
172
|
|
692
|
60
|
|
|
|
|
558
|
$self->log( |
693
|
|
|
|
|
|
|
"Floating remaining @floaters Down. [$number] @pairIds. @floaters => [$nextNumber] @nextMembers" ); |
694
|
60
|
|
|
|
|
294
|
return NEXT; |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
else { |
697
|
88
|
|
|
|
|
351
|
my $xprime = $group->bigGroupXprime; |
698
|
|
|
|
|
|
|
my $remainingX = $group->{xdeduction}? $xprime - $group->{xdeduction}: |
699
|
88
|
100
|
|
|
|
273
|
$xprime; |
700
|
88
|
|
|
|
|
361
|
my $remainderGroup = Games::Tournament::Swiss::Bracket->new( |
701
|
|
|
|
|
|
|
score => $group->score, |
702
|
|
|
|
|
|
|
remainderof => $group, |
703
|
|
|
|
|
|
|
number => "${number}'s Remainder Group", |
704
|
|
|
|
|
|
|
xprime => $remainingX, |
705
|
|
|
|
|
|
|
); |
706
|
|
|
|
|
|
|
# $group->{remainder} ||= $remainderGroup; |
707
|
88
|
|
|
|
|
202
|
$group->{remainder} = $remainderGroup; |
708
|
88
|
|
|
|
|
224
|
my $remaIndex = "${index}Remainder"; |
709
|
88
|
100
|
100
|
|
|
367
|
if ( $islastBracket and @$nonpaired == 1 ) { |
710
|
23
|
|
|
|
|
40
|
$remaIndex = "${index}Bye"; |
711
|
23
|
|
|
|
|
56
|
$remainderGroup->{number} = "${number}'s Bye"; |
712
|
|
|
|
|
|
|
} |
713
|
88
|
|
|
|
|
193
|
$groups->{$remaIndex} = $remainderGroup; |
714
|
88
|
|
|
|
|
329
|
my $remainderIndex = $self->nextBracket; |
715
|
88
|
|
|
|
|
167
|
my $remainder = $groups->{$remainderIndex}; |
716
|
88
|
|
|
|
|
252
|
my $remainderNumber = $remainder->number; |
717
|
88
|
|
|
|
|
195
|
for my $remainer (@$nonpaired) { |
718
|
256
|
|
|
|
|
669
|
$group->exit($remainer); |
719
|
|
|
|
|
|
|
# $remainder->entry($remainer); |
720
|
256
|
|
|
|
|
660
|
$remainderGroup->entry($remainer); |
721
|
|
|
|
|
|
|
} |
722
|
88
|
|
|
|
|
176
|
my @remains = map {$_->pairingNumber} @$nonpaired; |
|
256
|
|
|
|
|
737
|
|
723
|
88
|
|
|
|
|
246
|
my $members = $group->members; |
724
|
88
|
|
|
|
|
166
|
my @memberIds = map {$_->pairingNumber} @$members; |
|
198
|
|
|
|
|
463
|
|
725
|
88
|
|
|
|
|
152
|
my @next = map {$_->pairingNumber} @{$remainderGroup->members}; |
|
256
|
|
|
|
|
580
|
|
|
88
|
|
|
|
|
230
|
|
726
|
88
|
|
|
|
|
791
|
$self->log( "Remaindering @remains. |
727
|
|
|
|
|
|
|
[$number] @memberIds & [$remainderNumber] @next" ); |
728
|
88
|
100
|
|
|
|
287
|
$remainderGroup->{c10repaired} = 1 if $group->{c10repaired}; |
729
|
|
|
|
|
|
|
$remainderGroup->{lowfloaterlastshuffle} = 1 |
730
|
88
|
100
|
|
|
|
252
|
if $group->{lowfloaterlastshuffle}; |
731
|
88
|
100
|
|
|
|
281
|
$remainderGroup->{c11repaired} = 1 if $group->{c11repaired}; |
732
|
|
|
|
|
|
|
$remainderGroup->{lastheteroshuffle} = 1 |
733
|
88
|
100
|
|
|
|
210
|
if $group->{lastheteroshuffle}; |
734
|
88
|
|
|
|
|
250
|
$self->brackets($groups); |
735
|
88
|
100
|
|
|
|
224
|
if ( $islastBracket ) { |
736
|
43
|
|
|
|
|
224
|
return NEXT; |
737
|
|
|
|
|
|
|
} |
738
|
45
|
|
|
|
|
118
|
$self->thisBracket($remainderIndex); |
739
|
45
|
|
|
|
|
203
|
my ( $rejectionSlip, @rejections) = $self->rejectionTest(@$nonpaired); |
740
|
45
|
100
|
100
|
|
|
227
|
if ( @rejections and not @$nonpaired % 2 ) |
741
|
|
|
|
|
|
|
{ |
742
|
6
|
|
|
|
|
28
|
$self->log( |
743
|
|
|
|
|
|
|
"$rejectionSlip. $remainderIndex-Group [$remainderNumber] unpairable. Go C10" ); |
744
|
6
|
|
|
|
|
14
|
$remainderGroup->{lastshuffle} = 1; |
745
|
6
|
|
|
|
|
36
|
return C10; |
746
|
|
|
|
|
|
|
} |
747
|
39
|
|
|
|
|
216
|
else { return C2; } |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=head2 c7 |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
$next = $pairing->c7 |
755
|
|
|
|
|
|
|
while ( my @s2 = &$next ) |
756
|
|
|
|
|
|
|
{ |
757
|
|
|
|
|
|
|
create match cards unless this permutation is incompatible; |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Apply a new transposition of S2 according to D1 and restart at C6. But take precautions to prevent transposing players who are no longer in the bracket, when finding a different pairing, returning from C10,12,13. In particular, when returning from C10, stop when the last alternative pairing for the lowest downfloater has been tried. |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=cut |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
sub c7 { |
765
|
1414
|
|
|
1414
|
1
|
2046
|
my $self = shift; |
766
|
1414
|
|
|
|
|
3295
|
my $groups = $self->brackets; |
767
|
1414
|
|
|
|
|
3328
|
my $index = $self->thisBracket; |
768
|
1414
|
|
|
|
|
2654
|
my $group = $groups->{$index}; |
769
|
1414
|
|
|
|
|
4149
|
my $number = $group->number; |
770
|
1414
|
50
|
|
|
|
3803
|
if ( $self->{lowfloaterlastshuffle} ) |
771
|
|
|
|
|
|
|
{ |
772
|
0
|
|
|
|
|
0
|
$self->log("last C10 transposition in $index-Bracket [$number]"); |
773
|
0
|
|
|
|
|
0
|
return C10; |
774
|
|
|
|
|
|
|
} |
775
|
1414
|
|
|
|
|
3554
|
my $s1 = $group->s1; |
776
|
1414
|
|
|
|
|
3957
|
my $s2 = $group->s2; |
777
|
1414
|
|
|
|
|
3613
|
my $badpair = $group->badpair; |
778
|
1414
|
50
|
|
|
|
3087
|
$badpair = $#$s2 if not defined $badpair; |
779
|
1414
|
|
|
|
|
3928
|
my @newS2 = $group->c7shuffler($badpair); |
780
|
1414
|
100
|
|
|
|
3425
|
unless (@newS2) { |
781
|
461
|
|
|
|
|
2124
|
$self->log("last transposition in $index-Bracket [$number]"); |
782
|
461
|
|
|
|
|
1547
|
$group->resetS12; |
783
|
461
|
|
|
|
|
1009
|
$group->{lastshuffle} = 1; |
784
|
|
|
|
|
|
|
$group->{lastheteroshuffle} = 1 if ($group->hetero or |
785
|
461
|
100
|
66
|
|
|
1307
|
($group->{remainderof} and $group->{remainderof}->{lastheteroshuffle})); |
|
|
|
66
|
|
|
|
|
786
|
|
|
|
|
|
|
# return C11 if $group->{c11repaired}; |
787
|
|
|
|
|
|
|
# return C10 if $group->{c10repaired}; |
788
|
461
|
100
|
|
|
|
1357
|
return C8 unless $group->hetero; |
789
|
59
|
|
|
|
|
275
|
return C9; |
790
|
|
|
|
|
|
|
} |
791
|
953
|
|
|
|
|
2930
|
$group->s2( \@newS2 ); |
792
|
953
|
|
|
|
|
3996
|
$group->members( [ @$s1, @newS2 ] ); |
793
|
953
|
|
|
|
|
1663
|
my @newOrder = map { $_->pairingNumber } @newS2; |
|
2851
|
|
|
|
|
6844
|
|
794
|
953
|
|
|
|
|
5631
|
$self->log( " @newOrder"); |
795
|
953
|
|
|
|
|
2045
|
my $lastC10shuffle = $group->{lastC10Alternate}; |
796
|
953
|
100
|
66
|
|
|
3383
|
if ( $lastC10shuffle and ref $lastC10shuffle eq 'ARRAY' and @$lastC10shuffle |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
797
|
89
|
|
|
89
|
|
401
|
and all {$newOrder[$_] == $lastC10shuffle->[$_]} 0..$#$lastC10shuffle ) |
798
|
|
|
|
|
|
|
{ |
799
|
16
|
|
|
|
|
38
|
$group->{lowfloaterlastshuffle} = 1; |
800
|
|
|
|
|
|
|
} |
801
|
953
|
|
|
|
|
2622
|
$groups->{ $self->thisBracket } = $group; |
802
|
953
|
|
|
|
|
4586
|
return C6PAIRS; |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
=head2 c8 |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
$next = $pairing->c8 |
809
|
|
|
|
|
|
|
while ( my ($s1, $s2) = &$next ) |
810
|
|
|
|
|
|
|
{ |
811
|
|
|
|
|
|
|
create match cards unless this exchange is incompatible; |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
In case of a homogeneous (remainder) group: apply a new exchange between S1 and S2 according to D2. Restart at C5. |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=cut |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub c8 { |
819
|
402
|
|
|
402
|
1
|
643
|
my $self = shift; |
820
|
402
|
|
|
|
|
1060
|
my $groups = $self->brackets; |
821
|
402
|
|
|
|
|
1069
|
my $this = $self->thisBracket; |
822
|
402
|
|
|
|
|
796
|
my $group = $groups->{$this}; |
823
|
402
|
|
|
|
|
1258
|
my $number = $group->number; |
824
|
402
|
|
|
|
|
663
|
my $swapper; |
825
|
402
|
100
|
|
|
|
1164
|
if ( $group->c8swapper ) { |
826
|
348
|
|
|
|
|
885
|
$swapper = $group->c8swapper; |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
else { |
829
|
54
|
|
|
|
|
209
|
$swapper = $group->c8iterator; |
830
|
54
|
|
|
|
|
175
|
$group->c8swapper($swapper); |
831
|
|
|
|
|
|
|
} |
832
|
402
|
|
|
|
|
1087
|
my ($message, @newMembers) = &$swapper; |
833
|
402
|
|
|
|
|
2148
|
$self->log( "$message in $this-Bracket [$number]" ); |
834
|
402
|
100
|
|
|
|
1167
|
unless (@newMembers) { |
835
|
168
|
|
|
|
|
586
|
$swapper = $group->c8iterator; |
836
|
168
|
|
|
|
|
516
|
$group->c8swapper($swapper); |
837
|
168
|
|
|
|
|
1762
|
return C9; |
838
|
|
|
|
|
|
|
} |
839
|
234
|
|
|
|
|
728
|
my $p = $group->p; |
840
|
234
|
|
|
|
|
878
|
my @s1 = @newMembers[ 0 .. $p - 1 ]; |
841
|
234
|
|
|
|
|
698
|
my @s2 = @newMembers[ $p .. $#newMembers ]; |
842
|
234
|
|
|
|
|
749
|
$group->s1( \@s1 ); |
843
|
234
|
|
|
|
|
712
|
$group->s2( \@s2 ); |
844
|
234
|
|
|
|
|
479
|
$self->log( |
845
|
234
|
|
|
|
|
451
|
"@{[map { $_->pairingNumber } @s1]}, @{[map { $_->pairingNumber } @s2]}" ); |
|
514
|
|
|
|
|
1339
|
|
|
234
|
|
|
|
|
537
|
|
|
575
|
|
|
|
|
1379
|
|
846
|
234
|
|
|
|
|
815
|
$groups->{$this} = $group; |
847
|
234
|
|
|
|
|
459
|
$self->{brackets} = $groups; |
848
|
234
|
|
|
|
|
1037
|
return C5; |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=head2 c9 |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c9 |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
Drop, in order, criterion B6 (no identical float to 2 rounds before) and B5 (no identical float to previous round) for downfloats and restart at C4. |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=cut |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub c9 { |
861
|
227
|
|
|
227
|
1
|
352
|
my $self = shift; |
862
|
227
|
|
|
|
|
592
|
my $groups = $self->brackets; |
863
|
227
|
|
|
|
|
566
|
my $index = $self->thisBracket; |
864
|
227
|
|
|
|
|
458
|
my $group = $groups->{ $index }; |
865
|
227
|
|
|
|
|
606
|
my $number = $group->number; |
866
|
227
|
100
|
|
|
|
678
|
if ( $group->floatCheckWaive eq 'None' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
867
|
67
|
|
|
|
|
198
|
$group->floatCheckWaive('B6Down'); |
868
|
67
|
|
|
|
|
165
|
delete $group->{lastshuffle}; |
869
|
67
|
|
|
|
|
138
|
delete $group->{lastheteroshuffle}; |
870
|
67
|
|
|
|
|
340
|
$self->log( "No pairing with float checks on. Dropping B6 for Downfloats in $index-Bracket [$number]" ); |
871
|
67
|
|
|
|
|
231
|
return C4; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'B6Down' ) { |
874
|
61
|
|
|
|
|
174
|
$group->floatCheckWaive('B5Down'); |
875
|
61
|
|
|
|
|
133
|
delete $group->{lastshuffle}; |
876
|
61
|
|
|
|
|
122
|
delete $group->{lastheteroshuffle}; |
877
|
61
|
|
|
|
|
319
|
$self->log( "No pairing with B6 check off. Dropping B5 for Downfloats in $index-Bracket [$number]" ); |
878
|
61
|
|
|
|
|
206
|
return C4; |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'B5Down' ) { |
881
|
54
|
|
|
|
|
270
|
$self->log( |
882
|
|
|
|
|
|
|
"No pairing with all Downfloat checks dropped in $index-Bracket [$number]" ); |
883
|
54
|
|
|
|
|
222
|
return C10; |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'B6Up' ) { |
886
|
24
|
|
|
|
|
130
|
$self->log( |
887
|
|
|
|
|
|
|
"No pairing with all Downfloat checks dropped in $index-Bracket [$number]" ); |
888
|
24
|
|
|
|
|
91
|
return C10; |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'B5Up' ) { |
891
|
20
|
|
|
|
|
156
|
$self->log( |
892
|
|
|
|
|
|
|
"No pairing with all Downfloat checks dropped in $index-Bracket [$number]" ); |
893
|
20
|
|
|
|
|
73
|
return C10; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'All' ) { |
896
|
1
|
|
|
|
|
5
|
$group->floatCheckWaive('B6Down'); |
897
|
1
|
|
|
|
|
6
|
$self->log( "No Pairing with all Downfloat checks dropped. Pairing again with B6 dropped in $index-Bracket [$number]" ); |
898
|
1
|
|
|
|
|
4
|
return C4; |
899
|
|
|
|
|
|
|
} |
900
|
0
|
|
|
|
|
0
|
return ERROR, msg => "$index-Bracket [$number] fell through C9"; |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=head2 c10 |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c10 |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
In case of a homogeneous remainder group: undo the pairing of the lowest moved down player paired and try to find a different opponent for this player by restarting at C7. If no alternative pairing for this player exists then drop criterion B6 first and then B5 for upfloats and restart at C2 (C4 to avoid p, x resetting.) If we are in a C13 loop (check penultpPrime), avoid the C10 procedure. Why? |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
=cut |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
sub c10 { |
913
|
104
|
|
|
104
|
1
|
187
|
my $self = shift; |
914
|
104
|
|
|
|
|
271
|
my $brackets = $self->brackets; |
915
|
104
|
|
|
|
|
270
|
my $index = $self->thisBracket; |
916
|
104
|
|
|
|
|
216
|
my $group = $brackets->{ $index }; |
917
|
104
|
|
|
|
|
313
|
my $groupNumber = $group->number; |
918
|
104
|
|
|
|
|
384
|
my $lowFloat = $group->s1->[0]->pairingNumber; |
919
|
104
|
100
|
66
|
|
|
679
|
if ( $group->{c10repaired} and $group->{lowfloaterlastshuffle}) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
920
|
|
|
|
|
|
|
{ |
921
|
9
|
|
|
|
|
17
|
my ($heteroBracket, $heteroNumber, $heteroIndex); |
922
|
9
|
100
|
|
|
|
41
|
if ( $group->{remainderof} ) |
|
|
50
|
|
|
|
|
|
923
|
|
|
|
|
|
|
{ |
924
|
3
|
|
|
|
|
9
|
$heteroBracket = $group->{remainderof}; |
925
|
3
|
|
|
|
|
42
|
$heteroNumber = $heteroBracket->number; |
926
|
3
|
|
|
|
|
16
|
$heteroIndex = $self->index($heteroBracket); |
927
|
3
|
|
|
|
|
8
|
my $repairgroupRemainder = $group; |
928
|
3
|
|
|
|
|
11
|
my $lowest = $heteroBracket->s1->[0]; |
929
|
3
|
|
|
|
|
12
|
my $lowFloat = $lowest->pairingNumber; |
930
|
3
|
|
|
|
|
13
|
my $inadequateS2member = $heteroBracket->s2->[0]; |
931
|
3
|
|
|
|
|
13
|
my $partnerId = $inadequateS2member->pairingNumber; |
932
|
3
|
|
|
|
|
12
|
my $unpaired = $repairgroupRemainder->members; |
933
|
3
|
|
|
|
|
18
|
$repairgroupRemainder->exit($_) for @$unpaired; |
934
|
3
|
|
|
|
|
19
|
$_->floating('') for @$unpaired; |
935
|
3
|
|
|
|
|
16
|
$heteroBracket->entry($_) for @$unpaired; |
936
|
|
|
|
|
|
|
# $heteroBracket->floatCheckWaive('None'); |
937
|
|
|
|
|
|
|
# $heteroBracket->badpair(0); |
938
|
3
|
|
|
|
|
11
|
$self->thisBracket($heteroIndex); |
939
|
3
|
|
|
|
|
11
|
$repairgroupRemainder->dissolved(1); |
940
|
3
|
|
|
|
|
7
|
delete $repairgroupRemainder->{lowfloaterlastshuffle}; |
941
|
3
|
|
|
|
|
7
|
delete $heteroBracket->{lowfloaterlastshuffle}; |
942
|
3
|
|
|
|
|
23
|
$self->log( |
943
|
|
|
|
|
|
|
"Can't repair lowest downfloater, $lowFloat in $heteroIndex-Bracket [$heteroNumber]" ); |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
elsif ( $group->hetero ) { |
946
|
6
|
|
|
|
|
13
|
$heteroBracket = $group; |
947
|
6
|
|
|
|
|
11
|
$heteroNumber = $groupNumber; |
948
|
6
|
|
|
|
|
12
|
$heteroIndex = $index; |
949
|
6
|
|
|
|
|
15
|
delete $heteroBracket->{lowfloaterlastshuffle}; |
950
|
|
|
|
|
|
|
} |
951
|
9
|
100
|
100
|
|
|
37
|
if ( $heteroBracket->floatCheckWaive eq 'B5Up' ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
952
|
3
|
|
|
|
|
13
|
$heteroBracket->floatCheckWaive('All'); |
953
|
3
|
|
|
|
|
19
|
$self->log( |
954
|
|
|
|
|
|
|
"Float checks all dropped, but can't repair heterogeneous $index-Bracket [$groupNumber]. Go C11 " ); |
955
|
3
|
|
|
|
|
13
|
return C11; |
956
|
|
|
|
|
|
|
} |
957
|
|
|
|
|
|
|
elsif ( $heteroBracket->floatCheckWaive eq 'B6Down' or |
958
|
|
|
|
|
|
|
$heteroBracket->floatCheckWaive eq 'B5Down' ) { |
959
|
3
|
|
|
|
|
14
|
$heteroBracket->floatCheckWaive('B6Up'); |
960
|
3
|
|
|
|
|
22
|
$self->log( |
961
|
|
|
|
|
|
|
"Dropping B6 for Upfloats in $heteroIndex-Bracket [$heteroNumber]"); |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
elsif ( $heteroBracket->floatCheckWaive eq 'B6Up' ) { |
964
|
3
|
|
|
|
|
10
|
$heteroBracket->floatCheckWaive('B5Up'); |
965
|
3
|
|
|
|
|
19
|
$self->log( |
966
|
|
|
|
|
|
|
"Dropping B5 for Upfloats in $heteroIndex-Bracket [$heteroNumber]"); |
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
$self->log( |
969
|
6
|
|
|
|
|
34
|
"Repairing whole of $heteroIndex-Bracket [$heteroNumber]" ); |
970
|
6
|
|
|
|
|
24
|
return C4; |
971
|
|
|
|
|
|
|
} |
972
|
|
|
|
|
|
|
elsif ( $group->{remainderof} ) { |
973
|
32
|
100
|
66
|
|
|
171
|
if ( $group->{remainderof}->{c11repaired} or |
974
|
|
|
|
|
|
|
$group->{remainderof}->{c12repaired} ) |
975
|
|
|
|
|
|
|
{ |
976
|
17
|
|
|
|
|
86
|
$self->log( "Passing $index-Bracket [$groupNumber] to C11." ); |
977
|
17
|
|
|
|
|
65
|
return C11; |
978
|
|
|
|
|
|
|
} |
979
|
15
|
|
|
|
|
53
|
my $remaindered = $group->members; |
980
|
15
|
|
|
|
|
38
|
my @remaindered = map {$_->pairingNumber} @$remaindered; |
|
51
|
|
|
|
|
125
|
|
981
|
15
|
|
|
|
|
32
|
my $heteroBracket = $group->{remainderof}; |
982
|
15
|
|
|
|
|
83
|
my $index = $self->index($heteroBracket); |
983
|
15
|
|
|
|
|
46
|
my $number = $heteroBracket->number; |
984
|
15
|
|
|
|
|
31
|
my @ids = map { $_->pairingNumber } @{ $heteroBracket->members }; |
|
30
|
|
|
|
|
93
|
|
|
15
|
|
|
|
|
43
|
|
985
|
15
|
|
|
|
|
132
|
$self->log( |
986
|
|
|
|
|
|
|
"Pairing of @ids in $index-Bracket [$number] failed pairing @remaindered in remainder group." ); |
987
|
15
|
|
|
|
|
52
|
my $matches = delete $self->matches->{$index}; |
988
|
15
|
|
|
|
|
57
|
$group->dissolved(1); |
989
|
|
|
|
|
|
|
# $heteroBracket->floatCheckWaive('None'); |
990
|
15
|
|
|
|
|
37
|
$self->thisBracket( $index ); |
991
|
15
|
|
|
|
|
75
|
$group->exit($_) for @$remaindered; |
992
|
15
|
|
|
|
|
76
|
$_->floating('') for @$remaindered; |
993
|
15
|
|
|
|
|
66
|
$heteroBracket->entry($_) for @$remaindered; |
994
|
15
|
100
|
|
|
|
89
|
if ( not $heteroBracket->{c10repaired} ) |
|
|
50
|
|
|
|
|
|
995
|
|
|
|
|
|
|
{ |
996
|
3
|
|
|
|
|
8
|
$heteroBracket->{c10repaired} = 1; |
997
|
3
|
|
|
|
|
18
|
my $s1 = $heteroBracket->s1; |
998
|
3
|
|
|
|
|
10
|
my $s2 = $heteroBracket->s2; |
999
|
3
|
|
|
|
|
13
|
my @wellpairedS2 = map { $s2->[$_] } 0..$#$s1-1; |
|
0
|
|
|
|
|
0
|
|
1000
|
3
|
|
|
|
|
9
|
my @unpairedS2 = map { $s2->[$_] } $#$s1+1..$#$s2; |
|
11
|
|
|
|
|
24
|
|
1001
|
3
|
|
|
|
|
14
|
my $lastShufflePossibility = ( $self->rank(@unpairedS2) )[-1]; |
1002
|
3
|
|
|
|
|
983
|
my @lastIds = map { $_->pairingNumber } |
|
3
|
|
|
|
|
13
|
|
1003
|
|
|
|
|
|
|
@wellpairedS2, $lastShufflePossibility; |
1004
|
3
|
|
|
|
|
15
|
$heteroBracket->{lastC10Alternate} = \@lastIds; |
1005
|
3
|
|
|
|
|
7
|
my $lowest = $s1->[-1]; |
1006
|
3
|
|
|
|
|
11
|
my $id = $lowest->pairingNumber; |
1007
|
3
|
|
|
|
|
9
|
my $match = $matches->[-1]; |
1008
|
3
|
|
|
|
|
27
|
my $partner = $lowest->myOpponent($match); |
1009
|
3
|
|
|
|
|
11
|
my $partnerId = $partner->pairingNumber; |
1010
|
3
|
|
|
|
|
35
|
$self->log( |
1011
|
|
|
|
|
|
|
"Unpairing lowest downfloater, $id and $partnerId in $index-Bracket [$number] |
1012
|
|
|
|
|
|
|
Returning @remaindered to $index-Bracket [$number] |
1013
|
|
|
|
|
|
|
Trying different partner for $id in $index-Bracket [$number]"); |
1014
|
3
|
|
|
|
|
40
|
return C7; |
1015
|
|
|
|
|
|
|
} |
1016
|
|
|
|
|
|
|
elsif ( $group->{lastshuffle} ) { |
1017
|
12
|
|
|
|
|
61
|
$self->log("Trying next pairing in $index-Bracket [$number]"); |
1018
|
12
|
|
|
|
|
113
|
return C7; |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
} |
1021
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'B5Down' ) { |
1022
|
25
|
|
|
|
|
73
|
$group->floatCheckWaive('B6Up'); |
1023
|
25
|
|
|
|
|
134
|
$self->log( |
1024
|
|
|
|
|
|
|
"No more pairings. Dropping B6 for Upfloats in $index-Bracket [$groupNumber]"); |
1025
|
25
|
|
|
|
|
88
|
return C4; |
1026
|
|
|
|
|
|
|
} |
1027
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'B6Up' ) { |
1028
|
21
|
|
|
|
|
70
|
$group->floatCheckWaive('B5Up'); |
1029
|
21
|
|
|
|
|
104
|
$self->log( |
1030
|
|
|
|
|
|
|
"No more pairings. Dropping B5 for Upfloats in $index-Bracket [$groupNumber]"); |
1031
|
21
|
|
|
|
|
71
|
return C4; |
1032
|
|
|
|
|
|
|
} |
1033
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'B5Up' ) { |
1034
|
17
|
|
|
|
|
50
|
$group->floatCheckWaive('All'); |
1035
|
17
|
|
|
|
|
97
|
$self->log("Float checks all dropped in $index-Bracket [$groupNumber]"); |
1036
|
17
|
|
|
|
|
64
|
return C11; |
1037
|
|
|
|
|
|
|
} |
1038
|
|
|
|
|
|
|
elsif ( $group->floatCheckWaive eq 'All' ) { |
1039
|
0
|
|
|
|
|
0
|
$group->floatCheckWaive('None'); |
1040
|
0
|
|
|
|
|
0
|
$self->log("Float checks already off in $index-Bracket [$groupNumber]"); |
1041
|
0
|
|
|
|
|
0
|
return C11; |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
#elsif ( $group->{lastshuffle} ) { |
1044
|
|
|
|
|
|
|
# $self->log( |
1045
|
|
|
|
|
|
|
# "Repairing of whole $index-Bracket [$groupNumber] failed. Go C11" ); |
1046
|
|
|
|
|
|
|
# return C11; |
1047
|
|
|
|
|
|
|
#} |
1048
|
0
|
|
|
|
|
0
|
return ERROR, msg => "$index-Bracket [$groupNumber] fell through C10"; |
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=head2 c11 |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c11 |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
As long as x (xprime) is less than p: increase it by 1. When pairing a remainder group undo all pairings of players moved down also. Restart at C3. (We were restarting at C7 after resetting the C7shuffler (Why?) We restart at C4 (to avoid resetting p) the 1st time, and C7 after that). |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=cut |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
sub c11 { |
1061
|
37
|
|
|
37
|
1
|
78
|
my $self = shift; |
1062
|
37
|
|
|
|
|
111
|
my $brackets = $self->brackets; |
1063
|
37
|
|
|
|
|
103
|
my $index = $self->thisBracket; |
1064
|
37
|
|
|
|
|
85
|
my $group = $brackets->{ $index }; |
1065
|
37
|
|
|
|
|
120
|
my $number = $group->number; |
1066
|
37
|
|
|
|
|
58
|
my ($heteroBracket, @remaindered); |
1067
|
37
|
|
|
|
|
113
|
my $xprime = $group->xprime; |
1068
|
37
|
|
|
|
|
150
|
my $pprime = $group->pprime; |
1069
|
37
|
|
|
|
|
143
|
my $bigGroupXprime = $group->bigGroupXprime; |
1070
|
37
|
|
|
|
|
130
|
my $bigGroupPprime = $group->bigGroupPprime; |
1071
|
37
|
100
|
66
|
|
|
304
|
if ( $group->{c11repaired} and $group->{lastheteroshuffle} ) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
{ |
1073
|
2
|
50
|
|
|
|
10
|
if ( $heteroBracket = $group->{remainderof} ) |
|
|
0
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
{ |
1075
|
2
|
|
|
|
|
7
|
my $remaindered = $group->members; |
1076
|
2
|
|
|
|
|
6
|
@remaindered = map { $_->pairingNumber } @$remaindered; |
|
8
|
|
|
|
|
21
|
|
1077
|
2
|
|
|
|
|
13
|
$group->exit($_) for @$remaindered; |
1078
|
2
|
|
|
|
|
13
|
$_->floating('') for @$remaindered; |
1079
|
2
|
|
|
|
|
12
|
$heteroBracket->entry($_) for @$remaindered; |
1080
|
2
|
|
|
|
|
6
|
delete $group->{lastheteroshuffle}; |
1081
|
2
|
|
|
|
|
8
|
$group->dissolved(1); |
1082
|
|
|
|
|
|
|
} |
1083
|
0
|
|
|
|
|
0
|
elsif ( $group->hetero ) { $heteroBracket = $group; } |
1084
|
2
|
|
|
|
|
10
|
my $heteroIndex = $self->index($heteroBracket); |
1085
|
2
|
|
|
|
|
9
|
$self->thisBracket( $heteroIndex ); |
1086
|
2
|
|
|
|
|
9
|
my $heteroNumber = $heteroBracket->number; |
1087
|
2
|
|
|
|
|
8
|
my $heteroMembers = $heteroBracket->members; |
1088
|
2
|
|
|
|
|
6
|
my @heteroIds = map { $_->pairingNumber } @$heteroMembers; |
|
12
|
|
|
|
|
29
|
|
1089
|
2
|
|
|
|
|
7
|
$heteroIndex = $self->index($heteroBracket); |
1090
|
2
|
|
|
|
|
16
|
$self->log( |
1091
|
|
|
|
|
|
|
"Repairing of $heteroIndex-Bracket [$heteroNumber] failed. No more pairings with X=$bigGroupXprime" ); |
1092
|
2
|
|
|
|
|
5
|
delete $heteroBracket->{lastheteroshuffle}; |
1093
|
2
|
50
|
|
|
|
10
|
if ( $bigGroupXprime < $bigGroupPprime ) { |
1094
|
2
|
|
|
|
|
9
|
$heteroBracket->bigGroupXprime(++$bigGroupXprime); |
1095
|
2
|
|
|
|
|
7
|
$heteroBracket->{c8swapper} = $heteroBracket->c8iterator; |
1096
|
2
|
|
|
|
|
11
|
$heteroBracket->floatCheckWaive('None'); |
1097
|
2
|
|
|
|
|
15
|
$self->log( |
1098
|
|
|
|
|
|
|
"Retrying with X=$bigGroupXprime. All float checks on in $heteroIndex-Bracket [$heteroNumber]" ); |
1099
|
2
|
|
|
|
|
11
|
return C4; |
1100
|
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
else { |
1102
|
0
|
|
|
|
|
0
|
$self->log( |
1103
|
|
|
|
|
|
|
"X=P=$bigGroupPprime, no more X increases in $index-Bracket [$number]. |
1104
|
|
|
|
|
|
|
Giving up on C11 Repair. Go C12"); |
1105
|
0
|
|
|
|
|
0
|
return C12; |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
} |
1108
|
|
|
|
|
|
|
elsif ( $group->{c10repaired} ) { |
1109
|
3
|
|
|
|
|
11
|
my $matches = $self->matches->{$index}; |
1110
|
3
|
50
|
|
|
|
11
|
delete $self->matches->{$index} if $matches; |
1111
|
3
|
|
|
|
|
17
|
$self->log( "Deleting all matches in $index-Bracket [$number]"); |
1112
|
3
|
|
|
|
|
11
|
my $members = $group->members; |
1113
|
3
|
|
|
|
|
8
|
my @ids = map {$_->pairingNumber} @$members; |
|
17
|
|
|
|
|
42
|
|
1114
|
3
|
|
|
|
|
19
|
$group->bigGroupXprime(++$bigGroupXprime); |
1115
|
3
|
|
|
|
|
11
|
$group->xprime(++$xprime); |
1116
|
3
|
|
|
|
|
8
|
$group->{c10repaired} = 0; |
1117
|
3
|
|
|
|
|
7
|
$group->{lastshuffle} = 0; |
1118
|
3
|
|
|
|
|
6
|
delete $group->{lastheteroshuffle}; |
1119
|
3
|
|
|
|
|
9
|
$group->{c11repaired} = 1; |
1120
|
3
|
|
|
|
|
13
|
$group->floatCheckWaive('None'); |
1121
|
3
|
50
|
|
|
|
15
|
my $message = $group->{remainder}? "X=$bigGroupXprime": "x=$xprime"; |
1122
|
3
|
|
|
|
|
24
|
$self->log( |
1123
|
|
|
|
|
|
|
"Bracket ${number}'s C11 Repairing: @ids, with $message" ); |
1124
|
3
|
|
|
|
|
14
|
return C4; |
1125
|
|
|
|
|
|
|
} |
1126
|
|
|
|
|
|
|
elsif ( $group->{remainderof} ) |
1127
|
|
|
|
|
|
|
{ |
1128
|
15
|
50
|
|
|
|
66
|
if ( $group->{remainderof}->{c12repaired} ) |
|
|
50
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
{ |
1130
|
0
|
|
|
|
|
0
|
$self->log( "Passing to C12." ); |
1131
|
0
|
|
|
|
|
0
|
return ERROR, msg => "$number($index) shouldn't pass this way"; |
1132
|
0
|
|
|
|
|
0
|
return C12; |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
elsif ( $group->{c11repaired} ) |
1135
|
|
|
|
|
|
|
{ |
1136
|
15
|
|
|
|
|
76
|
$heteroBracket = $group->{remainderof}; |
1137
|
15
|
|
|
|
|
47
|
my $remaindered = $group->members; |
1138
|
15
|
|
|
|
|
34
|
my @remaindered = map { $_->pairingNumber } @$remaindered; |
|
57
|
|
|
|
|
129
|
|
1139
|
15
|
|
|
|
|
44
|
my $heteroNumber = $heteroBracket->number; |
1140
|
15
|
|
|
|
|
51
|
my $heteroIndex = $self->previousBracket; |
1141
|
15
|
|
|
|
|
54
|
my $heteroMembers = $heteroBracket->members; |
1142
|
15
|
|
|
|
|
33
|
my @heteroIds = map { $_->pairingNumber } @$heteroMembers; |
|
30
|
|
|
|
|
81
|
|
1143
|
|
|
|
|
|
|
# $heteroBracket->bigGroupXprime(++$bigGroupXprime); |
1144
|
15
|
|
|
|
|
1068
|
$self->log( |
1145
|
|
|
|
|
|
|
"Repairing of @heteroIds in $heteroIndex-Bracket [$heteroNumber] failed pairing @remaindered. Trying next pairing with X=$bigGroupXprime" ); |
1146
|
15
|
|
|
|
|
74
|
$group->exit($_) for @$remaindered; |
1147
|
15
|
|
|
|
|
323
|
$_->floating('') for @$remaindered; |
1148
|
15
|
|
|
|
|
61
|
$heteroBracket->entry($_) for @$remaindered; |
1149
|
15
|
|
|
|
|
45
|
$group->dissolved(1); |
1150
|
15
|
|
|
|
|
40
|
$self->thisBracket( $heteroIndex ); |
1151
|
15
|
|
|
|
|
84
|
return C7; |
1152
|
|
|
|
|
|
|
} |
1153
|
|
|
|
|
|
|
} |
1154
|
|
|
|
|
|
|
elsif ( $xprime < $pprime ) { |
1155
|
13
|
|
|
|
|
59
|
$group->xprime(++$xprime); |
1156
|
13
|
|
|
|
|
65
|
$self->log( "x=$xprime" ); |
1157
|
13
|
50
|
|
|
|
61
|
if ( $group->{remainder} ) |
1158
|
|
|
|
|
|
|
{ |
1159
|
0
|
|
|
|
|
0
|
$heteroBracket = $group; |
1160
|
0
|
|
|
|
|
0
|
delete $self->matches->{$index}; |
1161
|
0
|
|
|
|
|
0
|
$self->log("Undoing all hetero $index-Bracket [$number] matches."); |
1162
|
0
|
|
|
|
|
0
|
$self->log( "All float checks on in $index-Bracket [$number]" ); |
1163
|
0
|
|
|
|
|
0
|
$heteroBracket->floatCheckWaive('None'); |
1164
|
0
|
|
|
|
|
0
|
$heteroBracket->resetShuffler; |
1165
|
0
|
|
|
|
|
0
|
return C7; |
1166
|
|
|
|
|
|
|
} |
1167
|
|
|
|
|
|
|
else { |
1168
|
13
|
|
|
|
|
52
|
$group->{c8swapper} = $group->c8iterator; |
1169
|
13
|
|
|
|
|
116
|
$group->floatCheckWaive('None'); |
1170
|
13
|
|
|
|
|
83
|
$self->log( "All float checks on in $index-Bracket [$number]" ); |
1171
|
13
|
|
|
|
|
378
|
return C4; |
1172
|
|
|
|
|
|
|
} |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
else { |
1175
|
4
|
|
|
|
|
26
|
$self->log( |
1176
|
|
|
|
|
|
|
"x=p=$bigGroupPprime, no more x increases in $index-Bracket [$number]" ); |
1177
|
4
|
|
|
|
|
16
|
return C12; |
1178
|
|
|
|
|
|
|
} |
1179
|
0
|
|
|
|
|
0
|
return ERROR, msg => "$number($index) fell through C11", pairing => $self; |
1180
|
|
|
|
|
|
|
} |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
=head2 c12 |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c12 |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
If the group contains a player who cannot be paired without violating B1 or B2 and this is a heterogeneous group, undo the pairing of the previous score bracket. If in this previous score bracket a pairing can be made whereby another player will be moved down to the current one, and this now allows p pairing to be made then this pairing in the previous score bracket will be accepted. (If there was only one (or two) players in the previous score bracket, obviously (heh-heh) there is no use going back and trying to find another pairing). Using a c12repaired flag to tell if this is the 2nd time through (but what if this is a backtrack to a different bracket?). |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
=cut |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
sub c12 { |
1192
|
4
|
|
|
4
|
1
|
7
|
my $self = shift; |
1193
|
4
|
|
|
|
|
13
|
my $brackets = $self->brackets; |
1194
|
4
|
|
|
|
|
13
|
my $index = $self->thisBracket; |
1195
|
4
|
|
|
|
|
12
|
my $group = $brackets->{$index}; |
1196
|
4
|
|
|
|
|
13
|
my $number = $group->number; |
1197
|
4
|
|
|
|
|
12
|
my $first = $self->firstBracket; |
1198
|
4
|
100
|
|
|
|
16
|
if ( $index eq $first ) |
1199
|
|
|
|
|
|
|
{ |
1200
|
1
|
|
|
|
|
6
|
$self->log( "No C12 repair from first $index-Bracket [$number]" ); |
1201
|
1
|
|
|
|
|
4
|
return C13; |
1202
|
|
|
|
|
|
|
} |
1203
|
3
|
|
|
|
|
10
|
my $prevIndex = $self->previousBracket; |
1204
|
3
|
|
|
|
|
7
|
my $previous = $brackets->{$prevIndex}; |
1205
|
3
|
|
|
|
|
9
|
my $prevNumber = $previous->number; |
1206
|
3
|
|
|
|
|
10
|
my $previousMembers = $previous->members; |
1207
|
3
|
100
|
66
|
|
|
27
|
if ( $group->{c12repaired} or $previous->{c12repaired} ) |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
{ |
1209
|
2
|
|
|
|
|
14
|
$self->log( |
1210
|
|
|
|
|
|
|
"Repairing of $prevIndex-Bracket [$prevNumber] failed to pair $index [$number]. Go to C13"); |
1211
|
2
|
|
|
|
|
8
|
return C13; |
1212
|
|
|
|
|
|
|
} |
1213
|
|
|
|
|
|
|
elsif ( $group->{c11repaired} ) |
1214
|
|
|
|
|
|
|
{ |
1215
|
0
|
0
|
|
|
|
0
|
if (not $previous->{c12repaired}) { |
1216
|
0
|
|
|
|
|
0
|
my @downfloaters = $group->downFloaters; |
1217
|
0
|
|
|
|
|
0
|
my @floatIds = map { $_->pairingNumber } @downfloaters; |
|
0
|
|
|
|
|
0
|
|
1218
|
0
|
|
|
|
|
0
|
my $score = $previous->score; |
1219
|
0
|
|
|
|
|
0
|
my $matches = $self->matches->{$prevIndex}; |
1220
|
0
|
0
|
|
|
|
0
|
delete $self->matches->{$prevIndex} if $matches; |
1221
|
0
|
|
|
|
|
0
|
$self->log( |
1222
|
|
|
|
|
|
|
"Deleting matches in $prevIndex-Bracket [$prevNumber], home of @floatIds"); |
1223
|
0
|
|
|
|
|
0
|
my $paired = $previous->members; |
1224
|
0
|
|
|
|
|
0
|
my @ids = map {$_->pairingNumber} @downfloaters, @$paired; |
|
0
|
|
|
|
|
0
|
|
1225
|
0
|
|
|
|
|
0
|
$self->log( |
1226
|
|
|
|
|
|
|
"$prevIndex-Bracket [$prevNumber] C12 Repairing: @ids"); |
1227
|
0
|
|
|
|
|
0
|
$group->exit($_) for @downfloaters; |
1228
|
0
|
|
|
|
|
0
|
$_->floating('') for @downfloaters; |
1229
|
0
|
|
|
|
|
0
|
$previous->entry($_) for @downfloaters; |
1230
|
0
|
|
|
|
|
0
|
$previous->{c12repaired} = 1; |
1231
|
0
|
|
|
|
|
0
|
$previous->floatCheckWaive('None'); |
1232
|
0
|
|
|
|
|
0
|
$previous->{c8swapper} = $previous->c8iterator; |
1233
|
0
|
|
|
|
|
0
|
$previous->resetS12; |
1234
|
0
|
|
|
|
|
0
|
my $s2 = $previous->s2; |
1235
|
0
|
|
|
|
|
0
|
$self->thisBracket($prevIndex); |
1236
|
0
|
|
|
|
|
0
|
return C7; |
1237
|
|
|
|
|
|
|
} |
1238
|
|
|
|
|
|
|
} |
1239
|
|
|
|
|
|
|
elsif ( $group->{remainderof} and $group->{remainderof}->{c12repaired} ) |
1240
|
|
|
|
|
|
|
{ |
1241
|
0
|
|
|
|
|
0
|
my $repairGroupIndex = $self->previousBracket; |
1242
|
0
|
|
|
|
|
0
|
my $heteroBracket = $group->{remainderof}; |
1243
|
0
|
|
|
|
|
0
|
my $repairGroupNumber = $heteroBracket->number; |
1244
|
0
|
|
|
|
|
0
|
my $c11RepairRemainder = $group; |
1245
|
0
|
|
|
|
|
0
|
$self->log( "No repairings in $repairGroupNumber. Go to C13." ); |
1246
|
0
|
|
|
|
|
0
|
return C13; |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
elsif ( $group->{remainderof} and $group->{remainderof}->{c11repaired} ) |
1249
|
|
|
|
|
|
|
{ |
1250
|
0
|
|
|
|
|
0
|
my $c11Remainder = $group; |
1251
|
0
|
|
|
|
|
0
|
my $c11RepairIndex = $prevIndex; |
1252
|
0
|
|
|
|
|
0
|
my $c11RepairGroup = $previous; |
1253
|
0
|
|
|
|
|
0
|
my $c11RepairNumber = $prevNumber; |
1254
|
0
|
|
|
|
|
0
|
my $paired = $previousMembers; |
1255
|
0
|
|
|
|
|
0
|
my $score = $c11RepairGroup->score; |
1256
|
0
|
|
|
|
|
0
|
my @ids = map {$_->pairingNumber} @$paired; |
|
0
|
|
|
|
|
0
|
|
1257
|
0
|
|
|
|
|
0
|
my $matches = $self->matches; |
1258
|
0
|
|
|
|
|
0
|
delete $matches->{ $c11RepairIndex }; |
1259
|
0
|
0
|
|
|
|
0
|
delete $matches->{$c11Remainder} if $matches->{$c11Remainder}; |
1260
|
0
|
|
|
|
|
0
|
$self->log( |
1261
|
|
|
|
|
|
|
"Undoing Bracket $c11RepairIndex-Bracket ($c11RepairNumber) pairs, @ids."); |
1262
|
0
|
|
|
|
|
0
|
$self->thisBracket($c11RepairIndex); |
1263
|
0
|
|
|
|
|
0
|
my $remainderMembers = $c11Remainder->members; |
1264
|
0
|
|
|
|
|
0
|
$c11Remainder->exit($_) for @$remainderMembers; |
1265
|
0
|
|
|
|
|
0
|
$_->floating('') for @$remainderMembers; |
1266
|
0
|
|
|
|
|
0
|
$c11RepairGroup->entry($_) for @$remainderMembers; |
1267
|
0
|
|
|
|
|
0
|
$c11Remainder->dissolved(1); |
1268
|
0
|
|
|
|
|
0
|
$self->log( "Dissolving $c11RepairIndex-Bracket's Remainder Group" ); |
1269
|
0
|
|
|
|
|
0
|
my $newPrevIndex = $self->previousBracket; |
1270
|
0
|
|
|
|
|
0
|
my $bracketAbove = $brackets->{$newPrevIndex}; |
1271
|
0
|
|
|
|
|
0
|
my $aboveNumber = $bracketAbove->number; |
1272
|
0
|
0
|
0
|
|
|
0
|
if ( $bracketAbove and $bracketAbove->hetero ) |
|
|
0
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
{ |
1274
|
0
|
|
|
|
|
0
|
my $key = $score . "C12Repair"; |
1275
|
0
|
|
|
|
|
0
|
my $c12RepairGroup = Games::Tournament::Swiss::Bracket->new( |
1276
|
|
|
|
|
|
|
score => $score, |
1277
|
|
|
|
|
|
|
c12repaired => 1, |
1278
|
|
|
|
|
|
|
c12down => $c11RepairGroup, |
1279
|
|
|
|
|
|
|
number => "$aboveNumber(post-C12)" |
1280
|
|
|
|
|
|
|
); |
1281
|
0
|
|
|
|
|
0
|
my @downfloaters = $c11RepairGroup->downFloaters; |
1282
|
0
|
|
|
|
|
0
|
$c11RepairGroup->exit($_) for @downfloaters; |
1283
|
0
|
|
|
|
|
0
|
$_->floating('') for @downfloaters; |
1284
|
0
|
|
|
|
|
0
|
$c12RepairGroup->entry($_) for @downfloaters; |
1285
|
0
|
|
|
|
|
0
|
$c11RepairGroup->{c12up} = $c12RepairGroup; |
1286
|
0
|
|
|
|
|
0
|
my @floatIds = map {$_->pairingNumber} @downfloaters; |
|
0
|
|
|
|
|
0
|
|
1287
|
0
|
|
|
|
|
0
|
my @prevIds = map {$_->pairingNumber} @{$c12RepairGroup->members}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1288
|
0
|
|
|
|
|
0
|
my @thisIds = map {$_->pairingNumber} @{$group->members}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1289
|
0
|
|
|
|
|
0
|
$self->log("C12 Repairing of previous $newPrevIndex-Bracket"); |
1290
|
0
|
|
|
|
|
0
|
$self->log(qq/Unfloating @floatIds back from $number ($index). /); |
1291
|
0
|
|
|
|
|
0
|
$self->log( |
1292
|
|
|
|
|
|
|
"$index-Bracket [$number]: @thisIds & [$prevNumber]: @prevIds"); |
1293
|
0
|
|
|
|
|
0
|
$bracketAbove->dissolved(1); |
1294
|
0
|
|
|
|
|
0
|
$c12RepairGroup->floatCheckWaive('None'); |
1295
|
0
|
|
|
|
|
0
|
$c12RepairGroup->{c8swapper} = $c12RepairGroup->c8iterator; |
1296
|
0
|
|
|
|
|
0
|
$c12RepairGroup->resetS12; |
1297
|
0
|
|
|
|
|
0
|
$brackets->{$key} = $c12RepairGroup; |
1298
|
0
|
|
|
|
|
0
|
$self->thisBracket($key); |
1299
|
0
|
|
|
|
|
0
|
return C7; |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
elsif ( not $bracketAbove->hetero ) { |
1302
|
0
|
|
|
|
|
0
|
$self->log( |
1303
|
|
|
|
|
|
|
"No C11 OR C12 repairings of $c11RepairIndex-Bracket ($c11RepairNumber)"); |
1304
|
0
|
|
|
|
|
0
|
return C13; |
1305
|
|
|
|
|
|
|
} |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
elsif ( $group->hetero ) |
1308
|
|
|
|
|
|
|
{ |
1309
|
1
|
|
|
|
|
5
|
my @downfloaters = $group->downFloaters; |
1310
|
1
|
|
|
|
|
2
|
my $floaterSourceIndex = $prevIndex; |
1311
|
1
|
|
|
|
|
2
|
my $floaterSource = $previous; |
1312
|
1
|
|
|
|
|
2
|
my $floaterSourceNumber = $prevNumber; |
1313
|
1
|
|
|
|
|
3
|
my $paired = $floaterSource->members; |
1314
|
1
|
|
|
|
|
5
|
my $score = $floaterSource->score; |
1315
|
1
|
|
|
|
|
2
|
my @ids = map {$_->pairingNumber} @$paired; |
|
2
|
|
|
|
|
7
|
|
1316
|
1
|
|
|
|
|
4
|
my $matches = $self->matches; |
1317
|
1
|
|
|
|
|
6
|
delete $matches->{ $prevIndex }; |
1318
|
1
|
|
|
|
|
8
|
$self->log( |
1319
|
|
|
|
|
|
|
"Undoing Bracket $floaterSourceNumber($floaterSourceIndex) pairs, @ids."); |
1320
|
1
|
|
|
|
|
3
|
my $key = $score . "C12Repair"; |
1321
|
1
|
|
|
|
|
6
|
my $c12RepairGroup = Games::Tournament::Swiss::Bracket->new( |
1322
|
|
|
|
|
|
|
score => $score, |
1323
|
|
|
|
|
|
|
c12repaired => 1, |
1324
|
|
|
|
|
|
|
c12down => $group, |
1325
|
|
|
|
|
|
|
number => "$floaterSourceNumber(post-C12)" |
1326
|
|
|
|
|
|
|
); |
1327
|
1
|
|
|
|
|
5
|
$group->exit($_) for @downfloaters; |
1328
|
1
|
|
|
|
|
3
|
$group->c8swapper(''); |
1329
|
1
|
|
|
|
|
14
|
$floaterSource->exit($_) for @$paired; |
1330
|
1
|
|
|
|
|
5
|
$_->floating('') for @downfloaters; |
1331
|
1
|
|
|
|
|
5
|
$c12RepairGroup->entry($_) for @downfloaters, @$paired; |
1332
|
1
|
|
|
|
|
3
|
$floaterSource->{c12repair} = $c12RepairGroup; |
1333
|
1
|
|
|
|
|
2
|
$group->{c12up} = $c12RepairGroup; |
1334
|
1
|
|
|
|
|
2
|
my @floatIds = map {$_->pairingNumber} @downfloaters; |
|
1
|
|
|
|
|
4
|
|
1335
|
1
|
|
|
|
|
7
|
my @prevIds = map {$_->pairingNumber} @{$c12RepairGroup->members}; |
|
3
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
4
|
|
1336
|
1
|
|
|
|
|
2
|
my @thisIds = map {$_->pairingNumber} @{$group->members}; |
|
2
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
9
|
|
1337
|
1
|
|
|
|
|
7
|
$self->log(qq/Unfloating @floatIds back from $number ($index). /); |
1338
|
1
|
|
|
|
|
8
|
$self->log("[$number]: @thisIds & [$prevNumber]: @prevIds"); |
1339
|
1
|
|
|
|
|
4
|
$floaterSource->dissolved(1); |
1340
|
1
|
|
|
|
|
3
|
$c12RepairGroup->floatCheckWaive('None'); |
1341
|
1
|
|
|
|
|
4
|
$c12RepairGroup->{c8swapper} = $c12RepairGroup->c8iterator; |
1342
|
1
|
|
|
|
|
4
|
$c12RepairGroup->resetS12; |
1343
|
1
|
|
|
|
|
4
|
my $s2 = $c12RepairGroup->s2; |
1344
|
1
|
|
|
|
|
4
|
$c12RepairGroup->badpair($#$s2); |
1345
|
1
|
|
|
|
|
3
|
$brackets->{$key} = $c12RepairGroup; |
1346
|
1
|
|
|
|
|
4
|
$self->thisBracket($key); |
1347
|
1
|
|
|
|
|
6
|
return C7; |
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
elsif ( not $group->hetero ) |
1350
|
|
|
|
|
|
|
{ |
1351
|
0
|
|
|
|
|
0
|
$self->log( |
1352
|
|
|
|
|
|
|
"$index-Bracket [$number] not heterogeneous. Passing to C13."); |
1353
|
0
|
|
|
|
|
0
|
return C13; |
1354
|
|
|
|
|
|
|
} |
1355
|
0
|
|
|
|
|
0
|
return ERROR, msg => "$index-Bracket [$number] fell through C12"; |
1356
|
|
|
|
|
|
|
} |
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
=head2 c13 |
1360
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c13 |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
If the lowest score group contains a player who cannot be paired without violating B1 or B2 or who, if they are the only player in the group, cannot be given a bye (B1b), the pairing of the penultimate score bracket is undone. Try to find another pairing in the penultimate score bracket which will allow a pairing in the lowest score bracket. If in the penultimate score bracket p becomes zero (i.e. no pairing can be found which will allow a correct pairing for the lowest score bracket) then the two lowest score brackets are joined into a new lowest score bracket. Because now another score bracket is the penultimate one C13 can be repeated until an acceptable pairing is obtained. XXX Perhaps all the players from the old penultimate bracket were floated down. eg, t/cc6619.t. As a hack unfloat only those with the same score as the new penultimate bracket. |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
TODO not finding a pairing is not a program ERROR, but a LAST state. |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
=cut |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
sub c13 { |
1370
|
92
|
|
|
92
|
1
|
148
|
my $self = shift; |
1371
|
92
|
|
|
|
|
213
|
my $brackets = $self->brackets; |
1372
|
92
|
|
|
|
|
232
|
my $matches = $self->matches; |
1373
|
92
|
|
|
|
|
198
|
my $index = $self->thisBracket; |
1374
|
92
|
|
|
|
|
191
|
my $group = $brackets->{$index}; |
1375
|
92
|
|
|
|
|
249
|
my $number = $group->number; |
1376
|
92
|
|
|
|
|
259
|
my $members = $group->members; |
1377
|
92
|
100
|
|
|
|
272
|
unless ($index eq $self->lastBracket) { |
1378
|
2
|
|
|
|
|
12
|
$self->log("$index-Bracket [$number] not last group. Passing to C14" ) ; |
1379
|
2
|
|
|
|
|
7
|
return C14; |
1380
|
|
|
|
|
|
|
} |
1381
|
90
|
100
|
|
|
|
253
|
if ( $index eq $self->firstBracket ) |
1382
|
|
|
|
|
|
|
{ |
1383
|
1
|
|
|
|
|
6
|
return LAST, |
1384
|
|
|
|
|
|
|
msg => "All joined into one $index bracket, but no pairings! Sorry"; |
1385
|
|
|
|
|
|
|
} |
1386
|
89
|
100
|
|
|
|
248
|
if ( @$members == 1 ) { |
1387
|
32
|
|
|
|
|
59
|
my $lastone = $members->[0]; |
1388
|
32
|
|
|
|
|
90
|
my $pairingN = $lastone->pairingNumber; |
1389
|
32
|
|
|
|
|
95
|
my $id = $lastone->id; |
1390
|
32
|
|
|
|
|
156
|
$self->log( "One unpaired player, $pairingN in last bracket $number." ); |
1391
|
32
|
|
|
|
|
114
|
my $byeGone = $self->byes->{$id}; |
1392
|
32
|
100
|
|
|
|
78
|
if ( not $byeGone) { |
1393
|
30
|
|
|
|
|
80
|
$self->byer($lastone); |
1394
|
30
|
|
|
|
|
98
|
return BYE; |
1395
|
|
|
|
|
|
|
} |
1396
|
2
|
|
|
|
|
10
|
$self->log( "B1b: But that player, id $id had Bye in round $byeGone." ); |
1397
|
|
|
|
|
|
|
} |
1398
|
59
|
|
|
|
|
143
|
my $penultimateIndex = $self->previousBracket; |
1399
|
59
|
|
|
|
|
118
|
my $penultimateBracket = $brackets->{$penultimateIndex}; |
1400
|
59
|
|
|
|
|
172
|
my $penultimateNumber = $penultimateBracket->number; |
1401
|
59
|
|
|
|
|
186
|
my $penultScore = $penultimateBracket->score; |
1402
|
|
|
|
|
|
|
# $penultimateBracket->floatCheckWaive('None'); |
1403
|
59
|
|
|
|
|
347
|
delete $matches->{ $penultimateIndex }; |
1404
|
59
|
|
|
|
|
263
|
$self->log( |
1405
|
|
|
|
|
|
|
"Undoing $penultimateIndex-Bracket [$penultimateNumber] matches"); |
1406
|
59
|
|
|
|
|
129
|
my @returnees = grep { $_->score == $penultScore } @$members; |
|
194
|
|
|
|
|
864
|
|
1407
|
59
|
100
|
|
|
|
165
|
if ( @returnees ) |
1408
|
|
|
|
|
|
|
{ |
1409
|
57
|
|
|
|
|
98
|
my @floaterIds = map { $_->pairingNumber } @returnees; |
|
85
|
|
|
|
|
226
|
|
1410
|
57
|
|
|
|
|
316
|
$self->log( "Unfloating @floaterIds back from $number." ); |
1411
|
57
|
|
|
|
|
247
|
$group->exit($_) for @returnees; |
1412
|
57
|
|
|
|
|
201
|
$_->floating('') for @returnees; |
1413
|
57
|
|
|
|
|
194
|
$penultimateBracket->entry($_) for @returnees; |
1414
|
57
|
|
|
|
|
196
|
$_->floating('') for ( $penultimateBracket->upFloaters ); |
1415
|
57
|
|
|
|
|
203
|
$penultimateBracket->resetShuffler; |
1416
|
57
|
|
|
|
|
147
|
$brackets->{ $index } = $group; |
1417
|
|
|
|
|
|
|
} |
1418
|
59
|
|
|
|
|
183
|
my $penultp = $penultimateBracket->p; |
1419
|
59
|
|
|
|
|
208
|
my $penultxPrime = $penultimateBracket->xprime; |
1420
|
59
|
|
|
|
|
182
|
my $penultpPrime = $penultimateBracket->pprime; |
1421
|
59
|
100
|
66
|
|
|
315
|
if ($penultpPrime and not @returnees) { |
1422
|
2
|
|
|
|
|
5
|
$penultpPrime -= 1; |
1423
|
2
|
100
|
|
|
|
7
|
$penultxPrime -= 1 if $penultxPrime; |
1424
|
|
|
|
|
|
|
} |
1425
|
59
|
|
|
|
|
165
|
$penultimateBracket->pprime($penultpPrime); |
1426
|
59
|
|
|
|
|
164
|
$penultimateBracket->xprime($penultxPrime); |
1427
|
59
|
|
|
|
|
280
|
$self->log( "penultimate p=$penultpPrime." ); |
1428
|
59
|
100
|
|
|
|
185
|
if ( $penultpPrime == 0 ) { |
1429
|
1
|
|
|
|
|
4
|
my $evacuees = $penultimateBracket->members; |
1430
|
1
|
|
|
|
|
2
|
my @evacuIds = map { $_->pairingNumber } @$evacuees; |
|
2
|
|
|
|
|
5
|
|
1431
|
1
|
|
|
|
|
5
|
$penultimateBracket->exit($_) for @$evacuees; |
1432
|
1
|
|
|
|
|
4
|
$_->floating('Down') for @$evacuees; |
1433
|
1
|
|
|
|
|
5
|
$group->entry($_) for @$evacuees; |
1434
|
1
|
|
|
|
|
4
|
$penultimateBracket->dissolved(1); |
1435
|
1
|
|
|
|
|
3
|
my @finalIds = map { $_->pairingNumber } @$members; |
|
4
|
|
|
|
|
9
|
|
1436
|
0
|
|
|
|
|
0
|
my @penultimateIds = map { $_->pairingNumber } |
1437
|
1
|
|
|
|
|
3
|
@{$penultimateBracket->members}; |
|
1
|
|
|
|
|
3
|
|
1438
|
1
|
|
|
|
|
6
|
$self->log( "Joining Bracket $penultimateNumber, $number." ); |
1439
|
1
|
|
|
|
|
8
|
$self->log( "[$penultimateNumber] @evacuIds => [$number] @finalIds" ); |
1440
|
1
|
|
|
|
|
4
|
$group->resetShuffler; |
1441
|
1
|
|
|
|
|
5
|
return C1; |
1442
|
|
|
|
|
|
|
} |
1443
|
58
|
50
|
|
|
|
146
|
if ( $penultpPrime > 0 ) { |
1444
|
207
|
|
|
|
|
479
|
my @penultids = map {$_->pairingNumber} |
1445
|
58
|
|
|
|
|
74
|
@{$penultimateBracket->members}; |
|
58
|
|
|
|
|
158
|
|
1446
|
58
|
|
|
|
|
114
|
my @finalids = map {$_->pairingNumber} @{$group->members}; |
|
105
|
|
|
|
|
247
|
|
|
58
|
|
|
|
|
155
|
|
1447
|
58
|
|
|
|
|
239
|
$self->log( "Re-pairing Bracket $penultimateNumber." ); |
1448
|
58
|
|
|
|
|
386
|
$self->log( "[$penultimateNumber]: @penultids & [$number]: @finalids" ); |
1449
|
58
|
|
|
|
|
169
|
my $s2 = $penultimateBracket->s2; |
1450
|
58
|
|
|
|
|
240
|
$penultimateBracket->badpair($#$s2); |
1451
|
58
|
|
|
|
|
132
|
$self->thisBracket($penultimateIndex); |
1452
|
58
|
|
|
|
|
229
|
$self->penultpPrime( $penultpPrime ); |
1453
|
58
|
|
|
|
|
309
|
return C7; |
1454
|
|
|
|
|
|
|
} |
1455
|
0
|
|
|
|
|
0
|
else { return ERROR, msg => "Fell through C13 in $number ($index)"; } |
1456
|
|
|
|
|
|
|
} |
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
=head2 bye |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
$self->bye |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
The last, singular, unpairable player is given a bye. B2 |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
=cut |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
sub bye { |
1468
|
30
|
|
|
30
|
1
|
51
|
my $self = shift; |
1469
|
30
|
|
|
|
|
72
|
my $index = $self->thisBracket; |
1470
|
30
|
|
|
|
|
78
|
my $brackets = $self->brackets; |
1471
|
30
|
|
|
|
|
58
|
my $bracket = $brackets->{$index}; |
1472
|
30
|
|
|
|
|
93
|
my $members = $bracket->members; |
1473
|
30
|
|
|
|
|
68
|
my $byer = $self->byer; |
1474
|
30
|
|
|
|
|
80
|
my $id = $byer->id; |
1475
|
30
|
|
|
|
|
65
|
my $byes = $self->byes; |
1476
|
30
|
|
|
|
|
72
|
my $round = $self->round; |
1477
|
30
|
|
|
|
|
66
|
my $matches = $self->matches; |
1478
|
30
|
100
|
|
|
|
129
|
my $byeindex = $index =~ /Bye$/? $index : $index . 'Bye'; |
1479
|
30
|
|
|
|
|
144
|
my $game = |
1480
|
|
|
|
|
|
|
Games::Tournament::Card->new( |
1481
|
|
|
|
|
|
|
round => $round, |
1482
|
|
|
|
|
|
|
result => undef, |
1483
|
|
|
|
|
|
|
contestants => { Bye => $byer } ); |
1484
|
30
|
|
|
|
|
98
|
$game->float($byer, 'Down'); |
1485
|
30
|
|
|
|
|
82
|
$matches->{$byeindex} = [ $game ]; |
1486
|
30
|
|
|
|
|
96
|
$self->log( "OK." ); |
1487
|
30
|
|
|
|
|
66
|
$byes->{$id} = $round; |
1488
|
30
|
|
|
|
|
91
|
return LAST; |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
=head2 c14 |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
Games::Tournament::Swiss::Procedure->c14 |
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
Decrease p (pprime) by 1 (and if the original value of x was greater than zero decrease x by 1 as well). As long as p is unequal to zero restart at C4. (At C13, if this is final bracket, because this means it is unpairable.) If p equals zero the entire score bracket is moved down to the next one. Restart with this score bracket at C1. (If it is the penultimate bracket, and the final bracket is unpairable, the final bracket is moved up, but I guess that's the same thing. C13 ) |
1499
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
=cut |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
sub c14 { |
1503
|
2
|
|
|
2
|
1
|
5
|
my $self = shift; |
1504
|
2
|
|
|
|
|
6
|
my $groups = $self->brackets; |
1505
|
2
|
|
|
|
|
5
|
my $index = $self->thisBracket; |
1506
|
2
|
|
|
|
|
6
|
my $group = $groups->{ $index }; |
1507
|
2
|
|
|
|
|
7
|
my $number = $group->number; |
1508
|
2
|
|
|
|
|
7
|
my $members = $group->members; |
1509
|
2
|
|
|
|
|
6
|
my $p = $group->p; |
1510
|
2
|
|
|
|
|
6
|
my $x = $group->xprime; |
1511
|
2
|
|
|
|
|
6
|
my $pprime = $group->pprime; |
1512
|
2
|
50
|
|
|
|
8
|
if ($pprime) { |
1513
|
2
|
|
|
|
|
3
|
$pprime -= 1; |
1514
|
2
|
50
|
|
|
|
7
|
$x -= 1 if $x; |
1515
|
|
|
|
|
|
|
} |
1516
|
2
|
|
|
|
|
7
|
$group->pprime($pprime); |
1517
|
2
|
|
|
|
|
5
|
$group->xprime($x); |
1518
|
2
|
|
|
|
|
7
|
$group->floatCheckWaive('None'); |
1519
|
2
|
|
|
|
|
11
|
$self->log( "Bracket $number, now p=$pprime" ); |
1520
|
2
|
|
|
|
|
6
|
my $next = $self->nextBracket; |
1521
|
2
|
|
|
|
|
5
|
my $nextgroup = $groups->{$next}; |
1522
|
2
|
50
|
33
|
|
|
12
|
if ( $pprime == 0 and $index eq $self->lastBracket and defined |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
$self->penultpPrime ) { |
1524
|
0
|
|
|
|
|
0
|
$self->penultpPrime(undef); |
1525
|
0
|
|
|
|
|
0
|
$self->previousBracket($group); |
1526
|
0
|
|
|
|
|
0
|
return C13; |
1527
|
|
|
|
|
|
|
} |
1528
|
|
|
|
|
|
|
elsif ( $pprime < $p and $index eq $self->lastBracket ) |
1529
|
|
|
|
|
|
|
{ |
1530
|
0
|
|
|
|
|
0
|
$self->penultpPrime(undef); |
1531
|
0
|
|
|
|
|
0
|
return C13; |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
elsif ($pprime > 0) |
1534
|
|
|
|
|
|
|
{ |
1535
|
0
|
|
|
|
|
0
|
$self->log( "Trying to pair Bracket $index ($number) again" ); |
1536
|
0
|
|
|
|
|
0
|
return C4; |
1537
|
|
|
|
|
|
|
} |
1538
|
|
|
|
|
|
|
elsif ( $nextgroup->{remainderof} ) |
1539
|
|
|
|
|
|
|
{ |
1540
|
0
|
|
|
|
|
0
|
my $returners = $nextgroup->members; |
1541
|
0
|
|
|
|
|
0
|
$nextgroup->exit($_) for @$returners; |
1542
|
0
|
|
|
|
|
0
|
$_->floating('') for @$returners; |
1543
|
0
|
|
|
|
|
0
|
$group->entry($_) for @$returners; |
1544
|
0
|
|
|
|
|
0
|
$group->naturalize($_) for @$returners; |
1545
|
0
|
|
|
|
|
0
|
my $remainderNumber = $nextgroup->number; |
1546
|
0
|
|
|
|
|
0
|
my @remainderIds = map { $_->pairingNumber } @$returners; |
|
0
|
|
|
|
|
0
|
|
1547
|
0
|
|
|
|
|
0
|
my @heteroIds = map { $_->pairingNumber } @{$group->members}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1548
|
0
|
|
|
|
|
0
|
$self->log( "Moving all Group $remainderNumber members back to $number." ); |
1549
|
0
|
|
|
|
|
0
|
$self->log( "@remainderIds => Bracket $number: @heteroIds" ); |
1550
|
0
|
|
|
|
|
0
|
$self->thisBracket($index); |
1551
|
0
|
|
|
|
|
0
|
$nextgroup->resetShuffler; |
1552
|
0
|
|
|
|
|
0
|
$nextgroup->dissolved(1); |
1553
|
0
|
|
|
|
|
0
|
return C1; |
1554
|
|
|
|
|
|
|
} |
1555
|
|
|
|
|
|
|
else { |
1556
|
2
|
|
|
|
|
6
|
my @evacuees = @$members; |
1557
|
2
|
|
|
|
|
10
|
$group->exit($_) for @evacuees; |
1558
|
2
|
|
|
|
|
8
|
$_->floating('Down') for @evacuees; |
1559
|
2
|
|
|
|
|
8
|
$nextgroup->entry($_) for @evacuees; |
1560
|
2
|
|
|
|
|
11
|
$nextgroup->naturalize($_) for @evacuees; |
1561
|
2
|
|
|
|
|
6
|
my $nextNumber = $nextgroup->number; |
1562
|
2
|
|
|
|
|
5
|
my @thisMemberIds = map { $_->pairingNumber } @evacuees; |
|
6
|
|
|
|
|
14
|
|
1563
|
2
|
|
|
|
|
4
|
my @nextMemberIds = map { $_->pairingNumber } @{$nextgroup->members}; |
|
10
|
|
|
|
|
22
|
|
|
2
|
|
|
|
|
6
|
|
1564
|
2
|
|
|
|
|
13
|
$self->log( "Moving down all Bracket $number($next), to $nextNumber." ); |
1565
|
2
|
|
|
|
|
17
|
$self->log( "@thisMemberIds => Bracket $nextNumber: @nextMemberIds" ); |
1566
|
2
|
|
|
|
|
6
|
$self->thisBracket($next); |
1567
|
2
|
|
|
|
|
6
|
$nextgroup->resetShuffler; |
1568
|
2
|
|
|
|
|
6
|
$group->dissolved(1); |
1569
|
2
|
|
|
|
|
11
|
return C1; |
1570
|
|
|
|
|
|
|
} |
1571
|
|
|
|
|
|
|
} |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
=head2 colors |
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
$next = $pairing->c7 |
1577
|
|
|
|
|
|
|
while ( my @s2 = &$next ) |
1578
|
|
|
|
|
|
|
{ |
1579
|
|
|
|
|
|
|
create match cards unless this permutation is incompatible; |
1580
|
|
|
|
|
|
|
} |
1581
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
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 both players, or grant the stronger preference, or grant the opposite roles to those they had when they last played a round in different roles, or grant the preference of the higher ranked player, in that order. (E) A Games::Tournament::Card object, records round, contestants, (undefined) result, and floats (A4). |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
=cut |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
sub colors { |
1588
|
192
|
|
|
192
|
1
|
257
|
my $self = shift; |
1589
|
192
|
|
|
|
|
481
|
my %args = @_; |
1590
|
192
|
|
|
|
|
451
|
my $groups = $self->brackets; |
1591
|
192
|
|
|
|
|
496
|
my $round = $self->round; |
1592
|
192
|
|
|
|
|
437
|
my $thisGroup = $self->thisBracket; |
1593
|
192
|
|
|
|
|
379
|
my $group = $groups->{$thisGroup}; |
1594
|
192
|
|
|
|
|
600
|
my $number = $group->number; |
1595
|
192
|
|
|
|
|
373
|
my $pairs = $args{paired}; |
1596
|
192
|
|
|
|
|
259
|
my ($message, @bracketMatches); |
1597
|
192
|
|
|
|
|
384
|
for my $pair ( @$pairs ) { |
1598
|
246
|
|
|
|
|
556
|
my @pair = @$pair; |
1599
|
246
|
|
|
|
|
391
|
my @rolehistory = ( map { $pair[$_]->rolesPlayedList } 0, 1 ); |
|
492
|
|
|
|
|
1503
|
|
1600
|
246
|
|
|
|
|
393
|
my @lastdiff; |
1601
|
246
|
|
|
|
|
626
|
for my $lookback ( 1 .. $round - FIRSTROUND ) |
1602
|
|
|
|
|
|
|
{ |
1603
|
318
|
100
|
|
636
|
|
1518
|
last if notall { $_->firstround <= $round-$lookback } @pair; |
|
636
|
|
|
|
|
1746
|
|
1604
|
317
|
|
|
|
|
1081
|
my $s1role = $rolehistory[0]->[-$lookback]; |
1605
|
317
|
|
|
|
|
520
|
my $s2role = $rolehistory[1]->[-$lookback]; |
1606
|
317
|
|
|
|
|
503
|
my @ids = map {$_->id} @pair; |
|
634
|
|
|
|
|
1534
|
|
1607
|
|
|
|
|
|
|
# die "Missing roles for Players @ids in Round " . ($round-$lookback) |
1608
|
|
|
|
|
|
|
last |
1609
|
317
|
100
|
100
|
|
|
1583
|
unless $s1role and $s2role; |
1610
|
300
|
100
|
|
|
|
881
|
next if $s1role eq $s2role; |
1611
|
167
|
100
|
|
|
|
282
|
next unless 2 == grep { $_ eq (ROLES)[0] or $_ eq (ROLES)[1] } |
|
334
|
50
|
|
|
|
1674
|
|
1612
|
|
|
|
|
|
|
($s1role, $s2role); |
1613
|
167
|
|
|
|
|
341
|
@lastdiff = ($s1role, $s2role); |
1614
|
167
|
|
|
|
|
404
|
last; |
1615
|
|
|
|
|
|
|
} |
1616
|
246
|
|
|
|
|
347
|
my ( $contestants, $stronger, $diff ); |
1617
|
246
|
|
|
|
|
385
|
my @roles = map { $_->preference->role } @pair; |
|
492
|
|
|
|
|
1343
|
|
1618
|
246
|
|
|
|
|
527
|
my @strengths = map { $_->preference->strength } @pair; |
|
492
|
|
|
|
|
1279
|
|
1619
|
246
|
|
|
|
|
364
|
my $rule; |
1620
|
246
|
50
|
66
|
|
|
601
|
if ( not $roles[0] and not $roles[1] ) { |
1621
|
0
|
|
|
|
|
0
|
( $roles[0], $roles[1] ) = $self->randomRole; |
1622
|
0
|
|
|
|
|
0
|
$rule = 'No prefs'; |
1623
|
|
|
|
|
|
|
} |
1624
|
246
|
100
|
|
|
|
567
|
if ( not $roles[0] ) { |
1625
|
4
|
50
|
|
|
|
19
|
$roles[0] = |
1626
|
|
|
|
|
|
|
( $roles[1] eq (ROLES)[1] ) |
1627
|
|
|
|
|
|
|
? (ROLES)[0] |
1628
|
|
|
|
|
|
|
: (ROLES)[1]; |
1629
|
4
|
|
|
|
|
7
|
$rule = 'No S1 pref'; |
1630
|
|
|
|
|
|
|
} |
1631
|
246
|
100
|
|
|
|
505
|
if ( not $roles[1] ) { |
1632
|
27
|
100
|
|
|
|
89
|
$roles[1] = |
1633
|
|
|
|
|
|
|
( $roles[0] eq (ROLES)[1] ) |
1634
|
|
|
|
|
|
|
? (ROLES)[0] |
1635
|
|
|
|
|
|
|
: (ROLES)[1]; |
1636
|
27
|
|
|
|
|
46
|
$rule = 'No S2 pref'; |
1637
|
|
|
|
|
|
|
} |
1638
|
246
|
100
|
|
|
|
630
|
if ( $roles[0] ne $roles[1] ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1639
|
189
|
|
|
|
|
605
|
$contestants = { $roles[0] => $pair[0], $roles[1] => $pair[1] }; |
1640
|
189
|
|
|
|
|
333
|
$rule = 'E1'; |
1641
|
|
|
|
|
|
|
} |
1642
|
|
|
|
|
|
|
elsif ( $strengths[0] ne $strengths[1] ) { |
1643
|
18
|
100
|
|
|
|
46
|
if ( |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
defined( |
1645
|
|
|
|
|
|
|
$stronger = ( |
1646
|
36
|
|
|
|
|
103
|
grep { $pair[$_]->preference->strength eq 'Absolute' } |
1647
|
|
|
|
|
|
|
0 .. 1 |
1648
|
|
|
|
|
|
|
)[0] |
1649
|
|
|
|
|
|
|
) |
1650
|
|
|
|
|
|
|
) |
1651
|
|
|
|
|
|
|
{ |
1652
|
11
|
|
|
|
|
18
|
1; |
1653
|
|
|
|
|
|
|
} |
1654
|
|
|
|
|
|
|
elsif ( |
1655
|
|
|
|
|
|
|
defined( |
1656
|
|
|
|
|
|
|
$stronger = ( |
1657
|
14
|
|
|
|
|
41
|
grep { $pair[$_]->preference->strength eq 'Strong' } |
1658
|
|
|
|
|
|
|
0 .. 1 |
1659
|
|
|
|
|
|
|
)[0] |
1660
|
|
|
|
|
|
|
) |
1661
|
|
|
|
|
|
|
) |
1662
|
|
|
|
|
|
|
{ |
1663
|
7
|
|
|
|
|
11
|
1; |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
elsif ( |
1666
|
|
|
|
|
|
|
defined( |
1667
|
|
|
|
|
|
|
$stronger = ( |
1668
|
0
|
|
|
|
|
0
|
grep { $pair[$_]->preference->strength eq 'Mild' } |
1669
|
|
|
|
|
|
|
0 .. 1 |
1670
|
|
|
|
|
|
|
)[0] |
1671
|
|
|
|
|
|
|
) |
1672
|
|
|
|
|
|
|
) |
1673
|
|
|
|
|
|
|
{ |
1674
|
0
|
|
|
|
|
0
|
1; |
1675
|
|
|
|
|
|
|
} |
1676
|
18
|
|
|
|
|
57
|
my $strongerRole = $pair[$stronger]->preference->role; |
1677
|
18
|
100
|
|
|
|
56
|
my $weaker = $stronger == 0 ? 1 : 0; |
1678
|
18
|
|
|
|
|
38
|
my $weakerRole = ( grep { $_ ne $strongerRole } ROLES )[0]; |
|
36
|
|
|
|
|
85
|
|
1679
|
18
|
|
|
|
|
59
|
$contestants = { |
1680
|
|
|
|
|
|
|
$strongerRole => $pair[$stronger], |
1681
|
|
|
|
|
|
|
$weakerRole => $pair[$weaker] |
1682
|
|
|
|
|
|
|
}; |
1683
|
18
|
|
|
|
|
37
|
$rule = 'E2'; |
1684
|
|
|
|
|
|
|
} |
1685
|
|
|
|
|
|
|
elsif ( @lastdiff ) |
1686
|
|
|
|
|
|
|
{ |
1687
|
8
|
|
|
|
|
27
|
$contestants = {$lastdiff[1] => $pair[0], $lastdiff[0] => $pair[1]}; |
1688
|
8
|
|
|
|
|
17
|
$rule = 'E3'; |
1689
|
|
|
|
|
|
|
} |
1690
|
|
|
|
|
|
|
else { |
1691
|
31
|
|
|
|
|
105
|
my $rankerRole = $pair[0]->preference->role; |
1692
|
31
|
|
|
|
|
86
|
my $otherRole = ( grep { $_ ne $rankerRole } ROLES )[0]; |
|
62
|
|
|
|
|
152
|
|
1693
|
31
|
|
|
|
|
132
|
$contestants = { $rankerRole => $pair[0], $otherRole => $pair[1] }; |
1694
|
31
|
|
|
|
|
66
|
$rule = 'E4'; |
1695
|
|
|
|
|
|
|
} |
1696
|
|
|
|
|
|
|
$message .= $rule . ' ' . |
1697
|
|
|
|
|
|
|
$contestants->{ (ROLES)[0] }->pairingNumber . "&" . |
1698
|
246
|
|
|
|
|
1072
|
$contestants->{ (ROLES)[1] }->pairingNumber . ' '; |
1699
|
246
|
|
|
|
|
719
|
my $game = Games::Tournament::Card->new( |
1700
|
|
|
|
|
|
|
round => $self->round, |
1701
|
|
|
|
|
|
|
result => undef, |
1702
|
|
|
|
|
|
|
contestants => $contestants, |
1703
|
|
|
|
|
|
|
); |
1704
|
|
|
|
|
|
|
$game->float($contestants->{$_}, $contestants->{$_}->floating || 'Not') |
1705
|
246
|
|
100
|
|
|
1241
|
for ROLES; |
1706
|
246
|
|
|
|
|
1089
|
push @bracketMatches, $game; |
1707
|
|
|
|
|
|
|
} |
1708
|
|
|
|
|
|
|
# $self->previousBracket($group); |
1709
|
192
|
|
|
|
|
872
|
return $message, @bracketMatches; |
1710
|
|
|
|
|
|
|
} |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
=head2 brackets |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
$pairing->brackets |
1716
|
|
|
|
|
|
|
|
1717
|
|
|
|
|
|
|
Gets/sets all the brackets which we are pairing. The order of this array is important. The brackets are paired in order. I was storing these as an anonymous array of score group (bracket) objects. But the problem of remainder groups has forced me to store as a hash. |
1718
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
=cut |
1720
|
|
|
|
|
|
|
|
1721
|
|
|
|
|
|
|
sub brackets { |
1722
|
8016
|
|
|
8016
|
1
|
10626
|
my $self = shift; |
1723
|
8016
|
|
|
|
|
9829
|
my $brackets = shift; |
1724
|
8016
|
100
|
|
|
|
25623
|
if ( defined $brackets ) { $self->{brackets} = $brackets; } |
|
652
|
50
|
|
|
|
6023
|
|
1725
|
7364
|
|
|
|
|
15336
|
elsif ( $self->{brackets} ) { return $self->{brackets}; } |
1726
|
|
|
|
|
|
|
} |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
=head2 bracketOrder |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
$pairing->bracketOrder |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
Gets an array of homogeneous and heterogeneous brackets in order with remainder groups (iff they have been given bracket status and only until this status is withdrawn) coming after the heterogeneous groups from which they are formed. This ordered array is necessary, because remainder groups come into being and it is difficult to move back to them. Do we re-pair the remainder group, or the whole group from which it came? Remember to keep control of remainder groups' virtual bracket status with the dissolved field. This method depends on each bracket having an index made up of the bracket score and a 'Remainder' or other appropriate suffix, if it is a remainder or other kind of sub-bracket. We rely on the lexico ordering of the suffixes. |
1734
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
TODO No need to create scoresAndTags list of lists here. Just do |
1736
|
|
|
|
|
|
|
@index{@indexes} = map { m/^(\d*\.?\d+)(\D.*)?$/; |
1737
|
|
|
|
|
|
|
{score => $1, tag => $2||'' } |
1738
|
|
|
|
|
|
|
} @indexes; |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
=cut |
1741
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
sub bracketOrder { |
1743
|
1514
|
|
|
1514
|
1
|
1930
|
my $self = shift; |
1744
|
1514
|
|
|
|
|
2879
|
my $brackets = $self->brackets; |
1745
|
1514
|
|
|
|
|
3763
|
my @indexes = grep { not $brackets->{$_}->dissolved } keys %$brackets; |
|
6877
|
|
|
|
|
17791
|
|
1746
|
1514
|
|
|
|
|
2911
|
my @scoresAndTags = map { m/^(\d*\.?\d+)(\D.*)?$/; [$1,$2] } @indexes; |
|
5075
|
|
|
|
|
15054
|
|
|
5075
|
|
|
|
|
15388
|
|
1747
|
1514
|
|
|
|
|
2208
|
my %index; |
1748
|
1514
|
|
100
|
|
|
2188
|
@index{@indexes} = map {{score => $_->[0], tag => $_->[1] || '' }} |
|
5075
|
|
|
|
|
27378
|
|
1749
|
|
|
|
|
|
|
@scoresAndTags; |
1750
|
1514
|
|
|
|
|
3996
|
my @indexOrder = sort { $index{$b}->{score} <=> $index{$a}->{score} || |
1751
|
5799
|
50
|
|
|
|
17951
|
$index{$a}->{tag} cmp $index{$b}->{tag} } |
1752
|
|
|
|
|
|
|
@indexes; |
1753
|
1514
|
|
|
|
|
3066
|
unshift @indexOrder, 'START'; |
1754
|
1514
|
|
|
|
|
10851
|
return @indexOrder; |
1755
|
|
|
|
|
|
|
} |
1756
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
=head2 firstBracket |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
$pairing->firstBracket |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
Gets the firstBracket. This is the undissolved bracket with the highest score. |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
=cut |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
sub firstBracket { |
1767
|
188
|
|
|
188
|
1
|
277
|
my $self = shift; |
1768
|
188
|
|
|
|
|
410
|
my @scoreOrder = $self->bracketOrder; |
1769
|
188
|
|
|
|
|
361
|
my $startBlock = shift @scoreOrder; |
1770
|
188
|
|
|
|
|
274
|
my $firstBracket = shift @scoreOrder; |
1771
|
188
|
|
|
|
|
725
|
return $firstBracket; |
1772
|
|
|
|
|
|
|
} |
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
=head2 lastBracket |
1776
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
$pairing->lastBracket |
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
Gets the lastBracket. With the joining of score brackets and addition of remainder groups, this bracket may change. |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
=cut |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
sub lastBracket { |
1784
|
584
|
|
|
584
|
1
|
773
|
my $self = shift; |
1785
|
584
|
|
|
|
|
1295
|
my @scoreOrder = $self->bracketOrder; |
1786
|
584
|
|
|
|
|
3289
|
return pop @scoreOrder; |
1787
|
|
|
|
|
|
|
} |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
=head2 nextBracket |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
$pairing->nextBracket |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
Gets the nextBracket to that which we are pairing now. This may or may not be a remainder group, depending on whether they have been given virtual bracket status. |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
=cut |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
sub nextBracket { |
1799
|
412
|
|
|
412
|
1
|
626
|
my $self = shift; |
1800
|
412
|
|
|
|
|
883
|
my $place = $self->thisBracket; |
1801
|
412
|
|
|
|
|
961
|
my @scoreOrder = $self->bracketOrder; |
1802
|
412
|
|
|
|
|
687
|
my $nextBracket; |
1803
|
412
|
50
|
|
|
|
962
|
if (defined $place) |
1804
|
|
|
|
|
|
|
{ |
1805
|
412
|
|
|
|
|
506
|
my $next = 0; |
1806
|
412
|
|
|
|
|
761
|
for my $index ( @scoreOrder ) { |
1807
|
1520
|
|
|
|
|
1993
|
$nextBracket = $index; |
1808
|
1520
|
100
|
|
|
|
3039
|
last if $next; |
1809
|
1113
|
100
|
|
|
|
2623
|
$next++ if $index eq $place; |
1810
|
|
|
|
|
|
|
} |
1811
|
412
|
100
|
|
|
|
1737
|
return $nextBracket unless $nextBracket eq $place; |
1812
|
|
|
|
|
|
|
} |
1813
|
5
|
|
|
|
|
44
|
return; |
1814
|
|
|
|
|
|
|
} |
1815
|
|
|
|
|
|
|
|
1816
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
=head2 previousBracket |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
$pairing->previousBracket |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
Gets the previousBracket to that which we are pairing now. This may or may not be a remainder group, depending on whether they have been given virtual bracket status. |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
=cut |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
sub previousBracket { |
1826
|
308
|
|
|
308
|
1
|
419
|
my $self = shift; |
1827
|
308
|
|
|
|
|
671
|
my $place = $self->thisBracket; |
1828
|
308
|
|
|
|
|
754
|
my @indexOrder = $self->bracketOrder; |
1829
|
308
|
|
|
|
|
511
|
my $previousBracket; |
1830
|
308
|
|
|
|
|
553
|
for my $index ( @indexOrder ) { |
1831
|
1104
|
100
|
|
|
|
2389
|
last if $index eq $place; |
1832
|
796
|
|
|
|
|
1228
|
$previousBracket = $index; |
1833
|
|
|
|
|
|
|
} |
1834
|
308
|
|
|
|
|
809
|
return $previousBracket; |
1835
|
|
|
|
|
|
|
} |
1836
|
|
|
|
|
|
|
|
1837
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
=head2 index |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
$pairing->index($bracket) |
1841
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
Gets the index of $bracket, possibly a changing label, because remainder groups coming into being and are given virtual bracket status. |
1843
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
=cut |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
sub index { |
1847
|
22
|
|
|
22
|
1
|
36
|
my $self = shift; |
1848
|
22
|
|
|
|
|
57
|
my $brackets = $self->brackets; |
1849
|
22
|
|
|
|
|
31
|
my $bracket = shift; |
1850
|
22
|
|
|
|
|
72
|
my $score = $bracket->score; |
1851
|
22
|
|
|
|
|
67
|
my $number = $bracket->number; |
1852
|
22
|
|
|
|
|
69
|
my @order = $self->bracketOrder; |
1853
|
78
|
100
|
|
78
|
|
1397
|
my $index = first { m/^\d+(\.5)?$/ and $brackets->{$_}->score==$score } |
1854
|
22
|
|
|
|
|
137
|
@order; |
1855
|
22
|
50
|
|
|
|
99
|
confess "No index for Bracket $number, with score $score. Is it dissolved?" |
1856
|
|
|
|
|
|
|
unless defined $index; |
1857
|
|
|
|
|
|
|
# $index .= 'C11Repair' if $bracket->{c11repairof}; |
1858
|
|
|
|
|
|
|
# $index .= 'C10Repair' if $bracket->{c10repairof}; |
1859
|
22
|
50
|
|
|
|
57
|
$index .= 'Remainder' if $bracket->{remainderof}; |
1860
|
22
|
|
|
|
|
71
|
return $index; |
1861
|
|
|
|
|
|
|
} |
1862
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
|
1864
|
|
|
|
|
|
|
=head2 round |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
$pairing->round |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
What round is this round's results we're pairing on the basis of? |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
=cut |
1871
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
sub round { |
1873
|
515
|
|
|
515
|
1
|
659
|
my $self = shift; |
1874
|
515
|
|
|
|
|
680
|
my $round = shift; |
1875
|
515
|
50
|
|
|
|
1793
|
if ( defined $round ) { $self->{round} = $round; } |
|
0
|
50
|
|
|
|
0
|
|
1876
|
515
|
|
|
|
|
1749
|
elsif ( $self->{round} ) { return $self->{round}; } |
1877
|
|
|
|
|
|
|
} |
1878
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
=head2 thisBracket |
1881
|
|
|
|
|
|
|
|
1882
|
|
|
|
|
|
|
$pairing->thisBracket |
1883
|
|
|
|
|
|
|
$pairing->thisBracket($pairing->firstBracket) |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
What bracket is this? Gets/sets a string of the form $score, or |
1886
|
|
|
|
|
|
|
${score}Remainder if it is a remainder group. (In C10, create an 'C10Repair' group.) You need to set this when moving from one bracket to another. And test the value returned. If no bracket is set, undef is returned. |
1887
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
=cut |
1889
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
sub thisBracket { |
1891
|
8780
|
|
|
8780
|
1
|
11263
|
my $self = shift; |
1892
|
8780
|
|
|
|
|
10968
|
my $thisBracket = shift; |
1893
|
8780
|
100
|
|
|
|
24554
|
if ( defined $thisBracket ) { $self->{thisBracket} = $thisBracket; } |
|
416
|
100
|
|
|
|
747
|
|
1894
|
8317
|
|
|
|
|
18101
|
elsif ( defined $self->{thisBracket} ) { return $self->{thisBracket}; } |
1895
|
463
|
|
|
|
|
717
|
return; |
1896
|
|
|
|
|
|
|
} |
1897
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
=head2 byer |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
$group->byer |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
Gets/sets the player set to take the bye. |
1904
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
=cut |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
sub byer { |
1908
|
60
|
|
|
60
|
1
|
82
|
my $self = shift; |
1909
|
60
|
|
|
|
|
78
|
my $byer = shift; |
1910
|
60
|
100
|
|
|
|
152
|
if ( defined $byer ) { $self->{byer} = $byer; } |
|
30
|
50
|
|
|
|
63
|
|
1911
|
30
|
|
|
|
|
58
|
elsif ( $self->{byer} ) { return $self->{byer}; } |
1912
|
30
|
|
|
|
|
48
|
return; |
1913
|
|
|
|
|
|
|
} |
1914
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
=head2 paired |
1917
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
$group->paired |
1919
|
|
|
|
|
|
|
|
1920
|
|
|
|
|
|
|
Gets/sets an array of paired players, arranged pair by pair, in the bracket being paired. |
1921
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
=cut |
1923
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
sub paired { |
1925
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1926
|
0
|
|
|
|
|
0
|
my $paired = shift; |
1927
|
0
|
0
|
|
|
|
0
|
if ( defined $paired ) { $self->{paired} = $paired; } |
|
0
|
0
|
|
|
|
0
|
|
1928
|
0
|
|
|
|
|
0
|
elsif ( $self->{paired} ) { return $self->{paired}; } |
1929
|
0
|
|
|
|
|
0
|
return; |
1930
|
|
|
|
|
|
|
} |
1931
|
|
|
|
|
|
|
|
1932
|
|
|
|
|
|
|
|
1933
|
|
|
|
|
|
|
=head2 nonpaired |
1934
|
|
|
|
|
|
|
|
1935
|
|
|
|
|
|
|
$group->nonpaired |
1936
|
|
|
|
|
|
|
|
1937
|
|
|
|
|
|
|
Gets/sets an array of nonpaired players in the bracket being paired. |
1938
|
|
|
|
|
|
|
|
1939
|
|
|
|
|
|
|
=cut |
1940
|
|
|
|
|
|
|
|
1941
|
|
|
|
|
|
|
sub nonpaired { |
1942
|
296
|
|
|
296
|
1
|
415
|
my $self = shift; |
1943
|
296
|
|
|
|
|
368
|
my $nonpaired = shift; |
1944
|
296
|
100
|
|
|
|
748
|
if ( defined $nonpaired ) { $self->{nonpaired} = $nonpaired; } |
|
148
|
50
|
|
|
|
312
|
|
1945
|
148
|
|
|
|
|
298
|
elsif ( $self->{nonpaired} ) { return $self->{nonpaired}; } |
1946
|
148
|
|
|
|
|
293
|
return; |
1947
|
|
|
|
|
|
|
} |
1948
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
|
1950
|
|
|
|
|
|
|
=head2 matches |
1951
|
|
|
|
|
|
|
|
1952
|
|
|
|
|
|
|
$group->matches |
1953
|
|
|
|
|
|
|
|
1954
|
|
|
|
|
|
|
Gets/sets the matches which we have made. Returned is an anonymous hash of the matches in the round, keyed on a bracket index. Each value of the hash is an anonymous array of the matches in that bracket. So to get each actual match, you need to break up the matches in the individual brackets. |
1955
|
|
|
|
|
|
|
|
1956
|
|
|
|
|
|
|
=cut |
1957
|
|
|
|
|
|
|
|
1958
|
|
|
|
|
|
|
sub matches { |
1959
|
333
|
|
|
333
|
1
|
460
|
my $self = shift; |
1960
|
333
|
|
|
|
|
450
|
my $matches = shift; |
1961
|
333
|
50
|
|
|
|
1046
|
if ( defined $matches ) { $self->{matches} = $matches; } |
|
0
|
50
|
|
|
|
0
|
|
1962
|
333
|
|
|
|
|
686
|
elsif ( $self->{matches} ) { return $self->{matches}; } |
1963
|
0
|
|
|
|
|
0
|
return; |
1964
|
|
|
|
|
|
|
} |
1965
|
|
|
|
|
|
|
|
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
=head2 whoPlayedWho |
1968
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
$group->whoPlayedWho |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
Gets/sets a anonymous hash, keyed on the pairing numbers of the opponents, of the preference of individual pairs of @grandmasters, if they both have the same absolute preference, and so can't play each other. This has probably been calculated by Games::Tournament::Swiss::whoPlayedWho B1a |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
=cut |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
sub whoPlayedWho { |
1976
|
1768
|
|
|
1768
|
1
|
2304
|
my $self = shift; |
1977
|
1768
|
|
|
|
|
2242
|
my $whoPlayedWho = shift; |
1978
|
1768
|
50
|
|
|
|
6027
|
if ( defined $whoPlayedWho ) { $self->{whoPlayedWho} = $whoPlayedWho; } |
|
0
|
100
|
|
|
|
0
|
|
1979
|
1722
|
|
|
|
|
3441
|
elsif ( $self->{whoPlayedWho} ) { return $self->{whoPlayedWho}; } |
1980
|
|
|
|
|
|
|
} |
1981
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
=head2 colorClashes |
1984
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
$group->colorClashes |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
Gets/sets a anonymous hash, keyed on the pairing numbers of the opponents, of their preference, if (and only if) they both have an Absolute preference for the same role and so can't play each other. This has probably been calculated by Games::Tournament::Swiss::colorClashes B2a |
1988
|
|
|
|
|
|
|
|
1989
|
|
|
|
|
|
|
=cut |
1990
|
|
|
|
|
|
|
|
1991
|
|
|
|
|
|
|
sub colorClashes { |
1992
|
1768
|
|
|
1768
|
1
|
2456
|
my $self = shift; |
1993
|
1768
|
|
|
|
|
2190
|
my $colorClashes = shift; |
1994
|
1768
|
50
|
|
|
|
5871
|
if ( defined $colorClashes ) { $self->{colorClashes} = $colorClashes; } |
|
0
|
100
|
|
|
|
0
|
|
1995
|
1260
|
|
|
|
|
2581
|
elsif ( $self->{colorClashes} ) { return $self->{colorClashes}; } |
1996
|
|
|
|
|
|
|
} |
1997
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
=head2 incompatibles |
2000
|
|
|
|
|
|
|
|
2001
|
|
|
|
|
|
|
$group->incompatibles |
2002
|
|
|
|
|
|
|
|
2003
|
|
|
|
|
|
|
Gets/sets a anonymous hash, keyed on the pairing numbers of the opponents, of a previous round in which individual pairs of @grandmasters, if any, met. Or of their preference if they both have an Absolute preference for the same role and can't play each other. This has probably been calculated by Games::Tournament::Swiss::incompatibles. B1 |
2004
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
=cut |
2006
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
sub incompatibles { |
2008
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
2009
|
0
|
|
|
|
|
0
|
my $incompatibles = shift; |
2010
|
0
|
0
|
|
|
|
0
|
if ( defined $incompatibles ) { $self->{incompatibles} = $incompatibles; } |
|
0
|
0
|
|
|
|
0
|
|
2011
|
0
|
|
|
|
|
0
|
elsif ( $self->{incompatibles} ) { return $self->{incompatibles}; } |
2012
|
|
|
|
|
|
|
} |
2013
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
=head2 byes |
2016
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
$group->byes |
2018
|
|
|
|
|
|
|
return BYE unless $group->byes->{$id} |
2019
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
Gets/sets a anonymous hash, keyed on ids, not pairing numbers of players, of a previous round in which these players had a bye. This has probably been calculated by Games::Tournament::Swiss::byes. B1 |
2021
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
=cut |
2023
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
sub byes { |
2025
|
62
|
|
|
62
|
1
|
84
|
my $self = shift; |
2026
|
62
|
|
|
|
|
91
|
my $byes = shift; |
2027
|
62
|
50
|
|
|
|
231
|
if ( defined $byes ) { $self->{byes} = $byes; } |
|
0
|
50
|
|
|
|
0
|
|
2028
|
62
|
|
|
|
|
144
|
elsif ( $self->{byes} ) { return $self->{byes}; } |
2029
|
|
|
|
|
|
|
} |
2030
|
|
|
|
|
|
|
|
2031
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
=head2 penultpPrime |
2033
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
$pairing->penultpPrime |
2035
|
|
|
|
|
|
|
$pairing->penultpPrime($previousBracket->pprime) |
2036
|
|
|
|
|
|
|
|
2037
|
|
|
|
|
|
|
Gets/sets an accessor to the number of pairs in the penultimate bracket. When this reaches 0, the penultimate and final brackets are joined. C14 |
2038
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
=cut |
2040
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
sub penultpPrime { |
2042
|
58
|
|
|
58
|
1
|
95
|
my $self = shift; |
2043
|
58
|
|
|
|
|
84
|
my $penultpPrime = shift; |
2044
|
58
|
50
|
|
|
|
106
|
if ( defined $penultpPrime ) { $self->{penultpPrime} = $penultpPrime; } |
|
58
|
0
|
|
|
|
96
|
|
2045
|
0
|
|
|
|
|
0
|
elsif ( $self->{penultpPrime} ) { return $self->{penultpPrime}; } |
2046
|
58
|
|
|
|
|
82
|
return; |
2047
|
|
|
|
|
|
|
} |
2048
|
|
|
|
|
|
|
|
2049
|
|
|
|
|
|
|
|
2050
|
|
|
|
|
|
|
=head2 floatCriteriaInForce |
2051
|
|
|
|
|
|
|
|
2052
|
|
|
|
|
|
|
$group->floatCriteriaInForce( $group->floatCheckWaive ) |
2053
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
Given the last criterion at which level checks have been waived, returns an anonymous array of the levels below this level for which checking is still in force. B5,6 C6,9,10 TODO All is nice, but creates problems. |
2055
|
|
|
|
|
|
|
|
2056
|
|
|
|
|
|
|
=cut |
2057
|
|
|
|
|
|
|
|
2058
|
|
|
|
|
|
|
sub floatCriteriaInForce { |
2059
|
272
|
|
|
272
|
1
|
364
|
my $self = shift; |
2060
|
272
|
|
|
|
|
393
|
my $level = shift; |
2061
|
272
|
|
|
|
|
863
|
my @levels = qw/None B6Down B5Down B6Up B5Up All None/; |
2062
|
272
|
|
|
|
|
367
|
my $oldLevel = ''; |
2063
|
272
|
|
|
|
|
1534
|
$oldLevel = shift @levels until $oldLevel eq $level; |
2064
|
272
|
|
|
|
|
646
|
return \@levels; |
2065
|
|
|
|
|
|
|
} |
2066
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
|
2068
|
|
|
|
|
|
|
=head1 AUTHOR |
2069
|
|
|
|
|
|
|
|
2070
|
|
|
|
|
|
|
Dr Bean, C<< >> |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
=head1 BUGS |
2073
|
|
|
|
|
|
|
|
2074
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
2075
|
|
|
|
|
|
|
C, or through the web interface at |
2076
|
|
|
|
|
|
|
L. |
2077
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
2078
|
|
|
|
|
|
|
your bug as I make changes. |
2079
|
|
|
|
|
|
|
|
2080
|
|
|
|
|
|
|
=head1 SUPPORT |
2081
|
|
|
|
|
|
|
|
2082
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
2083
|
|
|
|
|
|
|
|
2084
|
|
|
|
|
|
|
perldoc Games::Tournament::Swiss |
2085
|
|
|
|
|
|
|
|
2086
|
|
|
|
|
|
|
You can also look for information at: |
2087
|
|
|
|
|
|
|
|
2088
|
|
|
|
|
|
|
=over 4 |
2089
|
|
|
|
|
|
|
|
2090
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
2091
|
|
|
|
|
|
|
|
2092
|
|
|
|
|
|
|
L |
2093
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
=item * CPAN Ratings |
2095
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
L |
2097
|
|
|
|
|
|
|
|
2098
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
2099
|
|
|
|
|
|
|
|
2100
|
|
|
|
|
|
|
L |
2101
|
|
|
|
|
|
|
|
2102
|
|
|
|
|
|
|
=item * Search CPAN |
2103
|
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
|
L |
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
=back |
2107
|
|
|
|
|
|
|
|
2108
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
2109
|
|
|
|
|
|
|
|
2110
|
|
|
|
|
|
|
See L for the FIDE's Swiss rules. |
2111
|
|
|
|
|
|
|
|
2112
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
2113
|
|
|
|
|
|
|
|
2114
|
|
|
|
|
|
|
Copyright 2006 Dr Bean, all rights reserved. |
2115
|
|
|
|
|
|
|
|
2116
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
2117
|
|
|
|
|
|
|
under the same terms as Perl itself. |
2118
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
=cut |
2120
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
1; # End of Games::Tournament::Swiss::Procedure |
2122
|
|
|
|
|
|
|
|
2123
|
|
|
|
|
|
|
# vim: set ts=8 sts=4 sw=4 noet: |