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

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

version 3.0, 2008/03/23 17:50:49 version 3.3, 2013/10/11 15:39:35
Line 1 Line 1
 #!/usr/local/bin/perl  #!/usr/bin/perl
 #$Id$  #$Id$
 #  #
 #  #
Line 56  for (my $i=1; $i<=$ROUNDS; $i++) { Line 56  for (my $i=1; $i<=$ROUNDS; $i++) {
 #  #
 # Таблица подводится отдельно по каждому раунду  # Таблица подводится отдельно по каждому раунду
 #  #
 my @nopoint_questions;  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";
     }      }
 #  
 #  Читаем ответы в данном раунде  
 #  
   
       #
       #  Удаляем старые рейтинги (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]} ) {      foreach my $file ( @{$FILES[$r]} ) {
         open (INFILE, $file);          open (INFILE, $file);
         readmail(\%teams);          readmail(\%teams);
Line 72  for (my $r=1; $r<=$ROUNDS; $r++) { Line 82  for (my $r=1; $r<=$ROUNDS; $r++) {
         close (INFILE);          close (INFILE);
     }      }
   
 #      #
 # Дополняем (добавляем к имеющемуся) список вопросов, идущих вне зачёта      # Дополняем (добавляем к имеющемуся!) список вопросов, идущих вне зачёта
 # в данном туре.  Для них проставляются плюсы и минусы, но они не входят      # в данном туре.  Для них проставляются плюсы и минусы, но они не входят
 # в суммарный результат и рейтинг команд.      # в суммарный результат и рейтинг команд.
 #      #
     foreach my $num ( @{$NOCOUNT[$r]} )      foreach my $num ( @{$NOCOUNT[$r]} )
     {      {
         # Если номер не начинается с минуса, то включить его в список          # Если номер не начинается с минуса, то включить его в список
Line 92  for (my $r=1; $r<=$ROUNDS; $r++) { Line 102  for (my $r=1; $r<=$ROUNDS; $r++) {
     my %seen;      my %seen;
     @nopoint_questions = grep( !$seen{$_}++, @nopoint_questions );      @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,\@nopoint_questions);      find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions);
 #  
 # Ну а теперь печатаем саму таблицу...      #
 #      # Ну а теперь печатаем саму таблицу...
 #      #
 # Печатаем заголовок      #
 #      # Печатаем заголовок
       #
     # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")      # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")
     my $COL=5;      my $COL=5;
   
Line 135  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 152  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;
             $score = 'X'   
                 if ( $score eq '+' && @nopoint_questions &&               # Особо пометим взятые внезачётные вопросы.
                      grep($_==$i, @nopoint_questions)              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) {              } elsif ($MEDIUM) {
Line 170  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 || $MEDIUM) {      if ($SHORT || $MEDIUM) {
         my $nline = 12;                         # По 12 рейтингов в строке          my $nline = 24;                         # По $nline рейтингов в строке
         print "\nРейтинг\n";          print "\nРейтинг\n";
         for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) {          for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) {
             my $max = $j*$nline + $nline;              my $max = $j*$nline + $nline;
Line 201  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.3.0  
changed lines
  Added in v.3.3

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