[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