]> mj.ucw.cz Git - eval.git/blob - bin/mo-score
3642f93c06639150b9bc9018ac4fc07972a8d52d
[eval.git] / bin / mo-score
1 #!/usr/bin/perl
2
3 $debug = 0;
4 $detail = 0;
5 $html = 0;
6 $tex = 0;
7 $extras = 0;
8 $alt = 0;
9 $split = 0;
10 $usage = "Usage: mo-score [--detail] [--alt] [--extras] [--html] [--tex] [--split] <task1> <task2> ...";
11 while (($arg = $ARGV[0]) =~ /^--([a-z]+)$/) {
12         shift @ARGV;
13         $var = "\$$1";
14         if (!eval "defined $var") { die $usage; }
15         eval "$var = 1;";
16 }
17 @ARGV || die $usage;
18
19 @tasks = @ARGV;
20
21 print STDERR "Scanning contestants... ";
22 open (CT, "bin/mo-get-users --full |") || die "Cannot get list of contestants";
23 while (<CT>) {
24         chomp;
25         ($u,$f) = split /\t/;
26         ($u eq "somebody") && next;
27         $users{$u}=$f;
28 }
29 close CT;
30 print STDERR 0+keys %users, "\n";
31
32 print STDERR "Scanning exceptions... ";
33 if ($extras && open (EX, "exceptions")) {
34         while (<EX>) {
35                 chomp;
36                 (/^$/ || /^#/) && next;
37                 @a = split /\s+/;
38                 $u = shift @a;
39                 defined $users{$u} || die "Unknown user $u";
40                 while (@a) { $extra{$u} += shift @a; }
41         }
42         close EX;
43         print STDERR "OK\n";
44 } else { print STDERR "none\n"; }
45
46 print STDERR "Scanning task results... ";
47 $need_tasks = join("|", @ARGV);
48 %messages = ();
49 %error_codes = ();
50 foreach $u (keys %users) {
51         opendir (D, "testing/$u") or next;
52         foreach $t (readdir(D)) {
53                 $t =~ /^\./ && next;
54                 $t =~ /$need_tasks/ || next;
55                 $known_tasks{$t} = 1;
56                 $tt = "testing/$u/$t/points" . ($alt ? ".alt" : "");
57                 -f $tt || next;
58                 print STDERR "$u/$t ";
59                 open (X, $tt) || die "Unable to open $tt";
60                 while (<X>) {
61                         chomp;
62                         /^(\S+) (-?\d+)\s*(.*)/ || die "Parse error: $_";
63                         $ttest = $1;
64                         $tpts = $2;
65                         $trem = $3;
66                         $trem =~ s/\[.*//;
67                         $ttest =~ s/[^0-9]//g unless $split;
68                         $known_tests{$t}{$ttest} = 1;
69                         $cmt = $tpts;
70                         if ($tpts == 0 && $trem ne "OK") {
71                                 if ($trem =~ /^Compile /) { $cmt = "CE"; }
72                                 elsif ($trem =~ /^Time limit exceeded/) { $cmt = "TO"; }
73                                 elsif ($trem =~ /^Exited with error /) { $cmt = "RE"; }
74                                 elsif ($trem =~ /^Caught fatal signal /) { $cmt = "SG"; }
75                                 elsif ($trem =~ /^([A-Za-z])\S*\s+([A-Za-z])/) {
76                                         ($cmt = "$1$2") =~ tr/a-z/A-Z/;
77                                 }
78                                 elsif ($trem =~ /^Wrong answer/) { $cmt = "WA"; }
79                                 if (!defined $messages{$trem}) {
80                                         $messages{$trem} = $cmt;
81                                         if (!defined $error_codes{$cmt}) {
82                                                 $error_codes{$cmt} = $trem;
83                                         } else {
84                                                 $error_codes{$cmt} .= ", $trem";
85                                         }
86                                 }
87                         }
88                         if (!defined($results{$u}{$t}{$ttest}) || $results{$u}{$t}{$ttest} > $tpts) {
89                                 $results{$u}{$t}{$ttest} = $tpts;
90                                 $comment{$u}{$t}{$ttest} = $cmt;
91                         }
92                 }
93                 close X;
94         }
95         foreach my $t (keys %known_tasks) {
96                 $total{$u}{$t} = 0;
97                 foreach my $pts (values %{$results{$u}{$t}}) { $total{$u}{$t} += $pts; }
98         }
99         closedir D;
100 }
101 print STDERR "OK\n";
102
103 print STDERR "Creating table template... ";
104 @header = ("Rank","User","Name");
105 @body = ('','$u','$users{$u}');
106 @bodysums = ();
107 @footer = ('"Total"','','');
108 if (keys %extra) {
109         push @header, "Extra";
110         push @body, '$extra{$u}';
111         $col = 0+@footer;
112         push @bodysums, $col;
113         push @footer, "sum($col)";
114 }
115 foreach $t (@ARGV) {
116         defined $known_tasks{$t} || die "Unknown task $t";
117         push @header, substr($t, 0, 4);
118         push @body, "(\$xx = \$total{\$u}{'$t'}) > 0 ? \$xx : 0";
119         $col = 0+@footer;
120         push @footer, "sum($col)";
121         push @bodysums, $col;
122         if ($detail) {
123                 foreach $s (sort { $a <=> $b } keys %{$known_tests{$t}}) {
124                         push @header, "$s";
125                         push @body, "\$comment{\$u}{'$t'}{'$s'}";
126                         $col = 0+@footer;
127                         push @footer, "sum($col)";
128                 }
129         }
130 }
131 push @header, "Total";
132 push @body, join('+', map { $_ = "\$$_" } @bodysums);
133 $col = 0+@footer;
134 push @footer, "sum($col)";
135 print STDERR "OK\n";
136
137 print STDERR "h: ", join(':',@header), "\n" if $debug;
138 print STDERR "b: ", join(':',@body), "\n" if $debug;
139 print STDERR "f: ", join(':',@footer), "\n" if $debug;
140
141 print STDERR "Filling in results... ";
142 @table = ();
143 foreach $u (keys %users) {
144         $row = [];
145         foreach my $c (@body) {
146                 $c =~ s/\$(\d+)/\$\$row[$1]/g;
147                 $x = eval $c;
148                 push @$row, (defined $x ? $x : '-');
149         }
150         print STDERR "row: ", join(':',@$row), "\n" if $debug;
151         push @table, $row;
152 }
153 print STDERR "OK\n";
154
155 print STDERR "Sorting... ";
156 $sortcol = @{$table[0]} - 1;
157 $namecol = 2;
158 @table = sort {
159         my $p, $an, $bn;
160         $p = $$b[$sortcol] <=> $$a[$sortcol];
161         ($an = $$a[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
162         ($bn = $$b[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
163         $p ? $p : ($an cmp $bn);
164 } @table;
165 $i=0;
166 while ($i < @table) {
167         $j = $i;
168         while ($i < @table && ${$table[$i]}[$sortcol] == ${$table[$j]}[$sortcol]) {
169                 $i++;
170         }
171         if ($i == $j+1) {
172                 ${table[$j]}[0] = "$i.";
173         } else {
174                 ${table[$j]}[0] = $j+1 . ".-" . $i . ".";
175                 $j++;
176                 while ($j < $i) { ${table[$j++]}[0] = ""; };
177         }
178 }
179 print STDERR "OK\n";
180
181 print STDERR "Attaching headers and footers... ";
182 sub sum { my $col=shift @_; my $t=0; foreach my $z (0..@table-1) { $t += ${$table[$z]}[$col]; } $t; }
183 map { $_ = eval $_; } @footer;
184 push @table, \@footer;
185 unshift @table, \@header;
186 print STDERR "OK\n";
187
188 if ($debug) {
189         foreach $r (@table) { print join(':',@$r), "\n"; }
190 } elsif ($html) {
191         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html40/strict.dtd">', "\n";
192         print "<HTML><HEAD><TITLE>Rank list</TITLE></HEAD><BODY>\n";
193         print "<H1>Rank list</H1>\n";
194
195         my @perm;
196         &printHtmlHeader(\@perm);
197         print "<tbody>";
198         
199         foreach $r (@table[1..($#table - 1)]) {
200                 &printHtmlRow(@{$r}[@perm]);
201         }
202
203         print "<tbody>";
204         &printHtmlRow(@{$table[$#table]}[@perm]);
205
206         print "</TABLE>\n";
207         if ($detail) {
208                 print "<H2>Error codes</H2><UL>\n";
209                 foreach $r (sort keys %error_codes) { print "<LI>$r: $error_codes{$r}\n"; }
210                 print "</UL>\n";
211         }
212         print "</BODY></HTML>\n";
213 } elsif ($tex) {
214         print "\\error{TeX output not supported yet!}\n";
215 } else {
216         foreach $r (@table) { print join("\t",@$r), "\n"; }
217         print "\n";
218         foreach $r (sort keys %error_codes) { print "$r: $error_codes{$r}\n"; }
219 }
220
221
222 sub printHtmlRow {
223         print "<TR>", join('',map {
224                 if ($hdr) { $_ = "<TH>$_"; }
225                 else { $_ = "<TD align=" . (/^[0-9A-Z-]+$/ ? "right" : "left") . (length($_) > 14 ? " width=150" : "") . ">$_"; }
226         } @_), "\n";
227 }
228
229
230 sub printHtmlHeader {
231
232   my ($perm) = @_;
233
234    my $colspec = "<colgroup span=3>";
235    my $hdr1;
236    my $hdr2;
237
238    @$perm = (0, 1, 2);
239    my $p = 3;
240
241    if ($detail) {
242      $hdr1 = "<th rowspan=2>Rank<th rowspan=2>User<th rowspan=2>Name";
243      for my $task (@tasks) {
244
245         my $nSub = scalar(keys %{$known_tests{$task}});
246
247         $p++;
248         map { push @$perm, $p++ } (1..$nSub);
249         push @$perm, $p - $nSub - 1;
250         
251         $colspec .= "<colgroup span='" . $nSub . "'>\n";
252         $colspec .= "<colgroup span='1'>\n";
253         $hdr1 .= "<th colspan='" . ($nSub + 1) . "' style='border-bottom:1px solid black;'>$task";
254         $hdr2 .= join("", map { "<th>$_" } sort {$a <=> $b} keys %{$known_tests{$task}});
255         $hdr2 .= "<th>Total";
256      }
257    
258      $hdr1 .= "<th rowspan='2'>Total";
259      
260    } else {  ## no detail
261    
262      $hdr1 = "<th>Rank<th>User<th>Name";
263
264      for my $task (@tasks) {
265         push @$perm, $p++;
266         $hdr1 .= "<th>$task";
267      }
268      $hdr1 .= "<th>Total";
269      $colspec .= "<colgroup span='" . scalar (@tasks) . "'>";
270    }
271
272    push @$perm, $p++;
273    
274    print "<TABLE rules=groups frame=all border='1' cellpadding='2'>\n";
275    print "$colspec<colgroup span='1'>\n";
276    print "<tr>$hdr1</tr>\n";
277    print "<tr>$hdr2</tr>\n" if $detail;
278   
279 }