1: #!/usr/local/bin/perl
2: #$Id: createtable.pl,v 3.0 2008/03/23 17:50:49 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: for (my $r=1; $r<=$ROUNDS; $r++) {
61: if ($DEBUG) {
62: print STDERR "Раунд $r\n";
63: }
64: #
65: # Читаем ответы в данном раунде
66: #
67:
68: foreach my $file ( @{$FILES[$r]} ) {
69: open (INFILE, $file);
70: readmail(\%teams);
71: collect_answers(\%teams,\@answers);
72: close (INFILE);
73: }
74:
75: #
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: #
96: # Подсчитываем рейтинги вопросов
97: #
98: rate_questions(\%teams,\@answers,\@ratings,$r);
99: #
100: # Вычисляем число ответов и рейтинги команд
101: #
102: find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions);
103: #
104: # Ну а теперь печатаем саму таблицу...
105: #
106: #
107: # Печатаем заголовок
108: #
109: # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+")
110: my $COL=5;
111:
112: print "ЗАЧЁТ $NAME[$r]\n";
113: if ( @nopoint_questions ) {
114: # Есть незачётные вопросы - печатаем их список.
115: print "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "")
116: . ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n";
117: }
118:
119: printf "%5s ", "N";
120: for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++)
121: {
122: if ($SHORT) {
123: printf("%1d",$i%10);
124: } elsif ($MEDIUM) {
125: if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) {
126: printf "%-3d", $i;
127: } else {
128: printf "%s", ".";
129: }
130: } else {
131: printf "%3d",$i;
132: }
133: }
134: printf "%6s","О";
135: printf "%4s","Р";
136: printf " КОМАНДА";
137: print "\n";
138: #
139: # Печатаем команды построчно
140: #
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: )
148: {
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;
155: $score = 'X'
156: if ( $score eq '+' && @nopoint_questions &&
157: grep($_==$i, @nopoint_questions)
158: );
159: if ($SHORT) {
160: printf "%1s",$score;
161: } elsif ($MEDIUM) {
162: printf "%1s",$score;
163: print " " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]);
164: } else {
165: printf "%3s", $score;
166: }
167: }
168: printf "%6.2f",$teams{$team}->{score};
169: printf "%4s",$teams{$team}->{rating};
170: print " $team";
171: print "\n";
172: }
173: #
174: # Печатаем рейтинги вопросов - длинный или короткий варианты.
175: #
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;
181: if ($max>$MAXQUEST[$r]) {
182: $max=$MAXQUEST[$r];
183: }
184: for ($i=$j*$nline+1; $i<=$max; $i++){
185: printf("%3s",$i);
186: }
187: printf "\n";
188: for ($i=$j*$nline+1; $i<=$max; $i++){
189: printf("%3s",$ratings[$i]);
190: }
191: printf "\n";
192: }
193: } else {
194: # Длинный вариант - под каждым вопросом.
195: printf "%5s ", "Р";
196: for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++)
197: {
198: printf "%3s", $ratings[$i];
199: }
200: print "\n";
201: }
202: print "\n";
203: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>