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