Diff for /processmail/createtable.pl between versions 1.3 and 3.3

version 1.3, 2005/02/16 22:20:08 version 3.3, 2013/10/11 15:39:35
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;
   
 my %teams;  my %teams;
 my @answers;  my @answers;
Line 55  for (my $i=1; $i<=$ROUNDS; $i++) { Line 56  for (my $i=1; $i<=$ROUNDS; $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=1;$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 147  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 165  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 198  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=$j*$nline+1; $i<=$max; $i++){
                 printf("%3s",$i);                  printf("%3s",$i);
             }              }
             printf "\n";              printf "\n";
             for ($i=1+$j*12;$i<=$max;$i++){              for ($i=$j*$nline+1; $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];
         }          }
Line 156  for (my $r=1; $r<=$ROUNDS; $r++) { Line 230  for (my $r=1; $r<=$ROUNDS; $r++) {
     }      }
     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);

Removed from v.1.3  
changed lines
  Added in v.3.3


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>