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