Return to createtable.pl CVS log

Up to [Local Repository] / processmail

Added Lev's corrections

    1: #!/usr/local/bin/perl
    2: #$Id: createtable.pl,v 3.0 2008/03/23 17:50:49 boris Exp $
    3: #
    4: #
    5: #
    6: # Исходные файлы и параметры
    7: #
    8: 
    9: use Getopt::Std; 
   10: 
   11: $usage = 
   12: "Usage: createtable.pl [-d] [-s|-m] [-t answers_file]  [-o results] \n";
   13: 
   14: require 'parameters.pl';
   15: require 'subroutines.pl';
   16: 
   17: die $usage unless getopts('t:o:dsm');
   18: 
   19: $DEBUG=$opt_d;
   20: $SHORT=$opt_s;
   21: $MEDIUM=$opt_m;
   22: 
   23: my %teams;
   24: my @answers;
   25: my @ratings;
   26: #
   27: # Читаем старые результаты
   28: #
   29: if ($opt_t) {
   30:     die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
   31: } else {
   32:    *INFILE=*STDIN;
   33: }
   34:     
   35: readhash(\@answers);
   36: close(INFILE);
   37: 
   38: 
   39: #
   40: # Открываем файл для записи
   41: #
   42: if ($opt_o) { 
   43:     die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
   44:     select OUTFILE;
   45: }
   46: 
   47: # Находим максимальный вопрос
   48: $MAXQUEST=1;
   49: for (my $i=1; $i<=$ROUNDS; $i++) {
   50:     if ($MAXQUEST<$MAXQUEST[$i]) {
   51: 	$MAXQUEST=$MAXQUEST[$i];
   52:     }
   53: }
   54: 
   55: 
   56: #
   57: # Таблица подводится отдельно по каждому раунду
   58: #
   59: my @nopoint_questions;
   60: for (my $r=1; $r<=$ROUNDS; $r++) {
   61:     if ($DEBUG) {
   62: 	print STDERR "Раунд $r\n";
   63:     }
   64: #
   65: #  Читаем ответы в данном раунде
   66: #
   67: 
   68:     foreach my $file ( @{$FILES[$r]} ) {
   69: 	open (INFILE, $file);
   70: 	readmail(\%teams);
   71: 	collect_answers(\%teams,\@answers);
   72: 	close (INFILE);
   73:     }
   74: 
   75: #
   76: # Дополняем (добавляем к имеющемуся) список вопросов, идущих вне зачёта
   77: # в данном туре.  Для них проставляются плюсы и минусы, но они не входят
   78: # в суммарный результат и рейтинг команд.
   79: #
   80:     foreach my $num ( @{$NOCOUNT[$r]} )
   81:     {
   82: 	# Если номер не начинается с минуса, то включить его в список
   83: 	# внезачётных, иначе - исключить.  Проверяем регэкспом, а не на
   84: 	# "> 0", чтобы можно было использовать и "-0".
   85:     	if ($num =~ /^\d+/) {
   86: 	    push @nopoint_questions, $num; 
   87: 	} else {
   88:             @nopoint_questions = grep( $_ != -$num, @nopoint_questions );
   89: 	}
   90:     }
   91:     # И удаляем возможные дубликаты, чтобы всё было красиво.
   92:     my %seen;
   93:     @nopoint_questions = grep( !$seen{$_}++, @nopoint_questions );
   94: 
   95: #
   96: # Подсчитываем рейтинги вопросов
   97: #
   98:     rate_questions(\%teams,\@answers,\@ratings,$r);
   99: #
  100: # Вычисляем число ответов и рейтинги команд
  101: #
  102:     find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions);
  103: #
  104: # Ну а теперь печатаем саму таблицу...
  105: #
  106: #
  107: # Печатаем заголовок
  108: #
  109:     # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")
  110:     my $COL=5;
  111: 
  112:     print "ЗАЧЁТ  $NAME[$r]\n";
  113:     if ( @nopoint_questions ) {
  114: 	# Есть незачётные вопросы - печатаем их список.
  115: 	print  "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "") 
  116: 		. ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n";
  117:     }
  118: 
  119:     printf "%5s ", "N";
  120:     for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
  121:     {
  122: 	if ($SHORT) {
  123: 	    printf("%1d",$i%10);
  124: 	} elsif ($MEDIUM) {
  125:             if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) {
  126: 		printf "%-3d", $i;
  127:             } else {
  128: 		printf "%s", ".";
  129:             }
  130: 	} else {
  131: 	    printf "%3d",$i;
  132: 	}
  133:     }
  134:     printf "%6s","О";
  135:     printf "%4s","Р";
  136:     printf " КОМАНДА";
  137:     print "\n";
  138: #
  139: # Печатаем команды построчно
  140: #
  141:     foreach $team (sort 
  142: 		   {
  143: 		       $teams{$b}->{score} <=> $teams{$a}->{score}
  144: 		       or
  145: 			   $teams{$b}->{rating} <=> $teams{$a}->{rating}
  146: 		   } keys %teams
  147: 		   )
  148:     {
  149: 	printf "%5d ",$teams{$team}->{regnum};
  150: 	for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
  151: 	{
  152: 	    my $answer = $teams{$team}->{answers}[$i];
  153: 	    my $score = $answers[$i]->{$answer}->{score};
  154: 	    $score = '-' unless $score;
  155: 	    $score = 'X' 
  156: 		if ( $score eq '+' && @nopoint_questions && 
  157: 		     grep($_==$i, @nopoint_questions)
  158: 		   );
  159: 	    if ($SHORT) {
  160: 		printf "%1s",$score;
  161: 	    } elsif ($MEDIUM) {
  162: 		printf "%1s",$score;
  163: 		print "  " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]);
  164: 	    } else {
  165: 		printf "%3s", $score;
  166: 	    }
  167: 	}
  168: 	printf "%6.2f",$teams{$team}->{score};
  169: 	printf "%4s",$teams{$team}->{rating};
  170: 	print " $team";
  171: 	print "\n";
  172:     }
  173: #
  174: # Печатаем рейтинги вопросов - длинный или короткий варианты.
  175: #
  176:     if ($SHORT || $MEDIUM) {
  177:         my $nline = 12; 			# По 12 рейтингов в строке
  178: 	print "\nРейтинг\n";
  179: 	for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) {
  180: 	    my $max = $j*$nline + $nline;
  181: 	    if ($max>$MAXQUEST[$r]) {
  182: 		$max=$MAXQUEST[$r];
  183: 	    }
  184: 	    for ($i=$j*$nline+1; $i<=$max; $i++){
  185: 		printf("%3s",$i);
  186: 	    }
  187: 	    printf "\n";
  188: 	    for ($i=$j*$nline+1; $i<=$max; $i++){
  189: 		printf("%3s",$ratings[$i]);
  190: 	    }
  191: 	    printf "\n";
  192: 	}
  193:     } else {
  194: 	# Длинный вариант - под каждым вопросом.
  195: 	printf "%5s ", "Р";
  196: 	for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++)
  197: 	{
  198: 	    printf "%3s", $ratings[$i];
  199: 	}
  200: 	print "\n";
  201:     }
  202:     print "\n";
  203: }