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                 while(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, $type, $map, @columns) = @data;
 195                 $addr ||= 'any';
 196                 $map ||= 'any';
 197                 $type ||= 'any';
 198                 print "For server $addr type $type map $map:\n";
 199         }
 200         elsif($event eq 'startrow')
 201         {
 202                 my ($row, $val) = @data;
 203                 printf "  %-30s %8s |", $stats->weaponid_to_name($row), defined $val ? sprintf("%8.5f", $val) : "N/A";
 204         }
 205         elsif($event eq 'cell')
 206         {
 207                 my ($win, $lose, $p) = @data;
 208                 if(!defined $p)
 209                 {
 210                         print "   .   ";
 211                 }
 212                 elsif(!$p)
 213                 {
 214                         printf " %6.3f", 0;
 215                 }
 216                 else
 217                 {
 218                         printf " %+6.3f", $p;
 219                 }
 220         }
 221         elsif($event eq 'endrow')
 222         {
 223                 print "\n";
 224         }
 225         elsif($event eq 'endmatrix')
 226         {
 227                 my ($min) = @data;
 228                 $min ||= 0;
 229                 print "  Relevance: $min\n";
 230                 print "\n";
 231         }
 232         elsif($event eq 'end')
 233         {
 234         }
 235 }
 236
 237 sub html($)
 238 {
 239         my ($s) = @_;
 240         $s =~ s/[^-_A-Za-z0-9 ]/&#@{[ord $&]};/g;
 241         return $s;
 242 }
 243
 244 sub nospace($)
 245 {
 246         my ($s) = @_;
 247         $s =~ s/ //g;
 248         return $s;
 249 }
 250
 251 sub out_html($@)
 252 {
 253         my ($event, @data) = @_;
 254         if($event eq 'start')
 255         {
 256                 print "<html><body><h1>Weapon Profiling</h1>\n";
 257         }
 258         elsif($event eq 'startmatrix')
 259         {
 260                 my ($addr, $type, $map, @columns) = @data;
 261                 $addr ||= 'any';
 262                 $type ||= 'any';
 263                 $map ||= 'any';
 264                 print "<h2>For server $addr type $type map $map</h2>\n";
 265                 print "<table><tr><th>Weapon</th><th>Rating</th>\n";
 266                 printf '<th><img width=64 height=87 src="weaponimg/%s_3rd_small.png" title="%s" alt="%s"></th>', $stats->weaponid_to_model($_), html $stats->weaponid_to_name($_), html nospace $stats->weaponid_to_name($_) for @columns;
 267                 print "</tr>\n";
 268         }
 269         elsif($event eq 'startrow')
 270         {
 271                 my ($row, $val) = @data;
 272                 printf '<tr><th><img width=96 height=64 src="weaponimg/%s_1st_small.png" title="%s" alt="%s"></th><th align=right>%s</th>', $stats->weaponid_to_model($row), html $stats->weaponid_to_name($row), html nospace $stats->weaponid_to_name($row), defined $val ? sprintf("%8.5f", $val) : "N/A";
 273         }
 274         elsif($event eq 'cell')
 275         {
 276                 my ($win, $lose, $p) = @data;
 277                 my $v = 200;
 278                 if(!defined $p)
 279                 {
 280                         printf '<td align=center bgcolor="#808080">%d</td>', $win;
 281                 }
 282                 elsif($p > 0)
 283                 {
 284                         printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', $v - $v * $p, 255, 0, $win;
 285                 }
 286                 elsif($p < 0)
 287                 {
 288                         #printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', (255 - $v) - $v * $p, $v + $v * $p, 0, $win;
 289                         printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', 255, $v + $v * $p, 0, $win;
 290                 }
 291                 else
 292                 {
 293                         printf '<td align=center bgcolor="#ffff00">%d</td>', $win;
 294                 }
 295         }
 296         elsif($event eq 'endrow')
 297         {
 298                 print "</tr>";
 299         }
 300         elsif($event eq 'endmatrix')
 301         {
 302                 my ($min) = @data;
 303                 $min ||= 0;
 304                 print "</table>Relevance: $min\n";
 305         }
 306         elsif($event eq 'end')
 307         {
 308         }
 309 }
 310
 311 my $out_html_cache_fh;
 312 sub out_html_cache($@)
 313 {
 314         my ($event, @data) = @_;
 315         if($event eq 'startmatrix')
 316         {
 317                 # open out file
 318                 my ($addr, $type, $map, @columns) = @data;
 319                 if(!defined $addr)
 320                 {
 321                         $type ||= ':any';
 322                         $map ||= ':any';
 323                         mkdir "$type";
 324                         open $out_html_cache_fh, ">", "$type/$map"
 325                                 or warn "open $type/$map: $!";
 326                         select $out_html_cache_fh;
 327                 }
 328         }
 329         out_html($event, @data)
 330                 if defined $out_html_cache_fh;
 331         if($event eq 'endmatrix')
 332         {
 333                 # close out file
 334                 select STDOUT;
 335                 close $out_html_cache_fh
 336                         if defined $out_html_cache_fh;
 337                 undef $out_html_cache_fh;
 338         }
 339 }
 340
 341 my $out =
 342         $ENV{html_cache} ? \&out_html_cache :
 343         $ENV{html}       ? \&out_html       :
 344         \&out_text;
 345
 346 LoadData();
 347 $out->(start => ());
 348 $stats->allstats(sub
 349 {
 350         my ($addr, $type, $map, $data) = @_;
 351         my $values = Evaluate $data;
 352         my $valid = defined [values %$values]->[0];
 353         my @weapons_sorted = sort { $valid ? $values->{$b} <=> $values->{$a} : $a <=> $b } keys %$values;
 354         my $min = undef;
 355         $out->(startmatrix => ($addr, $type, $map, @weapons_sorted));
 356         for my $row(@weapons_sorted)
 357         {
 358                 $out->(startrow => $row, ($valid ? $values->{$row} : undef));
 359                 for my $col(@weapons_sorted)
 360                 {
 361                         my $win = ($data->{$row}{$col} || 0);
 362                         my $lose = ($data->{$col}{$row} || 0);
 363                         $min = $win + $lose
 364                                 if $row ne $col and (not defined $min or $min > $win + $lose);
 365                         $out->(cell => ($win, $lose, (($row ne $col) && ($win + $lose)) ? (2 * $win / ($win + $lose) - 1) : undef));
 366                 }
 367                 $out->(endrow => ());
 368         }
 369         $out->(endmatrix => ($min));
 370 });
 371 $out->(end => ());