# В этот файл собраны процедуры, общие для всей системы
# работы с ответами.
#
#$Id: subroutines.pl,v 1.5 2005/02/16 22:20:08 boris Exp $
#
sub readhash
{
my ($answers) = @_;
my $answer = "";
my $score = "";
my $number = -1;
while (<INFILE>)
{
if (/^\s*\#(\d+).*Score:\s*([+-\?])/) # Нашли новый ответ
{
if ($DEBUG)
{
print STDERR "\#$number. Score: $score\n",$answer;
}
if ($answer ne "" && $number >0)
{
$$answers[$number]->{$answer}->{score} = $score;
%{$$answers[$number]->{$answer}->{teams}} = ();
}
$answer = "";
$number = $1;
$score = $2;
next;
}
if (/^Team:/)
{
next;
}
if (/^\s*\*\*\*\s*$/)
{
if ($answer ne "" && $number >0)
{
$$answers[$number]->{$answer}->{score} = $score;
}
last;
}
$answer .= &canonize_answer;
}
return 1;
}
#
# Читаем файл с письмами команд
#
sub readmail
{
my ($table) = @_;
$team="";
$number=-1;
while (<INFILE>)
{
if (/^\s*\*\*\*\s*"(.+)"\s*[,.]*\s*(\d+)*/) # Нашли новую команду
{
if ($DEBUG)
{
print STDERR "Команда: $1, рег. номер: $2\n";
}
$team = $1;
$number = -1;
if (!exists($$table{$team})) # Новая команда...
{
my @teamanswers = ();
my %teamhash = ('answers' => \@teamanswers,
'regnum' => $2,
'numletters'=>0);
$$table{$team} = \%teamhash;
}
$$table{$team}->{'numletters'}++;
if ($$table{$team}->{regnum} != $2)
{
print STDERR "Warning: Team $team uses registration nos. ",
$$table{$team}->{regnum}, " and $2!\n";
}
next;
}
if (s/^\s*\#(\d+)\.*// && $team ne "")
{
if ($DEBUG)
{
print STDERR "Ответ $1\n";
print STDERR;
}
$number = $1;
$$table{$team}->{answers}[$number] = &canonize_answer;
next;
}
if (/^\*\*\*/) # Команда кончилась
{
$team="";
$number=-1;
}
if ($team ne "" && $number >0)
{
if ($DEBUG)
{
print STDERR;
}
$$table{$team}->{answers}[$number] .= &canonize_answer;
}
}
return 1;
}
#
# Приводим ответ к канонической форме: два пробела в начале,
# ни одного в конце
#
sub canonize_answer
{
s/^\s*(.*)\s*$/ $1/;
if (/^\s*$/)
{
return "";
}
else
{
return $_."\n";
}
}
#
# Заполняем поля %answers
#
sub collect_answers
{
my ($teams,$answers) = @_;
for ($i=1;$i<=$MAXQUEST;$i++)
{
foreach $team (keys %$teams)
{
$answer = $$teams{$team}->{answers}[$i];
if ($answer eq "")
{
next;
}
$$answers[$i]->{$answer}->{teams}->{$team}=1;
if (!exists $$answers[$i]->{$answer}->{score})
{
$$answers[$i]->{$answer}->{score} = '?';
}
}
}
return 1;
}
#
# Сбрасываем ответы на вопрос $number с оценкой $symbol
#
sub dumphash
{
my ($teams,$answers,$number,$symbol) = @_;
foreach $answer (keys %{$answers->[$number]})
{
if ($$answers[$number]->{$answer}{score} eq $symbol)
{
print "\#$number. Frequency: ",
scalar keys %{$answers->[$number]->{$answer}->{teams}},
". Score: ",
$$answers[$number]->{$answer}{score},"\n";
print $answer;
if ($DEBUG)
{
foreach $team (keys %{$answers->[$number]->{$answer}->{teams}})
{
print "Team: ",
" \"$team\", ",$$teams{$team}->{regnum}, "\n";
}
}
}
}
return 1;
}
#
# Сбрасываем ответы на вопрос $number с оценкой $symbol
# в формате, пригодном для собрания сочинений
#
sub anondump
{
my ($teams,$answers,$number,$symbol) = @_;
foreach $answer (keys %{$answers->[$number]})
{
if ($$answers[$number]->{$answer}{score} eq $symbol)
{
my $frequency = scalar keys %{$answers->[$number]->{$answer}->{teams}};
my $canon = $answer;
$canon =~ s/^ /$symbol/;
if ($frequency >1)
{
chomp $canon;
$canon .= " [$frequency]\n";
}
print $canon;
if ($DEBUG)
{
foreach $team (keys %{$answers->[$number]->{$answer}->{teams}})
{
print STDERR "Team: ",
" \"$team\", ",$$teams{$team}->{regnum}, "\n";
}
}
}
}
return 1;
}
#
# Подсчитываем рейтинги вопросов. Рейтинг вопроса есть
# 1+количество команд, которые на него НЕ ответили
#
sub rate_questions
{
my($teams,$answers,$ratings,$round) = @_;
my $numteams = scalar keys %$teams;
for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++)
{
$$ratings[$i]=$numteams+1;
foreach $answer (keys %{$$answers[$i]})
{
if ($$answers[$i]->{$answer}{score} eq '+')
{
$$ratings[$i] -=
scalar keys %{$answers->[$i]->{$answer}->{teams}} ;
if ($DEBUG) {
print STDERR "Частота ответа $answer",
scalar keys %{$answers->[$i]->{$answer}->{teams}},
"\n";
}
}
}
}
}
#
# Подсчитываем рейтинги команд
#
sub find_scores
{
my ($teams,$answers,$ratings,$round,$factor) = @_;
foreach $team (keys %$teams)
{
if (!defined($factor)) {
$factor=1;
}
$$teams{$team}->{score} *=$factor;
$$teams{$team}->{rating} = 0;
for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++)
{
my $answer=$$teams{$team}->{answers}[$i];
if ($$answers[$i]->{$answer}{score} eq '+')
{
$$teams{$team}->{score} += 1;
$$teams{$team}->{rating} +=
$$ratings[$i];
}
}
if ($DEBUG)
{
print STDERR "$team: Score ",
$$teams{$team}->{score},
", Rating ",
$$teams{$team}->{rating},"\n";
}
}
}
1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>