Initial checkout of Vore Tournament 0.1.alpha.
[voretournament/voretournament.git] / misc / tools / weapon-profiler-analyzer.pl
1 #!/usr/bin/perl
2
3 # no warranty for this script
4 # and no documentation
5 # take it or leave it
6
7 use strict;
8 use warnings;
9 use FindBin; use lib $FindBin::Bin;
10 use WeaponEncounterProfile;
11
12 my ($statsfile) = @ARGV;
13 my $stats;
14
15 sub LoadData()
16 {
17         $stats = WeaponEncounterProfile->new($statsfile);
18 }
19
20 sub LinSolve($$)
21 {
22         my ($m, $v) = @_;
23         my $n = @$m;
24
25         my @out = ();
26
27         my @bigmatrix = map { [ @{$m->[$_]}, $v->[$_] ] } 0..$n-1;
28
29         # 1. Triangulate
30         for my $i(0..$n-1)
31         {
32                 # first: bring the highest value to the top
33                 my $best = -1;
34                 my $bestval = 0;
35                 for my $j($i..$n-1)
36                 {
37                         my $v = $bigmatrix[$j]->[$i];
38                         if($v*$v > $bestval*$bestval)
39                         {
40                                 $best = $j;
41                                 $bestval = $v;
42                         }
43                 }
44                 die "lindep" if $best == -1;
45
46                 # swap
47                 ($bigmatrix[$i], $bigmatrix[$best]) = ($bigmatrix[$best], $bigmatrix[$i]);
48
49                 # then: eliminate
50                 for my $j($i+1..$n-1)
51                 {
52                         my $r = $bigmatrix[$j]->[$i];
53                         for my $k(0..$n)
54                         {
55                                 $bigmatrix[$j]->[$k] -= $bigmatrix[$i]->[$k] * $r / $bestval;
56                         }
57                 }
58         }
59
60         # 2. Diagonalize
61         for my $i(reverse 0..$n-1)
62         {
63                 my $bestval = $bigmatrix[$i]->[$i];
64                 for my $j(0..$i-1)
65                 {
66                         my $r = $bigmatrix[$j]->[$i];
67                         for my $k(0..$n)
68                         {
69                                 $bigmatrix[$j]->[$k] -= $bigmatrix[$i]->[$k] * $r / $bestval;
70                         }
71                 }
72         }
73
74         # 3. Read off solutions
75         return map { $bigmatrix[$_]->[$n] / $bigmatrix[$_]->[$_] } 0..($n-1);
76 }
77
78 sub SolveBestSquares($$)
79 {
80         my ($d, $w) = @_;
81
82         my $n = @$d;
83
84         if($ENV{stupid})
85         {
86                 my @result = ();
87                 for my $i(0..$n-1)
88                 {
89                         my $num = 0;
90                         my $denom = 0;
91                         for my $j(0..$n-1)
92                         {
93                                 my $weight = $w->[$i]->[$j];
94                                 $num += $weight * $d->[$i]->[$j];
95                                 $denom += $weight;
96                         }
97                         push @result, $num / $denom;
98                 }
99                 return @result;
100         }
101
102         # build linear equation system
103
104         my @matrix = map { [ map { 0 } 1..$n ] } 1..$n;
105         my @vector = map { 0 } 1..$n;
106
107         for my $i(0..$n-1)
108         {
109                 $matrix[0][$i] += 1;
110         }
111         $vector[0] += 0;
112         for my $z(1..$n-1)
113         {
114                 for my $i(0..$n-1)
115                 {
116                         $matrix[$z][$i] += $w->[$i]->[$z];
117                         $matrix[$z][$z] -= $w->[$i]->[$z];
118                         $vector[$z] += $w->[$i]->[$z] * $d->[$i]->[$z];
119                 }
120         }
121
122         return LinSolve(\@matrix, \@vector);
123 }
124
125 sub Evaluate($)
126 {
127         my ($matrix) = @_;
128         my %allweps;
129         while(my ($k, $v) = each %$matrix)
130         {
131                 for(my ($k2, $v2) = each %$v)
132                 {
133                         next if $k eq $k2;
134                         next if !$v2;
135                         ++$allweps{$k};
136                         ++$allweps{$k2};
137                 }
138         }
139         delete $allweps{0}; # ignore the tuba
140         my @allweps = keys %allweps;
141         my %values;
142
143         my @dmatrix = map { [ map { 0 } @allweps ] } @allweps;
144         my @wmatrix = map { [ map { 0 } @allweps ] } @allweps;
145
146         for my $i(0..@allweps - 1)
147         {
148                 my $attackweapon = $allweps[$i];
149                 my $v = 0;
150                 my $d = 0;
151                 for my $j(0..@allweps - 1)
152                 {
153                         my $defendweapon = $allweps[$j];
154                         next if $attackweapon eq $defendweapon;
155                         my $win = ($matrix->{$attackweapon}{$defendweapon} || 0);
156                         my $lose = ($matrix->{$defendweapon}{$attackweapon} || 0);
157                         my $c = ($win + $lose);
158                         next if $c == 0;
159                         my $p = $win / $c;
160                         my $w = 1 - 1/($c * 0.1 + 1);
161
162                         $dmatrix[$i][$j] = $p - (1 - $p); # antisymmetric
163                         $wmatrix[$i][$j] = $w;            # symmetric
164                 }
165         }
166
167         my @val;
168         eval
169         {
170                 @val = SolveBestSquares(\@dmatrix, \@wmatrix);
171                 1;
172         }
173         or do
174         {
175                 @val = map { undef } @allweps;
176         };
177
178         for my $i(0..@allweps - 1)
179         {
180                 my $attackweapon = $allweps[$i];
181                 $values{$attackweapon} = $val[$i];
182         }
183         return \%values;
184 }
185
186 sub out_text($@)
187 {
188         my ($event, @data) = @_;
189         if($event eq 'start')
190         {
191         }
192         elsif($event eq 'startmatrix')
193         {
194                 my ($addr, $map, @columns) = @data;
195                 $addr ||= 'any';
196                 $map ||= 'any';
197                 print "For server @{[$addr || 'any']} map @{[$map || 'any']}:\n";
198         }
199         elsif($event eq 'startrow')
200         {
201                 my ($row, $val) = @data;
202                 printf "  %-30s %8s |", $stats->weaponid_to_name($row), defined $val ? sprintf("%8.5f", $val) : "N/A";
203         }
204         elsif($event eq 'cell')
205         {
206                 my ($win, $lose, $p) = @data;
207                 if(!defined $p)
208                 {
209                         print "   .   ";
210                 }
211                 elsif(!$p)
212                 {
213                         printf " %6.3f", 0;
214                 }
215                 else
216                 {
217                         printf " %+6.3f", $p;
218                 }
219         }
220         elsif($event eq 'endrow')
221         {
222                 print "\n";
223         }
224         elsif($event eq 'endmatrix')
225         {
226                 my ($min) = @data;
227                 $min ||= 0;
228                 print "  Relevance: $min\n";
229                 print "\n";
230         }
231         elsif($event eq 'end')
232         {
233         }
234 }
235
236 sub out_html($@)
237 {
238         my ($event, @data) = @_;
239         if($event eq 'start')
240         {
241                 print "<html><body><h1>Weapon Profiling</h1>\n";
242         }
243         elsif($event eq 'startmatrix')
244         {
245                 my ($addr, $map, @columns) = @data;
246                 $addr ||= 'any';
247                 $map ||= 'any';
248                 print "<h2>For server @{[$addr || 'any']} map @{[$map || 'any']}:</h2>\n";
249                 print "<table><tr><th>Weapon</th><th>Rating</th>\n";
250                 printf '<th><img width=70 height=80 src="http://svn.icculus.org/*checkout*/nexuiz/trunk/Docs/htmlfiles/weaponimg/thirdperson-%s.png" alt="%s"></th>', $stats->weaponid_to_model($_), $stats->weaponid_to_name($_) for @columns;
251                 print "</tr>\n";
252         }
253         elsif($event eq 'startrow')
254         {
255                 my ($row, $val) = @data;
256                 printf '<tr><th><img width=108 height=53 src="http://svn.icculus.org/*checkout*/nexuiz/trunk/Docs/htmlfiles/weaponimg/firstperson-%s.png" alt="%s"></th><th align=right>%s</th>', $stats->weaponid_to_model($row), $stats->weaponid_to_name($row), defined $val ? sprintf("%8.5f", $val) : "N/A";
257         }
258         elsif($event eq 'cell')
259         {
260                 my ($win, $lose, $p) = @data;
261                 my $v = 200;
262                 if(!defined $p)
263                 {
264                         printf '<td align=center bgcolor="#808080">%d</td>', $win;
265                 }
266                 elsif($p > 0)
267                 {
268                         printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', $v - $v * $p, 255, 0, $win;
269                 }
270                 elsif($p < 0)
271                 {
272                         #printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', (255 - $v) - $v * $p, $v + $v * $p, 0, $win;
273                         printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', 255, $v + $v * $p, 0, $win;
274                 }
275                 else
276                 {
277                         printf '<td align=center bgcolor="#ffff00">%d</td>', $win;
278                 }
279         }
280         elsif($event eq 'endrow')
281         {
282                 print "</tr>";
283         }
284         elsif($event eq 'endmatrix')
285         {
286                 my ($min) = @data;
287                 $min ||= 0;
288                 print "</table>Relevance: $min\n";
289         }
290         elsif($event eq 'end')
291         {
292         }
293 }
294
295 my $out = $ENV{html} ? \&out_html : \&out_text;
296
297 LoadData();
298 $out->(start => ());
299 $stats->allstats(sub
300 {
301         my ($addr, $map, $data) = @_;
302         my $values = Evaluate $data;
303         my $valid = defined [values %$values]->[0];
304         my @weapons_sorted = sort { $valid ? $values->{$b} <=> $values->{$a} : $a <=> $b } keys %$values;
305         my $min = undef;
306         $out->(startmatrix => ($addr, $map, @weapons_sorted));
307         for my $row(@weapons_sorted)
308         {
309                 $out->(startrow => $row, ($valid ? $values->{$row} : undef));
310                 for my $col(@weapons_sorted)
311                 {
312                         my $win = ($data->{$row}{$col} || 0);
313                         my $lose = ($data->{$col}{$row} || 0);
314                         $min = $win + $lose
315                                 if $row ne $col and (not defined $min or $min > $win + $lose);
316                         $out->(cell => ($win, $lose, (($row ne $col) && ($win + $lose)) ? (2 * $win / ($win + $lose) - 1) : undef));
317                 }
318                 $out->(endrow => ());
319         }
320         $out->(endmatrix => ($min));
321 });
322 $out->(end => ());