version 1.3, 2005/01/24 03:16:35
|
version 3.4, 2013/10/30 20:29:22
|
Line 17 sub readhash
|
Line 17 sub readhash
|
{ |
{ |
print STDERR "\#$number. Score: $score\n",$answer; |
print STDERR "\#$number. Score: $score\n",$answer; |
} |
} |
if ($answer ne "" && $number >0) |
if ($answer ne "" && $number >= 0) |
{ |
{ |
$$answers[$number]->{$answer}->{score} = $score; |
$$answers[$number]->{$answer}->{score} = $score; |
|
%{$$answers[$number]->{$answer}->{teams}} = (); |
} |
} |
$answer = ""; |
$answer = ""; |
$number = $1; |
$number = $1; |
Line 32 sub readhash
|
Line 33 sub readhash
|
} |
} |
if (/^\s*\*\*\*\s*$/) |
if (/^\s*\*\*\*\s*$/) |
{ |
{ |
if ($answer ne "" && $number >0) |
if ($answer ne "" && $number >= 0) |
{ |
{ |
$$answers[$number]->{$answer}->{score} = $score; |
$$answers[$number]->{$answer}->{score} = $score; |
} |
} |
Line 72 sub readmail
|
Line 73 sub readmail
|
$$table{$team}->{'numletters'}++; |
$$table{$team}->{'numletters'}++; |
if ($$table{$team}->{regnum} != $2) |
if ($$table{$team}->{regnum} != $2) |
{ |
{ |
print STDERR "Warning: Team $team uses registration nos. ", |
print STDERR "Warning: Team $team uses registration numbers ", |
$$table{$team}->{regnum}, " and $2!\n"; |
"'" . $$table{$team}->{regnum} . "'", " and '$2'!\n"; |
} |
} |
next; |
next; |
} |
} |
Line 111 sub readmail
|
Line 112 sub readmail
|
# |
# |
sub canonize_answer |
sub canonize_answer |
{ |
{ |
s/^\s*(.*)\s*$/ $1/; |
s/^\s*(.*?)\s*$/ $1/; |
if (/^\s*$/) |
if (/^\s*$/) |
{ |
{ |
return ""; |
return ""; |
Line 128 sub canonize_answer
|
Line 129 sub canonize_answer
|
sub collect_answers |
sub collect_answers |
{ |
{ |
my ($teams,$answers) = @_; |
my ($teams,$answers) = @_; |
for ($i=1;$i<=$MAXQUEST;$i++) |
for ($i=$MINQUEST;$i<=$MAXQUEST;$i++) |
{ |
{ |
foreach $answer (keys %{$$answers[$i]}) |
|
{ |
|
@{$$answers[$i]->{$answer}->{teams}} = (); |
|
} |
|
|
|
foreach $team (keys %$teams) |
foreach $team (keys %$teams) |
{ |
{ |
$answer = $$teams{$team}->{answers}[$i]; |
$answer = $$teams{$team}->{answers}[$i]; |
Line 142 sub collect_answers
|
Line 138 sub collect_answers
|
{ |
{ |
next; |
next; |
} |
} |
if (exists $$answers[$i]->{$answer}) |
$$answers[$i]->{$answer}->{teams}->{$team}=1; |
{ |
if (!exists $$answers[$i]->{$answer}->{score}) |
push @{$$answers[$i]->{$answer}->{teams}}, $team; |
|
} |
|
else |
|
{ |
{ |
my @tmp=($team); |
|
$$answers[$i]->{$answer}->{teams} = \@tmp; |
|
$$answers[$i]->{$answer}->{score} = '?'; |
$$answers[$i]->{$answer}->{score} = '?'; |
} |
} |
} |
} |
foreach $answer (keys %{$$answers[$i]}) |
|
{ |
|
if (scalar @{$$answers[$i]->{$answer}->{teams}} == 0) |
|
{ |
|
delete $$answers[$i]->{$answer}; |
|
} |
|
} |
|
} |
} |
return 1; |
return 1; |
|
|
Line 176 sub dumphash
|
Line 160 sub dumphash
|
if ($$answers[$number]->{$answer}{score} eq $symbol) |
if ($$answers[$number]->{$answer}{score} eq $symbol) |
{ |
{ |
print "\#$number. Frequency: ", |
print "\#$number. Frequency: ", |
scalar @{$answers->[$number]->{$answer}->{teams}}, |
scalar keys %{$answers->[$number]->{$answer}->{teams}}, |
". Score: ", |
". Score: ", |
$$answers[$number]->{$answer}{score},"\n"; |
$$answers[$number]->{$answer}{score},"\n"; |
print $answer; |
print $answer; |
if ($DEBUG) |
if ($DEBUG) |
{ |
{ |
foreach $team (@{$answers->[$number]->{$answer}->{teams}}) |
foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) |
{ |
{ |
print "Team: ", |
print "Team: ", |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
Line 192 sub dumphash
|
Line 176 sub dumphash
|
} |
} |
return 1; |
return 1; |
} |
} |
|
|
# |
# |
# Сбрасываем ответы на вопрос $number с оценкой $symbol |
# Сбрасываем ответы на вопрос $number с оценкой $symbol |
# в формате, пригодном для собрания сочинений |
# в формате, пригодном для собрания сочинений |
Line 203 sub anondump
|
Line 188 sub anondump
|
{ |
{ |
if ($$answers[$number]->{$answer}{score} eq $symbol) |
if ($$answers[$number]->{$answer}{score} eq $symbol) |
{ |
{ |
my $frequency = scalar @{$answers->[$number]->{$answer}->{teams}}; |
my $frequency = scalar keys %{$answers->[$number]->{$answer}->{teams}}; |
my $canon = $answer; |
my $canon = $answer; |
$canon =~ s/^ /$symbol/; |
$canon =~ s/^ /$symbol/; |
if ($frequency >1) |
if ($frequency >1) |
Line 214 sub anondump
|
Line 199 sub anondump
|
print $canon; |
print $canon; |
if ($DEBUG) |
if ($DEBUG) |
{ |
{ |
foreach $team (@{$answers->[$number]->{$answer}->{teams}}) |
foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) |
{ |
{ |
print STDERR "Team: ", |
print STDERR "Team: ", |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
Line 231 sub anondump
|
Line 216 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 241 sub rate_questions
|
Line 226 sub rate_questions
|
if ($$answers[$i]->{$answer}{score} eq '+') |
if ($$answers[$i]->{$answer}{score} eq '+') |
{ |
{ |
$$ratings[$i] -= |
$$ratings[$i] -= |
scalar @{$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 267 sub find_scores
|
Line 253 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 288 sub find_scores
|
Line 277 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}+0 == $num+0, keys %$teams); |
|
print STDERR "\tНомер $num: " . join(", ", @dup_names) . "\n"; |
|
} |
|
print STDERR "\n"; |
|
} |
|
} |
|
|
|
|
|
# |
|
# Считаем ответы на вопрос $number с оценкой $symbol |
|
# (фактически, это anondump(), только без печати списка |
|
# таких ответов). |
|
# |
|
sub countanswers |
|
{ |
|
my ($teams,$answers,$number,$symbol) = @_; |
|
my $num=0; |
|
foreach $answer (keys %{$answers->[$number]}) |
|
{ |
|
if ($$answers[$number]->{$answer}{score} eq $symbol) |
|
{ |
|
$num++; |
|
} |
|
} |
|
return $num; |
|
} |
|
|
|
|
|
1; |