Mercurial > hg > batmud > misc

annotate skinstats.pl @ 374:10d030b85117 misc tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Switch Convent map to SVG version, add link to PNG render to the caption.
author Matti Hamalainen <ccr@tnsp.org>
date Fri, 01 Mar 2024 10:02:38 +0200
parents 3a10a6ac7ec6
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
12
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
1 #!/usr/bin/perl -w
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
2 use strict;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
3 my $corpse_set = 0;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
4 my $corpse_name;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
5 my %pieces = ();
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
6 my %rpieces = ();
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
7 my %rcorpses = ();
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
8 my $rtotal = 0;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
9
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
10 while (<STDIN>) {
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
11 chomp;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
12 if (/^This is the dead body of ([A-Z][a-z ]+)\.$/) {
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
13 $corpse_name = $1;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
14 $corpse_set = 1;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
15 } elsif (/^([A-Z][a-z ]+) is DEAD, R.I.P\.$/) {
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
16 $corpse_name = $1;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
17 $corpse_set = 1;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
18 } elsif (/^You create a ([a-z]+) [a-z]+ by skinning the corpse\.$/) {
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
19 my $piece_name = $1;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
20 if ($corpse_set) {
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
21 $pieces{$corpse_name}{$piece_name}++;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
22 $rcorpses{$corpse_name}++;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
23 $rpieces{$piece_name}++;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
24 $rtotal++;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
25 }
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
26 $corpse_set = 0;
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
27 }
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
28 }
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
29
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
30 print "--------------------------------------\n";
13
3a10a6ac7ec6 Cosmetics.
Matti Hamalainen <ccr@tnsp.org>
parents: 12
diff changeset
31 for my $k1 (sort { $a cmp $b } keys %pieces) {
12
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
32 if ($rcorpses{$k1} >= 20) {
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
33 printf "%-15s [%3d]: ", $k1, $rcorpses{$k1};
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
34 for my $k2 ( sort { $a cmp $b } keys %{$pieces{$k1}} ) {
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
35 printf "%s=%1.1f%% | ",$k2, (($pieces{$k1}{$k2} * 100) / $rcorpses{$k1});
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
36 }
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
37 print "\n";
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
38 }
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
39 }
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
40
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
41 print "--------------------------------------\n";
13
3a10a6ac7ec6 Cosmetics.
Matti Hamalainen <ccr@tnsp.org>
parents: 12
diff changeset
42 for my $k1 (sort { $a cmp $b } keys %rpieces) {
12
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
43 printf "%-15s: %d (%1.1f%%)\n", $k1, $rpieces{$k1}, (($rpieces{$k1}*100)/$rtotal);
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
44 }
cdfdd13a82e8 Added simple Perl-script for making statistics about results of 'skinning' skill.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
45 print "--------------------------------------\n";