1: #!/usr/local/bin/perl
2: #$Id: createtable.pl,v 3.1 2008/03/24 16:01:47 boris Exp $
3: #
4: #
5: #
6: # Исходные файлы и параметры
7: #
8:
9: use Getopt::Std;
10:
11: $usage =
12: "Usage: createtable.pl [-d] [-s|-m] [-t answers_file] [-o results] \n";
13:
14: require 'parameters.pl';
15: require 'subroutines.pl';
16:
17: die $usage unless getopts('t:o:dsm');
18:
19: $DEBUG=$opt_d;
20: $SHORT=$opt_s;
21: $MEDIUM=$opt_m;
22:
23: my %teams;
24: my @answers;
25: my @ratings;
26: #
27: # Читаем старые результаты
28: #
29: if ($opt_t) {
30: die "Cannot open $opt_t\n" unless open(INFILE,$opt_t);
31: } else {
32: *INFILE=*STDIN;
33: }
34:
35: readhash(\@answers);
36: close(INFILE);
37:
38:
39: #
40: # Открываем файл для записи
41: #
42: if ($opt_o) {
43: die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o");
44: select OUTFILE;
45: }
46:
47: # Находим максимальный вопрос
48: $MAXQUEST=1;
49: for (my $i=1; $i<=$ROUNDS; $i++) {
50: if ($MAXQUEST<$MAXQUEST[$i]) {
51: $MAXQUEST=$MAXQUEST[$i];
52: }
53: }
54:
55:
56: #
57: # Таблица подводится отдельно по каждому раунду
58: #
59: my @nopoint_questions; # Здесь будут внезачётные вопросы
60: my @unknowns; # Сюда запомним все '?'
61: for (my $r=1; $r<=$ROUNDS; $r++) {
62: if ($DEBUG) {
63: print STDERR "Раунд $r\n";
64: }
65:
66: #
67: # Читаем ответы в данном раунде
68: #
69: foreach my $file ( @{$FILES[$r]} ) {
70: open (INFILE, $file);
71: readmail(\%teams);
72: collect_answers(\%teams,\@answers);
73: close (INFILE);
74: }
75:
76: #
77: # Дополняем (добавляем к имеющемуся!) список вопросов, идущих вне зачёта
78: # в данном туре. Для них проставляются плюсы и минусы, но они не входят
79: # в суммарный результат и рейтинг команд.
80: #
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:
96: #
97: # Подсчитываем рейтинги вопросов
98: #
99: rate_questions(\%teams,\@answers,\@ratings,$r);
100:
101: #
102: # Вычисляем число ответов и рейтинги команд
103: #
104: find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions);
105:
106: #
107: # Ну а теперь печатаем саму таблицу...
108: #
109: #
110: # Печатаем заголовок
111: #
112: # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")
113: my $COL=5;
114:
115: print "ЗАЧЁТ $NAME[$r]\n";
116: if ( @nopoint_questions ) {
117: # Есть незачётные вопросы - печатаем их список.
118: print "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "")
119: . ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n";
120: }
121:
122: printf "%5s ", "N";
123: for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
124: {
125: if ($SHORT) {
126: printf("%1d",$i%10);
127: } elsif ($MEDIUM) {
128: if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) {
129: printf "%-3d", $i;
130: } else {
131: printf "%s", ".";
132: }
133: } else {
134: printf "%3d",$i;
135: }
136: }
137: printf "%6s","О";
138: printf "%4s","Р";
139: printf " КОМАНДА";
140: print "\n";
141:
142: #
143: # Печатаем команды построчно
144: #
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: )
152: {
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;
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: # Ну наконец-то! Печатаем.
178: if ($SHORT) {
179: printf "%1s",$score;
180: } elsif ($MEDIUM) {
181: printf "%1s",$score;
182: print " " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]);
183: } else {
184: printf "%3s", $score;
185: }
186: }
187: printf "%6.2f",$teams{$team}->{score};
188: printf "%4s",$teams{$team}->{rating};
189: print " $team";
190: print "\n";
191: }
192:
193: #
194: # Печатаем рейтинги вопросов - длинный или короткий варианты.
195: #
196: if ($SHORT || $MEDIUM) {
197: my $nline = 24; # По $nline рейтингов в строке
198: print "\nРейтинг\n";
199: for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) {
200: my $max = $j*$nline + $nline;
201: if ($max>$MAXQUEST[$r]) {
202: $max=$MAXQUEST[$r];
203: }
204: for ($i=$j*$nline+1; $i<=$max; $i++){
205: printf("%3s",$i);
206: }
207: printf "\n";
208: for ($i=$j*$nline+1; $i<=$max; $i++){
209: printf("%3s",$ratings[$i]);
210: }
211: printf "\n";
212: }
213: } else {
214: # Длинный вариант - под каждым вопросом.
215: printf "%5s ", "Р";
216: for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++)
217: {
218: printf "%3s", $ratings[$i];
219: }
220: print "\n";
221: }
222: print "\n";
223: }
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