--- processmail/createtable.pl 2005/02/16 22:20:08 1.3 +++ processmail/createtable.pl 2013/10/30 19:28:30 3.4 @@ -1,5 +1,5 @@ -#!/usr/local/bin/perl -#$Id: createtable.pl,v 1.3 2005/02/16 22:20:08 boris Exp $ +#!/usr/bin/perl +#$Id: createtable.pl,v 3.4 2013/10/30 19:28:30 boris Exp $ # # # @@ -9,15 +9,31 @@ use Getopt::Std; $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 'subroutines.pl'; -die $usage unless getopts('t:o:ds'); +die $usage unless getopts('t:o:dsm'); $DEBUG=$opt_d; $SHORT=$opt_s; +$MEDIUM=$opt_m; + +# Находим максимальный и минимальный вопрос и слегка подстраховываемся. +$MINQUEST=1e99; +$MAXQUEST=-1; +for (my $r=1; $r<=$ROUNDS; $r++) { + if ($MINQUEST>$MINQUEST[$r]) { + $MINQUEST=$MINQUEST[$r]; + } + if ($MAXQUEST<$MAXQUEST[$r]) { + $MAXQUEST=$MAXQUEST[$r]; + } +} +if ($MINQUEST < 0 || $MAXQUEST < 0) { + die "Отрицательные номера вопросов не поддерживаются!\n"; +} my %teams; my @answers; @@ -43,53 +59,92 @@ if ($opt_o) { select OUTFILE; } -# Находим максимальный вопрос -$MAXQUEST=1; -for (my $i=1; $i<=$ROUNDS; $i++) { - if ($MAXQUEST<$MAXQUEST[$i]) { - $MAXQUEST=$MAXQUEST[$i]; - } -} - - # # Таблица подводится отдельно по каждому раунду # +my @nopoint_questions; # Здесь будут внезачётные вопросы +my @unknowns; # Сюда запомним все '?' for (my $r=1; $r<=$ROUNDS; $r++) { if ($DEBUG) { print STDERR "Раунд $r\n"; } -# -# Читаем ответы в данном раунде -# - foreach my $file (split /\s+/, $FILES[$r]) { + # + # Удаляем старые рейтинги (Ivan A Derzhanski ) + # + for ($i=$MINQUEST;$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); -# -# Ну а теперь печатаем саму таблицу... -# -# -# Печатаем заголовок -# + + # + # Вычисляем число ответов и рейтинги команд + # + 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++) { if ($SHORT) { printf("%1d",$i%10); + } elsif ($MEDIUM) { + if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) { + printf "%-3d", $i; + } else { + printf "%s", "."; + } } else { printf "%3d",$i; } @@ -98,9 +153,10 @@ for (my $r=1; $r<=$ROUNDS; $r++) { printf "%4s","Р"; printf " КОМАНДА"; print "\n"; -# -# Печатаем команды построчно -# + + # + # Печатаем команды построчно + # foreach $team (sort { $teams{$b}->{score} <=> $teams{$a}->{score} @@ -115,8 +171,30 @@ for (my $r=1; $r<=$ROUNDS; $r++) { 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; } @@ -126,33 +204,49 @@ for (my $r=1; $r<=$ROUNDS; $r++) { print " $team"; print "\n"; } -# -# Печатаем последнюю строку таблицы -# в ней рейтинги вопросов -# - if ($SHORT) { - print "Рейтинг\n"; - for ($j=0;$j<$MAXQUEST[$r]/12;$j++) { - my $max=$j*12+12; + + # + # Печатаем рейтинги вопросов - длинный или короткий варианты. + # + 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*12+1;$i<=$max;$i++){ + for ($i=$MINQUEST[$r]+$j*$nline; $i<=$max; $i++){ printf("%3s",$i); } printf "\n"; - for ($i=1+$j*12;$i<=$max;$i++){ + for ($i=$MINQUEST[$r]+$j*$nline; $i<=$max; $i++){ printf("%3s",$ratings[$i]); } printf "\n"; } } else { + # Длинный вариант - под каждым вопросом. printf "%5s ", "Р"; - for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r];$i++) + for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++) { printf "%3s", $ratings[$i]; } print "\n"; } print "\n"; + print "\n"; # LG: One more for better readability +} + + +# Печатаем предупреждение если есть неясные ответы. +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);