Return to createtable.pl CVS log

Up to [Local Repository] / processmail

New changes from Lev

#!/usr/bin/perl
#$Id: createtable.pl,v 3.4 2013/10/30 19:28:30 boris Exp $
#
#
#
# Исходные файлы и параметры
#

use Getopt::Std; 

$usage = 
"Usage: createtable.pl [-d] [-s|-m] [-t answers_file]  [-o results] \n";

require 'parameters.pl';
require 'subroutines.pl';

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;
my @ratings;
#
# Читаем старые результаты
#
if ($opt_t) {
    die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
} else {
   *INFILE=*STDIN;
}
    
readhash(\@answers);
close(INFILE);


#
# Открываем файл для записи
#
if ($opt_o) { 
    die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
    select OUTFILE;
}

#
# Таблица подводится отдельно по каждому раунду
#
my @nopoint_questions; 			# Здесь будут внезачётные вопросы
my @unknowns; 				# Сюда запомним все '?'
for (my $r=1; $r<=$ROUNDS; $r++) {
    if ($DEBUG) {
	print STDERR "Раунд $r\n";
    }

    #
    #  Удаляем старые рейтинги (Ivan A Derzhanski <iad58@mail.ru>)
    #
    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,\@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;
	}
    }
    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=$MINQUEST[$r]+$j*$nline; $i<=$max; $i++){
		printf("%3s",$i);
	    }
	    printf "\n";
	    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++)
	{
	    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);