version 1.4, 2005/02/15 19:27:51
|
version 3.1, 2008/03/24 16:01:47
|
Line 215 sub anondump
|
Line 215 sub anondump
|
# |
# |
sub rate_questions |
sub rate_questions |
{ |
{ |
my($teams,$answers,$ratings) = @_; |
my($teams,$answers,$ratings,$round) = @_; |
my $numteams = scalar keys %$teams; |
my $numteams = scalar keys %$teams; |
for ($i=1;$i<=$MAXQUEST;$i++) |
for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++) |
{ |
{ |
$$ratings[$i]=$numteams+1; |
$$ratings[$i]=$numteams+1; |
foreach $answer (keys %{$$answers[$i]}) |
foreach $answer (keys %{$$answers[$i]}) |
Line 225 sub rate_questions
|
Line 225 sub rate_questions
|
if ($$answers[$i]->{$answer}{score} eq '+') |
if ($$answers[$i]->{$answer}{score} eq '+') |
{ |
{ |
$$ratings[$i] -= |
$$ratings[$i] -= |
scalar keys %{$answers->[$i]->{$answer}->{teams}} ; |
scalar keys %{$answers->[$i]->{$answer}->{teams}} ; |
|
if ($DEBUG) { |
|
print STDERR "Частота ответа $answer", |
|
scalar keys %{$answers->[$i]->{$answer}->{teams}}, |
|
"\n"; |
|
} |
} |
} |
} |
} |
} |
} |
if ($DEBUG) |
|
{ |
|
for ($i=1;$i<=$MAXQUEST;$i++) |
|
{ |
|
print STDERR "Вопрос $i, Рейтинг: ", $$ratings[$i], "\n"; |
|
} |
|
} |
|
} |
} |
|
|
# |
# |
# Подсчитываем рейтинги команд |
# Подсчитываем рейтинги команд |
|
# @{$nopoint_questions} - список номеров вопросов, идущих вне зачёта. |
|
# Для них проставляются плясы/минусы, но они не учитываются в подсчёте |
|
# очков и рейтингов команд. |
# |
# |
sub find_scores |
sub find_scores |
{ |
{ |
my ($teams,$answers,$ratings,$factor) = @_; |
my ($teams,$answers,$ratings,$round,$factor,$nopoint_questions) = @_; |
foreach $team (keys %$teams) |
foreach $team (keys %$teams) |
{ |
{ |
if (!defined($factor)) { |
if (!defined($factor)) { |
Line 251 sub find_scores
|
Line 252 sub find_scores
|
} |
} |
$$teams{$team}->{score} *=$factor; |
$$teams{$team}->{score} *=$factor; |
$$teams{$team}->{rating} = 0; |
$$teams{$team}->{rating} = 0; |
for ($i=1;$i<=$MAXQUEST;$i++) |
for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++) |
{ |
{ |
my $answer=$$teams{$team}->{answers}[$i]; |
my $answer=$$teams{$team}->{answers}[$i]; |
if ($$answers[$i]->{$answer}{score} eq '+') |
if ($$answers[$i]->{$answer}{score} eq '+') |
{ |
{ |
|
next if ( @{$nopoint_questions} && |
|
grep($_==$i, @{$nopoint_questions}) |
|
); |
$$teams{$team}->{score} += 1; |
$$teams{$team}->{score} += 1; |
$$teams{$team}->{rating} += |
$$teams{$team}->{rating} += |
$$ratings[$i]; |
$$ratings[$i]; |
Line 272 sub find_scores
|
Line 276 sub find_scores
|
} |
} |
|
|
|
|
1; |
# |
|
# Проверяем на наличие дублирующихся номеров у разных команд. |
|
# |
|
sub check_dup_numbers |
|
{ |
|
my ($teams) = @_; |
|
|
|
|
|
|
|
|
|
|
|
my %seen; |
|
|
|
# Имена команд, номера которых встречаются >1 раза. |
|
# Массив uniq_compr_names содержит по одному имени на каждый повторяющийся |
|
# номер (чуть позже мы найдём все имена, соответствующие каждому из |
|
# этих номеров). |
|
# '+0' - чтобы номера обрабатывались как числа (072 == 72). |
|
my @uniq_compr_names = |
|
grep( $seen{$teams->{$_}->{regnum}+0}++ > 1, keys %$teams ); |
|
|
|
# А теперь извлекаем номера из полученного списка. |
|
my @dup_numbers = map {$teams->{$_}->{regnum}} @uniq_compr_names; |
|
@dup_numbers = sort @dup_numbers; |
|
|
|
# И печатаем предупреждение. |
|
if ( @dup_numbers ) { |
|
print STDERR "\nВНИМАНИЕ! Одинаковые номера у нескольких команд:\n"; |
|
foreach my $num ( @dup_numbers ) { |
|
my @dup_names = grep($teams->{$_}->{regnum} == $num, keys %$teams); |
|
print STDERR "\tНомер $num: " . join(", ", @dup_names) . "\n"; |
|
} |
|
print STDERR "\n"; |
|
} |
|
} |
|
|
|
|
|
|
|
1; |