#!/usr/bin/perl
#$Id: createtable.pl,v 3.4 2013/10/30 19:28:30 boris Exp $
#
#
#
# Исходные файлы и параметры
#
use Getopt::Std;
$usage =
"Usage: createtable.pl [-d] [-s|-m] [-t answers_file] [-o results] \n";
require 'parameters.pl';
require 'subroutines.pl';
die $usage unless getopts('t:o:dsm');
$DEBUG=$opt_d;
$SHORT=$opt_s;
$MEDIUM=$opt_m;
# Находим максимальный и минимальный вопрос и слегка подстраховываемся.
$MINQUEST=1e99;
$MAXQUEST=-1;
for (my $r=1; $r<=$ROUNDS; $r++) {
if ($MINQUEST>$MINQUEST[$r]) {
$MINQUEST=$MINQUEST[$r];
}
if ($MAXQUEST<$MAXQUEST[$r]) {
$MAXQUEST=$MAXQUEST[$r];
}
}
if ($MINQUEST < 0 || $MAXQUEST < 0) {
die "Отрицательные номера вопросов не поддерживаются!\n";
}
my %teams;
my @answers;
my @ratings;
#
# Читаем старые результаты
#
if ($opt_t) {
die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
} else {
*INFILE=*STDIN;
}
readhash(\@answers);
close(INFILE);
#
# Открываем файл для записи
#
if ($opt_o) {
die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
select OUTFILE;
}
#
# Таблица подводится отдельно по каждому раунду
#
my @nopoint_questions; # Здесь будут внезачётные вопросы
my @unknowns; # Сюда запомним все '?'
for (my $r=1; $r<=$ROUNDS; $r++) {
if ($DEBUG) {
print STDERR "Раунд $r\n";
}
#
# Удаляем старые рейтинги (Ivan A Derzhanski <iad58@mail.ru>)
#
for ($i=$MINQUEST;$i<=$MAXQUEST;$i++) {
foreach $answer (keys %{$answers[$i]}) {
%{$answers[$i]->{$answer}->{teams}} = ();
}
}
#
# Читаем ответы в данном раунде
#
foreach my $file ( @{$FILES[$r]} ) {
open (INFILE, $file);
readmail(\%teams);
collect_answers(\%teams,\@answers);
close (INFILE);
}
#
# Дополняем (добавляем к имеющемуся!) список вопросов, идущих вне зачёта
# в данном туре. Для них проставляются плюсы и минусы, но они не входят
# в суммарный результат и рейтинг команд.
#
foreach my $num ( @{$NOCOUNT[$r]} )
{
# Если номер не начинается с минуса, то включить его в список
# внезачётных, иначе - исключить. Проверяем регэкспом, а не на
# "> 0", чтобы можно было использовать и "-0".
if ($num =~ /^\d+/) {
push @nopoint_questions, $num;
} else {
@nopoint_questions = grep( $_ != -$num, @nopoint_questions );
}
}
# И удаляем возможные дубликаты, чтобы всё было красиво.
my %seen;
@nopoint_questions = grep( !$seen{$_}++, @nopoint_questions );
#
# Подсчитываем рейтинги вопросов
#
rate_questions(\%teams,\@answers,\@ratings,$r);
#
# Вычисляем число ответов и рейтинги команд
#
find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions);
#
# Ну а теперь печатаем саму таблицу...
#
#
# Печатаем заголовок
#
# Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")
my $COL=5;
print "ЗАЧЁТ $NAME[$r]\n";
if ( @nopoint_questions ) {
# Есть незачётные вопросы - печатаем их список.
print "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "")
. ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n";
}
printf "%5s ", "N";
for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
{
if ($SHORT) {
printf("%1d",$i%10);
} elsif ($MEDIUM) {
if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) {
printf "%-3d", $i;
} else {
printf "%s", ".";
}
} else {
printf "%3d",$i;
}
}
printf "%6s","О";
printf "%4s","Р";
printf " КОМАНДА";
print "\n";
#
# Печатаем команды построчно
#
foreach $team (sort
{
$teams{$b}->{score} <=> $teams{$a}->{score}
or
$teams{$b}->{rating} <=> $teams{$a}->{rating}
} keys %teams
)
{
printf "%5d ",$teams{$team}->{regnum};
for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
{
my $answer = $teams{$team}->{answers}[$i];
my $score = $answers[$i]->{$answer}->{score};
$score = '-' unless $score;
# Особо пометим взятые внезачётные вопросы.
if ( $score eq '+' && grep($_==$i, @nopoint_questions) ) {
$score = 'X';
}
# И запомним, если вопрос не взят и не не взят ;-).
if ( $score eq '?' ) {
my $unk = {
question => $i,
score => $score,
team => $team,
regnum => $teams{$team}->{regnum},
round => $r,
};
push( @unknowns, $unk );
}
# Ну наконец-то! Печатаем.
if ($SHORT) {
printf "%1s",$score;
} elsif ($MEDIUM) {
printf "%1s",$score;
print " " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]);
} else {
printf "%3s", $score;
}
}
printf "%6.2f",$teams{$team}->{score};
printf "%4s",$teams{$team}->{rating};
print " $team";
print "\n";
}
#
# Печатаем рейтинги вопросов - длинный или короткий варианты.
#
if ($SHORT || $MEDIUM) {
my $nline = 24; # По $nline рейтингов в строке
print "\nРейтинг\n";
for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) {
my $max = $j*$nline + $nline;
if ($max>$MAXQUEST[$r]) {
$max=$MAXQUEST[$r];
}
for ($i=$MINQUEST[$r]+$j*$nline; $i<=$max; $i++){
printf("%3s",$i);
}
printf "\n";
for ($i=$MINQUEST[$r]+$j*$nline; $i<=$max; $i++){
printf("%3s",$ratings[$i]);
}
printf "\n";
}
} else {
# Длинный вариант - под каждым вопросом.
printf "%5s ", "Р";
for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++)
{
printf "%3s", $ratings[$i];
}
print "\n";
}
print "\n";
print "\n"; # LG: One more for better readability
}
# Печатаем предупреждение если есть неясные ответы.
if ( @unknowns ) {
print STDERR "ВНИМАНИЕ! Не всем ответам проставлены '+' и '-':\n";
foreach my $unk ( @unknowns ) {
print STDERR "\tКоманда $unk->{team} ($unk->{regnum}), "
. "вопрос $unk->{question} ($NAME[$unk->{round}]): "
. "$unk->{score}\n";
}
}
# На всякий случай проверяем на наличие команд с дублирующимися номерами.
check_dup_numbers(\%teams);
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>