[nexuiz-commits] r6855 - trunk/misc/tools
DONOTREPLY at icculus.org
DONOTREPLY at icculus.org
Wed Jun 3 09:28:37 EDT 2009
Author: div0
Date: 2009-06-03 09:28:37 -0400 (Wed, 03 Jun 2009)
New Revision: 6855
Added:
trunk/misc/tools/WeaponEncounterProfile.pm
trunk/misc/tools/weapon-profiler-analyzer.pl
trunk/misc/tools/weapon-profiler.pl
Log:
weapon profiler
Added: trunk/misc/tools/WeaponEncounterProfile.pm
===================================================================
--- trunk/misc/tools/WeaponEncounterProfile.pm (rev 0)
+++ trunk/misc/tools/WeaponEncounterProfile.pm 2009-06-03 13:28:37 UTC (rev 6855)
@@ -0,0 +1,93 @@
+#!/usr/bin/perl
+
+package WeaponEncounterProfile;
+use strict;
+use warnings;
+
+sub new
+{
+ my ($cls, $filename) = @_;
+ my $self = bless { fn => $filename }, 'WeaponEncounterProfile';
+ $self->load();
+ return $self;
+}
+
+sub load($)
+{
+ my ($self) = @_;
+ $self->{stats} = {};
+ $self->{mapstats} = {};
+ $self->{addrstats} = {};
+ $self->{allstats} = {};
+ open my $fh, "<", $self->{fn}
+ or return;
+ while(<$fh>)
+ {
+ chomp;
+ my ($addr, $map, $attackerweapon, $targweapon, $value) = split /\t/, $_;
+ $self->{stats}->{$addr}{$map}{$attackerweapon}{$targweapon} += $value;
+ $self->{mapstats}->{$map}{$attackerweapon}{$targweapon} += $value;
+ $self->{addrstats}->{$addr}{$attackerweapon}{$targweapon} += $value;
+ $self->{allstats}->{$attackerweapon}{$targweapon} += $value;
+ }
+}
+
+sub save($)
+{
+ my ($self) = @_;
+ open my $fh, ">", $self->{fn}
+ or die "save: $!";
+ while(my ($addr, $addrhash) = each %{$self->{stats}})
+ {
+ while(my ($map, $maphash) = each %$addrhash)
+ {
+ while(my ($attackerweapon, $attackerweaponhash) = each %$maphash)
+ {
+ while(my ($targweapon, $value) = each %$attackerweaponhash)
+ {
+ print $fh "$addr\t$map\t$attackerweapon\t$targweapon\t$value\n";
+ }
+ }
+ }
+ }
+}
+
+sub event($$$$$$)
+{
+ my ($self, $addr, $map, $attackerweapon, $targweapon, $type) = @_;
+ return if $map eq '';
+ if($type > 0)
+ {
+ $self->{stats}->{$addr}{$map}{$attackerweapon}{$targweapon} += $type;
+ $self->{mapstats}->{$map}{$attackerweapon}{$targweapon} += $type;
+ $self->{addrstats}->{$addr}{$attackerweapon}{$targweapon} += $type;
+ $self->{allstats}->{$attackerweapon}{$targweapon} += $type;
+ }
+}
+
+sub allstats($$)
+{
+ my ($self, $callback) = @_;
+ # send global stats
+ $callback->(undef, undef, $self->{allstats});
+ # send per-host stats
+ while(my ($k, $v) = each %{$self->{addrstats}})
+ {
+ $callback->($k, undef, $v);
+ }
+ # send per-map stats
+ while(my ($k, $v) = each %{$self->{mapstats}})
+ {
+ $callback->(undef, $k, $v);
+ }
+ # send single stats
+ while(my ($k1, $v1) = each %{$self->{stats}})
+ {
+ while(my ($k2, $v2) = each %$v1)
+ {
+ $callback->($k1, $k2, $v2);
+ }
+ }
+}
+
+1;
Added: trunk/misc/tools/weapon-profiler-analyzer.pl
===================================================================
--- trunk/misc/tools/weapon-profiler-analyzer.pl (rev 0)
+++ trunk/misc/tools/weapon-profiler-analyzer.pl 2009-06-03 13:28:37 UTC (rev 6855)
@@ -0,0 +1,221 @@
+#!/usr/bin/perl
+
+# no warranty for this script
+# and no documentation
+# take it or leave it
+
+use strict;
+use warnings;
+use FindBin; use lib $FindBin::Bin;
+use WeaponEncounterProfile;
+
+my ($statsfile) = @ARGV;
+my $stats;
+
+sub LoadData()
+{
+ $stats = WeaponEncounterProfile->new($statsfile);
+}
+
+sub LinSolve($$)
+{
+ my ($m, $v) = @_;
+ my $n = @$m;
+
+ my @out = ();
+
+ my @bigmatrix = map { [ @{$m->[$_]}, $v->[$_] ] } 0..$n-1;
+
+ # 1. Triangulate
+ for my $i(0..$n-1)
+ {
+ # first: bring the highest value to the top
+ my $best = -1;
+ my $bestval = 0;
+ for my $j($i..$n-1)
+ {
+ my $v = $bigmatrix[$j]->[$i];
+ if($v*$v > $bestval*$bestval)
+ {
+ $best = $j;
+ $bestval = $v;
+ }
+ }
+ die "lindep" if $best == -1;
+
+ # swap
+ ($bigmatrix[$i], $bigmatrix[$best]) = ($bigmatrix[$best], $bigmatrix[$i]);
+
+ # then: eliminate
+ for my $j($i+1..$n-1)
+ {
+ my $r = $bigmatrix[$j]->[$i];
+ for my $k(0..$n)
+ {
+ $bigmatrix[$j]->[$k] -= $bigmatrix[$i]->[$k] * $r / $bestval;
+ }
+ }
+ }
+
+ # 2. Diagonalize
+ for my $i(reverse 0..$n-1)
+ {
+ my $bestval = $bigmatrix[$i]->[$i];
+ for my $j(0..$i-1)
+ {
+ my $r = $bigmatrix[$j]->[$i];
+ for my $k(0..$n)
+ {
+ $bigmatrix[$j]->[$k] -= $bigmatrix[$i]->[$k] * $r / $bestval;
+ }
+ }
+ }
+
+ # 3. Read off solutions
+ return map { $bigmatrix[$_]->[$n] / $bigmatrix[$_]->[$_] } 0..($n-1);
+}
+
+sub SolveBestSquares($$)
+{
+ my ($d, $w) = @_;
+
+ my $n = @$d;
+
+ if($ENV{stupid})
+ {
+ my @result = ();
+ for my $i(0..$n-1)
+ {
+ my $num = 0;
+ my $denom = 0;
+ for my $j(0..$n-1)
+ {
+ my $weight = $w->[$i]->[$j];
+ $num += $weight * $d->[$i]->[$j];
+ $denom += $weight;
+ }
+ push @result, $num / $denom;
+ }
+ return @result;
+ }
+
+ # build linear equation system
+
+ my @matrix = map { [ map { 0 } 1..$n ] } 1..$n;
+ my @vector = map { 0 } 1..$n;
+
+ for my $i(0..$n-1)
+ {
+ $matrix[0][$i] += 1;
+ }
+ $vector[0] += 0;
+ for my $z(1..$n-1)
+ {
+ for my $i(0..$n-1)
+ {
+ $matrix[$z][$i] += $w->[$i]->[$z];
+ $matrix[$z][$z] -= $w->[$i]->[$z];
+ $vector[$z] += $w->[$i]->[$z] * $d->[$i]->[$z];
+ }
+ }
+
+ return LinSolve(\@matrix, \@vector);
+}
+
+sub Evaluate($)
+{
+ my ($matrix) = @_;
+ my %allweps;
+ for(keys %$matrix)
+ {
+ ++$allweps{$_};
+ for(keys %{$matrix->{$_}})
+ {
+ ++$allweps{$_};
+ }
+ }
+ delete $allweps{"@!#%'n Tuba"};
+ delete $allweps{"Port-O-Launch"};
+ my @allweps = keys %allweps;
+ my %values;
+
+ my @dmatrix = map { [ map { 0 } @allweps ] } @allweps;
+ my @wmatrix = map { [ map { 0 } @allweps ] } @allweps;
+
+ for my $i(0.. at allweps - 1)
+ {
+ my $attackweapon = $allweps[$i];
+ my $v = 0;
+ my $d = 0;
+ for my $j(0.. at allweps - 1)
+ {
+ my $defendweapon = $allweps[$j];
+ next if $attackweapon eq $defendweapon;
+ my $win = ($matrix->{$attackweapon}{$defendweapon} || 0);
+ my $lose = ($matrix->{$defendweapon}{$attackweapon} || 0);
+ my $c = ($win + $lose);
+ next if $c == 0;
+ my $p = $win / $c;
+ my $w = 1 - 1/($c * 0.1 + 1);
+
+ $dmatrix[$i][$j] = $p - (1 - $p); # antisymmetric
+ $wmatrix[$i][$j] = $w; # symmetric
+ }
+ }
+
+ my @val;
+ eval
+ {
+ @val = SolveBestSquares(\@dmatrix, \@wmatrix);
+ 1;
+ }
+ or do
+ {
+ @val = map { undef } @allweps;
+ };
+
+ for my $i(0.. at allweps - 1)
+ {
+ my $attackweapon = $allweps[$i];
+ $values{$attackweapon} = $val[$i];
+ }
+ return \%values;
+}
+
+LoadData();
+$stats->allstats(sub
+{
+ my ($addr, $map, $data) = @_;
+ print "For server @{[$addr || 'any']} map @{[$map || 'any']}:\n";
+ my $values = Evaluate $data;
+ my $valid = defined [values %$values]->[0];
+ my @weapons_sorted = sort { $valid ? $values->{$b} <=> $values->{$a} : $a cmp $b } keys %$values;
+ my $min = undef;
+ for my $row(@weapons_sorted)
+ {
+ printf " %-30s %8s |", $row, $valid ? sprintf("%8.5f", $values->{$row}) : "N/A";
+ for my $col(@weapons_sorted)
+ {
+ my $win = ($data->{$row}{$col} || 0);
+ my $lose = ($data->{$col}{$row} || 0);
+ $min = $win + $lose
+ if $row ne $col and (not defined $min or $min > $win + $lose);
+ if(($row eq $col) || ($win + $lose == 0))
+ {
+ print " . ";
+ }
+ elsif($win == $lose)
+ {
+ printf " %6.3f", 0;
+ }
+ else
+ {
+ my $p = 2 * ($win / ($win + $lose) - 0.5);
+ printf " %+6.3f", $p;
+ }
+ }
+ print "\n";
+ }
+ $min ||= 0;
+ print " Relevance: $min\n";
+});
Property changes on: trunk/misc/tools/weapon-profiler-analyzer.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/misc/tools/weapon-profiler.pl
===================================================================
--- trunk/misc/tools/weapon-profiler.pl (rev 0)
+++ trunk/misc/tools/weapon-profiler.pl 2009-06-03 13:28:37 UTC (rev 6855)
@@ -0,0 +1,202 @@
+#!/usr/bin/perl
+
+# no warranty for this script
+# and no documentation
+# take it or leave it
+
+use strict;
+use warnings;
+use FindBin; use lib $FindBin::Bin;
+use IO::Socket;
+use Socket;
+use sigtrap qw(die normal-signals);
+use WeaponEncounterProfile;
+
+my %weaponmap = (
+ 1 => "Laser",
+ 2 => "Shotgun",
+ 3 => "Uzi",
+ 4 => "Mortar",
+ 5 => "Electro",
+ 6 => "Crylink",
+ 7 => "Nex",
+ 8 => "Hagar",
+ 9 => "Rocket Launcher",
+ 10 => "Port-O-Launch",
+ 11 => "MinstaNex",
+ 12 => "Grappling Hook",
+ 13 => "Heavy Laser Assault Cannon",
+ 14 => "T.A.G. Seeker",
+ 15 => "Camping Rifle",
+ 0 => "@!#%'n Tuba"
+);
+
+my ($statsfile) = @ARGV;
+my $password = $ENV{rcon_password};
+my $server = $ENV{rcon_address};
+my $bind = $ENV{rcon_bindaddress};
+
+my $stats;
+
+sub AddKill($$$$$)
+{
+ my ($addr, $map, $attackerweapon, $targweapon, $type) = @_;
+ $stats->event($addr, $map, $attackerweapon, $targweapon, $type);
+}
+
+sub StoreData()
+{
+ $stats->save();
+}
+
+sub LoadData()
+{
+ $stats = WeaponEncounterProfile->new($statsfile);
+}
+
+$SIG{ALRM} = sub
+{
+ print STDERR "Operation timed out.\n";
+ exit 1;
+};
+
+our @discosockets = ();
+sub LogDestUDP($)
+{
+ # connects to a DP server using rcon with log_dest_udp
+ my ($sock) = @_;
+ my $value = sprintf "%s:%d", $sock->sockhost(), $sock->sockport();
+ $sock->send("\377\377\377\377rcon $password log_dest_udp", 0)
+ or die "send rcon: $!";
+ alarm 15;
+ for(;;)
+ {
+ $sock->recv(my $response, 2048, 0)
+ or die "recv: $!";
+ if($response =~ /^\377\377\377\377n"log_dest_udp" is "(.*)" \[".*"\]\n$/s)
+ {
+ alarm 0;
+ my @dests = split /\s+/, $1;
+ return
+ if grep { $_ eq $value } @dests;
+ push @dests, $value;
+ $sock->send("\377\377\377\377rcon $password log_dest_udp \"@dests\"");
+ last;
+ }
+ }
+ alarm 0;
+ push @discosockets, [$sock, $value];
+
+ END
+ {
+ for(@discosockets)
+ {
+ my ($s, $v) = @$_;
+ # disconnects (makes the server stop send the data to us)
+ $s->send("\377\377\377\377rcon $password log_dest_udp", 0)
+ or die "send rcon: $!";
+ alarm 15;
+ for(;;)
+ {
+ $s->recv(my $response, 2048, 0)
+ or die "recv: $!";
+ if($response =~ /^\377\377\377\377n"log_dest_udp" is "(.*)" \[".*"\]\n$/s)
+ {
+ alarm 0;
+ my @dests = split /\s+/, $1;
+ return
+ if not grep { $_ eq $v } @dests;
+ @dests = grep { $_ ne $v } @dests;
+ $s->send("\377\377\377\377rcon $password log_dest_udp \"@dests\"");
+ last;
+ }
+ }
+ alarm 0;
+ }
+ }
+}
+
+sub sockaddr_readable($)
+{
+ my ($binary) = @_;
+ my ($port, $addr) = sockaddr_in $binary;
+ return sprintf "%s:%d", inet_ntoa($addr), $port;
+}
+
+my $sock;
+if(defined $bind)
+{
+ # bind to a port and wait for any packets
+ $sock = IO::Socket::INET->new(Proto => 'udp', LocalAddr => $bind, LocalPort => 26000)
+ or die "socket: $!";
+}
+else
+{
+ # connect to a DP server
+ $sock = IO::Socket::INET->new(Proto => 'udp', PeerAddr => $server, PeerPort => 26000)
+ or die "socket: $!";
+ LogDestUDP $sock;
+}
+my %currentmap = ();
+
+my %bots = ();
+
+LoadData();
+while(my $addr = sockaddr_readable $sock->recv($_, 2048, 0))
+{
+ $addr = ""
+ if not defined $bind;
+ s/^\377\377\377\377n//
+ or next;
+ for(split /\r?\n/, $_)
+ {
+ if(/^:gamestart:([^:]+):/)
+ {
+ StoreData();
+ $currentmap{$addr} = $1;
+ $bots{$addr} = {};
+ print "($addr) switching to $1\n";
+ next;
+ }
+
+ next
+ unless defined $currentmap{$addr};
+ if(/^:join:(\d+):bot:/)
+ {
+ $bots{$addr}{$1} = 1;
+ }
+ elsif(/^:kill:frag:(\d+):(\d+):type=(\d+):items=(\d+)([A-Z]*)(?:|(\d+)):victimitems=(\d+)([A-Z]*)(?:|(\d+))$/)
+ {
+ my ($a, $b, $type, $killweapon, $killflags, $killrunes, $victimweapon, $victimflags, $victimrules) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
+ next
+ if exists $bots{$addr}{$a} or exists $bots{$addr}{$b}; # only count REAL kills
+ $type &= 0xFF
+ if $type < 10000;
+ $killweapon = $type
+ if defined $weaponmap{$type}; # if $type is not a weapon deathtype, count the weapon of the killer
+ $killweapon = 0
+ if not defined $weaponmap{$killweapon}; # invalid weapon? that's 0 then
+ $victimweapon = 0
+ if not defined $weaponmap{$victimweapon}; # dito
+ $killweapon = $weaponmap{$killweapon};
+ $victimweapon = $weaponmap{$victimweapon};
+ next
+ if $killflags =~ /S|I/ or $victimflags =~ /T/; # no strength, shield or typekills (these skew the statistics)
+ AddKill($addr, $currentmap{$addr}, $killweapon, $victimweapon, +1);
+ }
+ elsif(/^:kill:suicide:\d+:\d+:type=(\d+):items=(\d+)([A-Z]*)(?:|(\d+))$/)
+ {
+ my ($type, $killweapon, $killflags, $killrunes) = ($1, $2, $3, $4, $5, $6, $7);
+ $type &= 0xFF
+ if $type < 10000;
+ $killweapon = $type
+ if defined $weaponmap{$type};
+ $killweapon = 0
+ if not defined $weaponmap{$killweapon};
+ $killweapon = $weaponmap{$killweapon};
+ next
+ if $killflags =~ /S/; # no strength suicides (happen too easily accidentally)
+ AddKill($addr, $currentmap{$addr}, $killweapon, $killweapon, +1);
+ }
+ }
+}
Property changes on: trunk/misc/tools/weapon-profiler.pl
___________________________________________________________________
Name: svn:executable
+ *
More information about the nexuiz-commits
mailing list