[BACK]Return to createtable.pl CVS log [TXT] [DIR] Up to [Local Repository] / processmail

Diff for /processmail/createtable.pl between versions 1.1 and 3.1

version 1.1, 2002/02/04 15:44:51 version 3.1, 2008/03/24 16:01:47
Line 6 Line 6
 # Исходные файлы и параметры  # Исходные файлы и параметры
 #  #
   
     use Getopt::Std;   use Getopt::Std; 
   
 $usage = 'createtable.pl $Revision$, $Date$'. "\n".  $usage = 
 "Usage: createtable.pl [-d] [-t answers_file] [-m mail_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:m:o:d');  die $usage unless getopts('t:o:dsm');
   
 $DEBUG=$opt_d;  $DEBUG=$opt_d;
   $SHORT=$opt_s;
   $MEDIUM=$opt_m;
   
 my %teams;  my %teams;
 my @answers;  my @answers;
Line 24  my @ratings; Line 26  my @ratings;
 #  #
 # Читаем старые результаты  # Читаем старые результаты
 #  #
 if ($opt_t)  if ($opt_t) {
 {  
     die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);      die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
     readhash(\@answers);  } else {
     close(INFILE);     *INFILE=*STDIN;
 }  }
       
 #  readhash(\@answers);
 # Читаем ответы команд  
 #  
 if ($opt_m)  
 {  
     die "Cannot open $opt_m\n" unless open(INFILE,$opt_m)  
 }  
 else  
 {  
     *INFILE=*STDIN;  
 }  
 readmail(\%teams);  
 close(INFILE);  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");      die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
     select OUTFILE;      select OUTFILE;
 }  }
   
   # Находим максимальный вопрос
   $MAXQUEST=1;
   for (my $i=1; $i<=$ROUNDS; $i++) {
       if ($MAXQUEST<$MAXQUEST[$i]) {
           $MAXQUEST=$MAXQUEST[$i];
       }
   }
   
   
 #  #
 # Печатаем заголовок  # Таблица подводится отдельно по каждому раунду
 #  #
 printf "%5s", "N";  my @nopoint_questions;                  # Здесь будут внезачётные вопросы
 for ($i=1;$i<=$MAXQUEST;$i++)  my @unknowns;                           # Сюда запомним все '?'
 {  for (my $r=1; $r<=$ROUNDS; $r++) {
     printf "%3d",$i;      if ($DEBUG) {
 }          print STDERR "Раунд $r\n";
 printf "%3s","О";      }
 printf "%4s","Р";  
 printf " КОМАНДА";      #
 print "\n";      #  Читаем ответы в данном раунде
 #      #
 # Печатаем команды построчно      foreach my $file ( @{$FILES[$r]} ) {
 #          open (INFILE, $file);
 foreach $team (sort           readmail(\%teams);
                 {          collect_answers(\%teams,\@answers);
                     $teams{$b}->{score} <=> $teams{$a}->{score}          close (INFILE);
                     or      }
                         $teams{$b}->{rating} <=> $teams{$a}->{rating}  
                 } keys %teams      #
                )      # Дополняем (добавляем к имеющемуся!) список вопросов, идущих вне зачёта
 {      # в данном туре.  Для них проставляются плюсы и минусы, но они не входят
     printf "%5d",$teams{$team}->{regnum};      # в суммарный результат и рейтинг команд.
     for ($i=1;$i<=$MAXQUEST;$i++)      #
       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];          if ($SHORT) {
         my $score = $answers[$i]->{$answer}->{score};              printf("%1d",$i%10);
         $score = '-' unless $score;          } elsif ($MEDIUM) {
             printf "%3s", $score;              if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) {
     }                  printf "%-3d", $i;
     printf "%3s",$teams{$team}->{score};              } else {
     printf "%4s",$teams{$team}->{rating};                  printf "%s", ".";
     print " $team";              }
           } 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=$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";      print "\n";
 }  }
 #  
 # Печатаем последнюю строку таблицы  
 # в ней рейтинги вопросов  
 #  
 printf "%5s", "Р";  
 for ($i=1; $i<=$MAXQUEST;$i++)  
 {  
         printf "%3s", $ratings[$i];  
 }  
 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.1  
changed lines
  Added in v.3.1

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