version 1.3, 2005/02/16 22:20:08
|
version 3.4, 2013/10/30 19:28:30
|
Line 1
|
Line 1
|
#!/usr/local/bin/perl |
#!/usr/bin/perl |
#$Id$ |
#$Id$ |
# |
# |
# |
# |
Line 9
|
Line 9
|
use Getopt::Std; |
use Getopt::Std; |
|
|
$usage = |
$usage = |
"Usage: createtable.pl [-d] [-s] [-t answers_file] [-o results] \n"; |
"Usage: createtable.pl [-d] [-s|-m] [-t answers_file] [-o results] \n"; |
|
|
require 'parameters.pl'; |
require 'parameters.pl'; |
require 'subroutines.pl'; |
require 'subroutines.pl'; |
|
|
die $usage unless getopts('t:o:ds'); |
die $usage unless getopts('t:o:dsm'); |
|
|
$DEBUG=$opt_d; |
$DEBUG=$opt_d; |
$SHORT=$opt_s; |
$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 %teams; |
my @answers; |
my @answers; |
Line 43 if ($opt_o) {
|
Line 59 if ($opt_o) {
|
select OUTFILE; |
select OUTFILE; |
} |
} |
|
|
# Находим максимальный вопрос |
|
$MAXQUEST=1; |
|
for (my $i=1; $i<=$ROUNDS; $i++) { |
|
if ($MAXQUEST<$MAXQUEST[$i]) { |
|
$MAXQUEST=$MAXQUEST[$i]; |
|
} |
|
} |
|
|
|
|
|
# |
# |
# Таблица подводится отдельно по каждому раунду |
# Таблица подводится отдельно по каждому раунду |
# |
# |
|
my @nopoint_questions; # Здесь будут внезачётные вопросы |
|
my @unknowns; # Сюда запомним все '?' |
for (my $r=1; $r<=$ROUNDS; $r++) { |
for (my $r=1; $r<=$ROUNDS; $r++) { |
if ($DEBUG) { |
if ($DEBUG) { |
print STDERR "Раунд $r\n"; |
print STDERR "Раунд $r\n"; |
} |
} |
# |
|
# Читаем ответы в данном раунде |
|
# |
|
|
|
foreach my $file (split /\s+/, $FILES[$r]) { |
# |
|
# Удаляем старые рейтинги (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); |
open (INFILE, $file); |
readmail(\%teams); |
readmail(\%teams); |
collect_answers(\%teams,\@answers); |
collect_answers(\%teams,\@answers); |
close (INFILE); |
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); |
rate_questions(\%teams,\@answers,\@ratings,$r); |
# |
|
# Вычисляем число ответов и рейтинги команд |
# |
# |
# Вычисляем число ответов и рейтинги команд |
find_scores(\%teams,\@answers,\@ratings,$r,0.01); |
# |
# |
find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions); |
# Ну а теперь печатаем саму таблицу... |
|
# |
# |
# |
# Ну а теперь печатаем саму таблицу... |
# Печатаем заголовок |
# |
# |
# |
|
# Печатаем заголовок |
|
# |
|
# Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+") |
|
my $COL=5; |
|
|
print "ЗАЧЁТ $NAME[$r]\n"; |
print "ЗАЧЁТ $NAME[$r]\n"; |
|
if ( @nopoint_questions ) { |
|
# Есть незачётные вопросы - печатаем их список. |
|
print "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "") |
|
. ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n"; |
|
} |
|
|
printf "%5s ", "N"; |
printf "%5s ", "N"; |
for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++) |
for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++) |
{ |
{ |
if ($SHORT) { |
if ($SHORT) { |
printf("%1d",$i%10); |
printf("%1d",$i%10); |
|
} elsif ($MEDIUM) { |
|
if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) { |
|
printf "%-3d", $i; |
|
} else { |
|
printf "%s", "."; |
|
} |
} else { |
} else { |
printf "%3d",$i; |
printf "%3d",$i; |
} |
} |
Line 98 for (my $r=1; $r<=$ROUNDS; $r++) {
|
Line 153 for (my $r=1; $r<=$ROUNDS; $r++) {
|
printf "%4s","Р"; |
printf "%4s","Р"; |
printf " КОМАНДА"; |
printf " КОМАНДА"; |
print "\n"; |
print "\n"; |
# |
|
# Печатаем команды построчно |
# |
# |
# Печатаем команды построчно |
|
# |
foreach $team (sort |
foreach $team (sort |
{ |
{ |
$teams{$b}->{score} <=> $teams{$a}->{score} |
$teams{$b}->{score} <=> $teams{$a}->{score} |
Line 115 for (my $r=1; $r<=$ROUNDS; $r++) {
|
Line 171 for (my $r=1; $r<=$ROUNDS; $r++) {
|
my $answer = $teams{$team}->{answers}[$i]; |
my $answer = $teams{$team}->{answers}[$i]; |
my $score = $answers[$i]->{$answer}->{score}; |
my $score = $answers[$i]->{$answer}->{score}; |
$score = '-' unless $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) { |
if ($SHORT) { |
printf "%1s",$score; |
printf "%1s",$score; |
|
} elsif ($MEDIUM) { |
|
printf "%1s",$score; |
|
print " " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]); |
} else { |
} else { |
printf "%3s", $score; |
printf "%3s", $score; |
} |
} |
Line 126 for (my $r=1; $r<=$ROUNDS; $r++) {
|
Line 204 for (my $r=1; $r<=$ROUNDS; $r++) {
|
print " $team"; |
print " $team"; |
print "\n"; |
print "\n"; |
} |
} |
# |
|
# Печатаем последнюю строку таблицы |
# |
# в ней рейтинги вопросов |
# Печатаем рейтинги вопросов - длинный или короткий варианты. |
# |
# |
if ($SHORT) { |
if ($SHORT || $MEDIUM) { |
print "Рейтинг\n"; |
my $nline = 24; # По $nline рейтингов в строке |
for ($j=0;$j<$MAXQUEST[$r]/12;$j++) { |
print "\nРейтинг\n"; |
my $max=$j*12+12; |
for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) { |
|
my $max = $j*$nline + $nline; |
if ($max>$MAXQUEST[$r]) { |
if ($max>$MAXQUEST[$r]) { |
$max=$MAXQUEST[$r]; |
$max=$MAXQUEST[$r]; |
} |
} |
for ($i=$j*12+1;$i<=$max;$i++){ |
for ($i=$MINQUEST[$r]+$j*$nline; $i<=$max; $i++){ |
printf("%3s",$i); |
printf("%3s",$i); |
} |
} |
printf "\n"; |
printf "\n"; |
for ($i=1+$j*12;$i<=$max;$i++){ |
for ($i=$MINQUEST[$r]+$j*$nline; $i<=$max; $i++){ |
printf("%3s",$ratings[$i]); |
printf("%3s",$ratings[$i]); |
} |
} |
printf "\n"; |
printf "\n"; |
} |
} |
} else { |
} else { |
|
# Длинный вариант - под каждым вопросом. |
printf "%5s ", "Р"; |
printf "%5s ", "Р"; |
for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r];$i++) |
for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++) |
{ |
{ |
printf "%3s", $ratings[$i]; |
printf "%3s", $ratings[$i]; |
} |
} |
print "\n"; |
print "\n"; |
} |
} |
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); |