--- processmail/createtable.pl 2002/02/04 16:23:23 1.2 +++ processmail/createtable.pl 2013/10/11 15:39:35 3.3 @@ -1,23 +1,24 @@ -#!/usr/local/bin/perl -#$Id: createtable.pl,v 1.2 2002/02/04 16:23:23 boris Exp $ +#!/usr/bin/perl +#$Id: createtable.pl,v 3.3 2013/10/11 15:39:35 boris Exp $ # # # # Исходные файлы и параметры # - use Getopt::Std; +use Getopt::Std; -$usage = 'createtable.pl $Revision: 1.2 $, $Date: 2002/02/04 16:23:23 $'. "\n". -"Usage: createtable.pl [-d] [-s] [-t answers_file] [-m mail_file] [-o results] \n"; +$usage = +"Usage: createtable.pl [-d] [-s|-m] [-t answers_file] [-o results] \n"; require 'parameters.pl'; require 'subroutines.pl'; -die $usage unless getopts('t:m:o:ds'); +die $usage unless getopts('t:o:dsm'); $DEBUG=$opt_d; $SHORT=$opt_s; +$MEDIUM=$opt_m; my %teams; my @answers; @@ -25,115 +26,220 @@ my @ratings; # # Читаем старые результаты # -if ($opt_t) -{ +if ($opt_t) { die "Cannot open $opt_t\n" unless open(INFILE,$opt_t); - readhash(\@answers); - close(INFILE); -} - -# -# Читаем ответы команд -# -if ($opt_m) -{ - die "Cannot open $opt_m\n" unless open(INFILE,$opt_m) -} -else -{ - *INFILE=*STDIN; +} else { + *INFILE=*STDIN; } -readmail(\%teams); + +readhash(\@answers); close(INFILE); + + # -# Чистим хэш %answers -# -collect_answers(\%teams,\@answers); -# -# Подсчитываем рейтинги вопросов -# -rate_questions(\%teams,\@answers,\@ratings); -# -# Вычисляем число ответов и рейтинги команд -# -find_scores(\%teams,\@answers,\@ratings); -# -# Ну а теперь печатаем саму таблицу... +# Открываем файл для записи # -if ($opt_o) -{ +if ($opt_o) { die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o"); select OUTFILE; } + +# Находим максимальный вопрос +$MAXQUEST=1; +for (my $i=1; $i<=$ROUNDS; $i++) { + if ($MAXQUEST<$MAXQUEST[$i]) { + $MAXQUEST=$MAXQUEST[$i]; + } +} + + # -# Печатаем заголовок +# Таблица подводится отдельно по каждому раунду # -printf "%5s ", "N"; -for ($i=1;$i<=$MAXQUEST;$i++) -{ - if ($SHORT) { - printf("%1d",$i%10); - } else { - printf "%3d",$i; +my @nopoint_questions; # Здесь будут внезачётные вопросы +my @unknowns; # Сюда запомним все '?' +for (my $r=1; $r<=$ROUNDS; $r++) { + if ($DEBUG) { + print STDERR "Раунд $r\n"; } -} -printf "%3s","О"; -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=1;$i<=$MAXQUEST;$i++) + + # + # Удаляем старые рейтинги (Ivan A Derzhanski ) + # + for ($i=1;$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++) { - my $answer = $teams{$team}->{answers}[$i]; - my $score = $answers[$i]->{$answer}->{score}; - $score = '-' unless $score; if ($SHORT) { - printf "%1s",$score; + printf("%1d",$i%10); + } elsif ($MEDIUM) { + if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) { + printf "%-3d", $i; + } else { + printf "%s", "."; + } } else { - printf "%3s", $score; + printf "%3d",$i; } } - printf "%3s",$teams{$team}->{score}; - printf "%4s",$teams{$team}->{rating}; - print " $team"; + printf "%6s","О"; + printf "%4s","Р"; + printf " КОМАНДА"; print "\n"; -} -# -# Печатаем последнюю строку таблицы -# в ней рейтинги вопросов -# -if ($SHORT) { - print "Рейтинг\n"; - for ($j=0;$j<$MAXQUEST/12;$j++) { - my $max=$j*12+12; - if ($max>$MAXQUEST) { - $max=$MAXQUEST; - } - for ($i=$j*12+1;$i<=$max;$i++){ - printf("%3s",$i); - } - printf "\n"; - for ($i=1+$j*12;$i<=$max;$i++){ - printf("%3s",$ratings[$i]); + + # + # Печатаем команды построчно + # + 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 "\n"; + printf "%6.2f",$teams{$team}->{score}; + printf "%4s",$teams{$team}->{rating}; + print " $team"; + print "\n"; } -} else { - printf "%5s ", "Р"; - for ($i=1; $i<=$MAXQUEST;$i++) - { - printf "%3s", $ratings[$i]; + + # + # Печатаем рейтинги вопросов - длинный или короткий варианты. + # + 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=$j*$nline+1; $i<=$max; $i++){ + printf("%3s",$i); + } + printf "\n"; + for ($i=$j*$nline+1; $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"; } + + +# Печатаем предупреждение если есть неясные ответы. +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);