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