Annotation of processmail/createtable.pl, revision 3.1
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.1 ! boris 59: my @nopoint_questions; # Здесь будут внезачётные вопросы
! 60: my @unknowns; # Сюда запомним все '?'
1.3 boris 61: for (my $r=1; $r<=$ROUNDS; $r++) {
62: if ($DEBUG) {
63: print STDERR "Раунд $r\n";
64: }
65:
3.1 ! boris 66: #
! 67: # Читаем ответы в данном раунде
! 68: #
3.0 boris 69: foreach my $file ( @{$FILES[$r]} ) {
1.3 boris 70: open (INFILE, $file);
71: readmail(\%teams);
72: collect_answers(\%teams,\@answers);
73: close (INFILE);
74: }
75:
3.1 ! boris 76: #
! 77: # Дополняем (добавляем к имеющемуся!) список вопросов, идущих вне зачёта
! 78: # в данном туре. Для них проставляются плюсы и минусы, но они не входят
! 79: # в суммарный результат и рейтинг команд.
! 80: #
3.0 boris 81: foreach my $num ( @{$NOCOUNT[$r]} )
82: {
83: # Если номер не начинается с минуса, то включить его в список
84: # внезачётных, иначе - исключить. Проверяем регэкспом, а не на
85: # "> 0", чтобы можно было использовать и "-0".
86: if ($num =~ /^\d+/) {
87: push @nopoint_questions, $num;
88: } else {
89: @nopoint_questions = grep( $_ != -$num, @nopoint_questions );
90: }
91: }
92: # И удаляем возможные дубликаты, чтобы всё было красиво.
93: my %seen;
94: @nopoint_questions = grep( !$seen{$_}++, @nopoint_questions );
95:
3.1 ! boris 96: #
! 97: # Подсчитываем рейтинги вопросов
! 98: #
1.3 boris 99: rate_questions(\%teams,\@answers,\@ratings,$r);
3.1 ! boris 100:
! 101: #
! 102: # Вычисляем число ответов и рейтинги команд
! 103: #
3.0 boris 104: find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions);
3.1 ! boris 105:
! 106: #
! 107: # Ну а теперь печатаем саму таблицу...
! 108: #
! 109: #
! 110: # Печатаем заголовок
! 111: #
3.0 boris 112: # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")
113: my $COL=5;
114:
1.3 boris 115: print "ЗАЧЁТ $NAME[$r]\n";
3.0 boris 116: if ( @nopoint_questions ) {
117: # Есть незачётные вопросы - печатаем их список.
118: print "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "")
119: . ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n";
120: }
121:
1.3 boris 122: printf "%5s ", "N";
123: for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
124: {
125: if ($SHORT) {
126: printf("%1d",$i%10);
3.0 boris 127: } elsif ($MEDIUM) {
128: if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) {
129: printf "%-3d", $i;
130: } else {
131: printf "%s", ".";
132: }
1.3 boris 133: } else {
134: printf "%3d",$i;
135: }
1.2 boris 136: }
1.3 boris 137: printf "%6s","О";
138: printf "%4s","Р";
139: printf " КОМАНДА";
140: print "\n";
3.1 ! boris 141:
! 142: #
! 143: # Печатаем команды построчно
! 144: #
1.3 boris 145: foreach $team (sort
146: {
147: $teams{$b}->{score} <=> $teams{$a}->{score}
148: or
149: $teams{$b}->{rating} <=> $teams{$a}->{rating}
150: } keys %teams
151: )
1.1 boris 152: {
1.3 boris 153: printf "%5d ",$teams{$team}->{regnum};
154: for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
155: {
156: my $answer = $teams{$team}->{answers}[$i];
157: my $score = $answers[$i]->{$answer}->{score};
158: $score = '-' unless $score;
3.1 ! boris 159:
! 160: # Особо пометим взятые внезачётные вопросы.
! 161: if ( $score eq '+' && grep($_==$i, @nopoint_questions) ) {
! 162: $score = 'X';
! 163: }
! 164:
! 165: # И запомним, если вопрос не взят и не не взят ;-).
! 166: if ( $score eq '?' ) {
! 167: my $unk = {
! 168: question => $i,
! 169: score => $score,
! 170: team => $team,
! 171: regnum => $teams{$team}->{regnum},
! 172: round => $r,
! 173: };
! 174: push( @unknowns, $unk );
! 175: }
! 176:
! 177: # Ну наконец-то! Печатаем.
1.3 boris 178: if ($SHORT) {
179: printf "%1s",$score;
3.0 boris 180: } elsif ($MEDIUM) {
181: printf "%1s",$score;
182: print " " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]);
1.3 boris 183: } else {
184: printf "%3s", $score;
185: }
1.2 boris 186: }
1.3 boris 187: printf "%6.2f",$teams{$team}->{score};
188: printf "%4s",$teams{$team}->{rating};
189: print " $team";
190: print "\n";
1.1 boris 191: }
3.1 ! boris 192:
! 193: #
! 194: # Печатаем рейтинги вопросов - длинный или короткий варианты.
! 195: #
3.0 boris 196: if ($SHORT || $MEDIUM) {
3.1 ! boris 197: my $nline = 24; # По $nline рейтингов в строке
3.0 boris 198: print "\nРейтинг\n";
199: for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) {
200: my $max = $j*$nline + $nline;
1.3 boris 201: if ($max>$MAXQUEST[$r]) {
202: $max=$MAXQUEST[$r];
203: }
3.0 boris 204: for ($i=$j*$nline+1; $i<=$max; $i++){
1.3 boris 205: printf("%3s",$i);
206: }
207: printf "\n";
3.0 boris 208: for ($i=$j*$nline+1; $i<=$max; $i++){
1.3 boris 209: printf("%3s",$ratings[$i]);
210: }
211: printf "\n";
1.2 boris 212: }
1.3 boris 213: } else {
3.0 boris 214: # Длинный вариант - под каждым вопросом.
1.3 boris 215: printf "%5s ", "Р";
3.0 boris 216: for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++)
1.3 boris 217: {
218: printf "%3s", $ratings[$i];
1.2 boris 219: }
1.3 boris 220: print "\n";
1.2 boris 221: }
222: print "\n";
1.1 boris 223: }
3.1 ! boris 224:
! 225:
! 226: # Печатаем предупреждение если есть неясные ответы.
! 227: if ( @unknowns ) {
! 228: print STDERR "ВНИМАНИЕ! Не всем ответам проставлены '+' и '-':\n";
! 229: foreach my $unk ( @unknowns ) {
! 230: print STDERR "\tКоманда $unk->{team} ($unk->{regnum}), "
! 231: . "вопрос $unk->{question} ($NAME[$unk->{round}]): "
! 232: . "$unk->{score}\n";
! 233: }
! 234: }
! 235: # На всякий случай проверяем на наличие команд с дублирующимися номерами.
! 236: check_dup_numbers(\%teams);
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