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         for(keys %$matrix)
 130         {
 131                 ++$allweps{$_};
 132                 for(keys %{$matrix->{$_}})
 133                 {
 134                         ++$allweps{$_};
 135                 }
 136         }
 137         delete $allweps{"@!#%'n Tuba"};
 138         delete $allweps{"Port-O-Launch"};
 139         my @allweps = keys %allweps;
 140         my %values;
 141
 142         my @dmatrix = map { [ map { 0 } @allweps ] } @allweps;
 143         my @wmatrix = map { [ map { 0 } @allweps ] } @allweps;
 144
 145         for my $i(0..@allweps - 1)
 146         {
 147                 my $attackweapon = $allweps[$i];
 148                 my $v = 0;
 149                 my $d = 0;
 150                 for my $j(0..@allweps - 1)
 151                 {
 152                         my $defendweapon = $allweps[$j];
 153                         next if $attackweapon eq $defendweapon;
 154                         my $win = ($matrix->{$attackweapon}{$defendweapon} || 0);
 155                         my $lose = ($matrix->{$defendweapon}{$attackweapon} || 0);
 156                         my $c = ($win + $lose);
 157                         next if $c == 0;
 158                         my $p = $win / $c;
 159                         my $w = 1 - 1/($c * 0.1 + 1);
 160
 161                         $dmatrix[$i][$j] = $p - (1 - $p); # antisymmetric
 162                         $wmatrix[$i][$j] = $w;            # symmetric
 163                 }
 164         }
 165
 166         my @val;
 167         eval
 168         {
 169                 @val = SolveBestSquares(\@dmatrix, \@wmatrix);
 170                 1;
 171         }
 172         or do
 173         {
 174                 @val = map { undef } @allweps;
 175         };
 176
 177         for my $i(0..@allweps - 1)
 178         {
 179                 my $attackweapon = $allweps[$i];
 180                 $values{$attackweapon} = $val[$i];
 181         }
 182         return \%values;
 183 }
 184
 185 LoadData();
 186 $stats->allstats(sub
 187 {
 188         my ($addr, $map, $data) = @_;
 189         print "For server @{[$addr || 'any']} map @{[$map || 'any']}:\n";
 190         my $values = Evaluate $data;
 191         my $valid = defined [values %$values]->[0];
 192         my @weapons_sorted = sort { $valid ? $values->{$b} <=> $values->{$a} : $a cmp $b } keys %$values;
 193         my $min = undef;
 194         for my $row(@weapons_sorted)
 195         {
 196                 printf "  %-30s %8s |", $row, $valid ? sprintf("%8.5f", $values->{$row}) : "N/A";
 197                 for my $col(@weapons_sorted)
 198                 {
 199                         my $win = ($data->{$row}{$col} || 0);
 200                         my $lose = ($data->{$col}{$row} || 0);
 201                         $min = $win + $lose
 202                                 if $row ne $col and (not defined $min or $min > $win + $lose);
 203                         if(($row eq $col) || ($win + $lose == 0))
 204                         {
 205                                 print "   .   ";
 206                         }
 207                         elsif($win == $lose)
 208                         {
 209                                 printf " %6.3f", 0;
 210                         }
 211                         else
 212                         {
 213                                 my $p = 2 * ($win / ($win + $lose) - 0.5);
 214                                 printf " %+6.3f", $p;
 215                         }
 216                 }
 217                 print "\n";
 218         }
 219         $min ||= 0;
 220         print "  Relevance: $min\n";
 221 });