Annotation of processmail/createtable.pl, revision 3.0
1.1 boris 1: #!/usr/local/bin/perl
3.0 ! boris 2: #$Id: createtable.pl,v 1.3 2005/02/16 22:20:08 boris Exp $
1.1 boris 3: #
4: #
5: #
6: # Исходные файлы и параметры
7: #
8:
1.3 boris 9: use Getopt::Std;
1.1 boris 10:
1.3 boris 11: $usage =
3.0 ! boris 12: "Usage: createtable.pl [-d] [-s|-m] [-t answers_file] [-o results] \n";
1.1 boris 13:
14: require 'parameters.pl';
15: require 'subroutines.pl';
16:
3.0 ! boris 17: die $usage unless getopts('t:o:dsm');
1.1 boris 18:
19: $DEBUG=$opt_d;
1.2 boris 20: $SHORT=$opt_s;
3.0 ! boris 21: $MEDIUM=$opt_m;
1.1 boris 22:
23: my %teams;
24: my @answers;
25: my @ratings;
26: #
27: # Читаем старые результаты
28: #
1.3 boris 29: if ($opt_t) {
1.1 boris 30: die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
1.3 boris 31: } else {
32: *INFILE=*STDIN;
1.1 boris 33: }
1.3 boris 34:
35: readhash(\@answers);
36: close(INFILE);
37:
1.1 boris 38:
39: #
1.3 boris 40: # Открываем файл для записи
1.1 boris 41: #
1.3 boris 42: if ($opt_o) {
43: die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
44: select OUTFILE;
1.1 boris 45: }
1.3 boris 46:
47: # Находим максимальный вопрос
48: $MAXQUEST=1;
49: for (my $i=1; $i<=$ROUNDS; $i++) {
50: if ($MAXQUEST<$MAXQUEST[$i]) {
51: $MAXQUEST=$MAXQUEST[$i];
52: }
1.1 boris 53: }
1.3 boris 54:
55:
56: #
57: # Таблица подводится отдельно по каждому раунду
1.1 boris 58: #
3.0 ! boris 59: my @nopoint_questions;
1.3 boris 60: for (my $r=1; $r<=$ROUNDS; $r++) {
61: if ($DEBUG) {
62: print STDERR "Раунд $r\n";
63: }
1.1 boris 64: #
1.3 boris 65: # Читаем ответы в данном раунде
66: #
67:
3.0 ! boris 68: foreach my $file ( @{$FILES[$r]} ) {
1.3 boris 69: open (INFILE, $file);
70: readmail(\%teams);
71: collect_answers(\%teams,\@answers);
72: close (INFILE);
73: }
74:
1.1 boris 75: #
3.0 ! boris 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: #
1.1 boris 96: # Подсчитываем рейтинги вопросов
97: #
1.3 boris 98: rate_questions(\%teams,\@answers,\@ratings,$r);
1.1 boris 99: #
100: # Вычисляем число ответов и рейтинги команд
101: #
3.0 ! boris 102: find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions);
1.1 boris 103: #
104: # Ну а теперь печатаем саму таблицу...
105: #
106: #
107: # Печатаем заголовок
108: #
3.0 ! boris 109: # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")
! 110: my $COL=5;
! 111:
1.3 boris 112: print "ЗАЧЁТ $NAME[$r]\n";
3.0 ! boris 113: if ( @nopoint_questions ) {
! 114: # Есть незачётные вопросы - печатаем их список.
! 115: print "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "")
! 116: . ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n";
! 117: }
! 118:
1.3 boris 119: printf "%5s ", "N";
120: for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
121: {
122: if ($SHORT) {
123: printf("%1d",$i%10);
3.0 ! boris 124: } elsif ($MEDIUM) {
! 125: if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) {
! 126: printf "%-3d", $i;
! 127: } else {
! 128: printf "%s", ".";
! 129: }
1.3 boris 130: } else {
131: printf "%3d",$i;
132: }
1.2 boris 133: }
1.3 boris 134: printf "%6s","О";
135: printf "%4s","Р";
136: printf " КОМАНДА";
137: print "\n";
1.1 boris 138: #
139: # Печатаем команды построчно
140: #
1.3 boris 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: )
1.1 boris 148: {
1.3 boris 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;
3.0 ! boris 155: $score = 'X'
! 156: if ( $score eq '+' && @nopoint_questions &&
! 157: grep($_==$i, @nopoint_questions)
! 158: );
1.3 boris 159: if ($SHORT) {
160: printf "%1s",$score;
3.0 ! boris 161: } elsif ($MEDIUM) {
! 162: printf "%1s",$score;
! 163: print " " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]);
1.3 boris 164: } else {
165: printf "%3s", $score;
166: }
1.2 boris 167: }
1.3 boris 168: printf "%6.2f",$teams{$team}->{score};
169: printf "%4s",$teams{$team}->{rating};
170: print " $team";
171: print "\n";
1.1 boris 172: }
173: #
3.0 ! boris 174: # Печатаем рейтинги вопросов - длинный или короткий варианты.
1.1 boris 175: #
3.0 ! boris 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;
1.3 boris 181: if ($max>$MAXQUEST[$r]) {
182: $max=$MAXQUEST[$r];
183: }
3.0 ! boris 184: for ($i=$j*$nline+1; $i<=$max; $i++){
1.3 boris 185: printf("%3s",$i);
186: }
187: printf "\n";
3.0 ! boris 188: for ($i=$j*$nline+1; $i<=$max; $i++){
1.3 boris 189: printf("%3s",$ratings[$i]);
190: }
191: printf "\n";
1.2 boris 192: }
1.3 boris 193: } else {
3.0 ! boris 194: # Длинный вариант - под каждым вопросом.
1.3 boris 195: printf "%5s ", "Р";
3.0 ! boris 196: for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++)
1.3 boris 197: {
198: printf "%3s", $ratings[$i];
1.2 boris 199: }
1.3 boris 200: print "\n";
1.2 boris 201: }
202: print "\n";
1.1 boris 203: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to createtable.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / processmail