Hello fellow monks,
I was curious about my progress in the XP game, and found it hard to visualize so I made this little script to produce a report on "XP Efficiency."
It attempts to produce a ranking of Saints by comparing XP to either number of posts made, or to how long the Saint has been a Monk.
I made a couple of efforts at making the data more relevant. For example, I exclude anyone who hasn't been active for a certain time, and anyone who has not made a minimum number of posts. This eliminates the Monks who have accumulated thousands of points but are not here in the community these days, as well as those who do come by regularly but have never posted anything.
I also try to get at meaningful data by deducting half a point for each day as a Monk, since I'm most interested in XP efficiency based on real contributions to the Monastery, i.e. XP for upvotes and for votes cast, not for votes accumulated through simple longevity. (Of course it is impossible to properly account for all factors, e.g. the fact that there were far fewer Monks in the early days, so posts had fewer potential upvotes they could earn.) Would like to hear any suggestions on how to improve this "normalization" of the data. Mostly though the results appear to be in line with what I would have expected so I don't think it's too far off. Deducting a point per day seems to make a small difference, and only for XP/posts.
It's just for fun, but it helps motivate me to excel as a teacher and as a student. You can run the script and force it to include you in the rankings even if you don't make the top 20 (or whatever you limit the search to), so you can see your progress at a glance.
Usage:
$ perl XP_efficiency.pl
Usage: perl XP_efficiency.pl --sort_by (age|posts)
Options:
--sort_by, -s: Rank monks by XP/posts or by XP/age
--limit, -l: Limit results to this many
--order, -o: Sort order (asc|desc)
--recent, -r: Limit to monks seen in the last n wee
+ks
--only_include, -i: Skip all monks except this/these one(
+s)
--force_include, -f: Include this/these monk(s) even if -l
+ is set
--min_posts, -m: Exclude monks with fewer than this ma
+ny posts
--no_adjust, -n: Don't deduct 0.5 XP for each day of m
+onkhood
--help, -h: Print this help
A couple of example reports:
$ perl XP_efficiency.pl --sort_by age --min_posts 200 --recent 3 --lim
+it 10 --order desc
+---------------------------------------------------------------------
+-----------------+
| Pos | St. | Monk name | XP | Level | Age | XP/Age |
+Posts | XP/Posts |
+---------------------------------------------------------------------
+-----------------+
| 1 2 BrowserUk 159,881 Pope (28) 4,971 36.0644
+22,404 6.9144 |
| 2 3 ikegami 127,624 Pope (28) 4,173 34.2347
+19,716 6.2615 |
| 3 4 Corion 122,789 Pope (28) 5,783 23.4148
+ 9,796 11.9443 |
| 4 5 GrandFather 72,446 Sage (25) 3,880 20.4526
+ 6,562 10.4489 |
| 5 55 Athanasius 24,854 Canon (20) 1,352 20.1077
+ 1,458 16.1193 |
| 6 664 1nickt 3,115 Curate (13) 214 15.6199
+ 468 6.1987 |
| 7 42 choroba 29,288 Canon (20) 2,112 14.8885
+ 3,739 7.2683 |
| 8 20 toolic 43,023 Bishop (22) 3,130 14.7489
+ 3,597 11.0906 |
| 9 7 tye 70,849 Sage (25) 5,661 13.3272
+ 7,887 8.2652 |
| 10 60 kcott 24,138 Canon (20) 1,939 13.2484
+ 2,407 9.2227 |
+---------------------------------------------------------------------
+-----------------+
The next two show the effect of adjusting to discount the daily freebie XP point (not really seen when sorting by XP/age; this is XP/posts):
$ perl XP_efficiency.pl -s posts -m 200 -l 5 -o desc -n
+---------------------------------------------------------------------
+-----------------+
| Pos | St. | Monk name | XP | Level | Age | XP/Age |
+Posts | XP/Posts |
+---------------------------------------------------------------------
+-----------------+
| 1 82 gryphon 18,249 Abbot (19) 5,643 3.7429
+ 218 83.7110 |
| 2 17 Old_Gray_Bear 46,694 Bishop (22) 4,507 11.9908
+ 598 78.0836 |
| 3 72 gmax 20,739 Abbot (19) 5,164 4.6478
+ 292 71.0240 |
| 4 54 Perlbotics 24,920 Canon (20) 3,056 9.4366
+ 384 64.8958 |
| 5 34 Gavin 32,148 Chancellor (21) 3,599 10.3364
+ 600 53.5800 |
+---------------------------------------------------------------------
+-----------------+
$ perl XP_efficiency.pl -s posts -m 200 -l 5 -o desc
+---------------------------------------------------------------------
+-----------------+
| Pos | St. | Monk name | XP | Level | Age | XP/Age |
+Posts | XP/Posts |
+---------------------------------------------------------------------
+-----------------+
| 1 17 Old_Gray_Bear 46,694 Bishop (22) 4,507 10.8334
+ 598 70.5468 |
| 2 82 gryphon 18,249 Abbot (19) 5,643 2.5855
+ 218 57.8257 |
| 3 54 Perlbotics 24,920 Canon (20) 3,056 8.2794
+ 384 56.9375 |
| 4 72 gmax 20,739 Abbot (19) 5,164 3.4905
+ 292 53.3390 |
| 5 34 Gavin 32,148 Chancellor (21) 3,599 9.1792
+ 600 47.5817 |
+---------------------------------------------------------------------
+-----------------+
Include yourself and someone else and see how you stack up:
$ perl XP_efficiency.pl -s posts -m 200 -l 10 -o desc -f 1nickt -f mer
+lyn
+---------------------------------------------------------------------
+-----------------+
| Pos | St. | Monk name | XP | Level | Age | XP/Age |
+Posts | XP/Posts |
+---------------------------------------------------------------------
+-----------------+
| 1 17 Old_Gray_Bear 46,694 Bishop (22) 4,507 10.8334
+ 598 70.5468 |
| 2 82 gryphon 18,249 Abbot (19) 5,643 2.5855
+ 218 57.8257 |
| 3 54 Perlbotics 24,920 Canon (20) 3,056 8.2794
+ 384 56.9375 |
| 4 72 gmax 20,739 Abbot (19) 5,164 3.4905
+ 292 53.3390 |
| 5 34 Gavin 32,148 Chancellor (21) 3,599 9.1792
+ 600 47.5817 |
| 6 100 scorpio17 16,117 Abbot (19) 3,253 4.5761
+ 323 39.8266 |
| 7 61 hsmyers 23,992 Canon (20) 5,452 3.9352
+ 520 35.6538 |
| 8 44 borisz 27,915 Canon (20) 4,756 5.6351
+ 913 25.3658 |
| 9 129 dvergin 12,732 Monsignor (18) 5,825 1.3724
+ 311 22.2090 |
| 10 58 FunkyMonk 24,201 Canon (20) 3,187 7.6302
+ 1,024 20.5215 |
| 41 6 merlyn 71,157 Sage (25) 5,741 13.1874
+ 6,322 10.3474 |
| 82 664 1nickt 3,115 Curate (13) 214 15.6198
+ 468 6.1987 |
+---------------------------------------------------------------------
+-----------------+
Code if you would like to play with it:
#!/usr/bin/perl
use strict;
use warnings;
use feature qw/ say /;
use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use Getopt::Long;
use HTTP::Tiny;
use HTML::TableExtract;
use Time::Piece;
use Number::Format qw/ format_number /;
use List::Util qw/ any /;
my ( $sort_by, $order, $limit, $recent, $only_include, $force_include,
+ $min_posts, $no_adjust );
GetOptions(
'sort_by|s=s' => \$sort_by,
'order|o=s' => \$order,
'limit|l=i' => \$limit,
'recent|r=i' => \$recent,
'only_include|i=s@' => \$only_include,
'force_include|f=s@' => \$force_include,
'min_posts|m=i', => \$min_posts,
'no_adjust|n' => \$no_adjust,
'help|?' => \&print_usage,
);
minor_validation();
my $url = 'http://perlmonks.com/?node_id=3559';
my $headers = ['#', 'User', 'Experience', 'Level', 'Writeups', 'User S
+ince', 'Last Here'];
my $data;
fetch_data( $url );
print_data( $data );
exit;
######################################
sub fetch_data {
my $url = shift;
my $page = HTTP::Tiny->new->get( $url );
die 'Died. No response' if not $page;
die "Died. $page->{'status'} $page->{'reason'}" if not $page->{'su
+ccess'};
my $table = HTML::TableExtract->new( 'headers' => $headers );
$table->parse( $page->{'content'} );
my $now = time();
foreach my $row ( $table->rows ) {
process_row( $now, $row );
}
}
sub process_row {
my $now = shift;
my $row = shift;
my ( $rank, $monk, $xp, $level, $posts, $created, $last_here ) = @
+{ $row };
return if $last_here =~ /year/ or ( $last_here =~ /(\d+) week/ and
+ $1 > ( $recent || 4 ) );
return if $sort_by eq 'posts' and $posts eq 'None';
return if $min_posts and ( $posts eq 'None' or $posts < $min_posts
+ );
return if $only_include and not any { $_ eq $monk } @{ $only_inclu
+de };
$created = Time::Piece->strptime($created, '%Y-%m-%d %R')->epoch;
my $age = $now - $created;
my $age_days = int( $age / 86400 );
my $xp_adjusted = $no_adjust ? $xp : $xp - ( $age_days / 2 );
my %record = (
rank => $rank,
xp => $xp,
level => $level,
posts => $posts,
by_posts => $posts eq 'None' ? 0 : ( $xp_adjusted / $posts ),
age => $age_days,
by_age => ( $xp_adjusted / $age ) * 100000, # for scale
);
$data->{ $monk } = \%record;
}
sub print_data {
my $data = shift;
$sort_by = 'by_' . $sort_by;
my %sortable = ( map { $_ => $data->{ $_ }->{ $sort_by } } keys %{
+ $data } );
my @results;
foreach my $monk ( sort { $sortable{$a} <=> $sortable{$b} } keys %
+sortable ) {
$data->{ $monk }->{'posts'} =~ s/None/0/;
push @results, {
rank => $data->{ $monk }->{'rank'},
monk => $monk,
xp => format_number( $data->{ $monk }->{'xp'} ),
level => $data->{ $monk }->{'level'},
age => format_number( $data->{ $monk }->{'age'} ),
by_age => format_number( $data->{ $monk }->{'by_age'}, 4
+, 1 ),
posts => format_number( $data->{ $monk }->{'posts'} ),
by_posts => format_number( $data->{ $monk }->{'by_posts'},
+ 4, 1 )
};
}
@results = reverse @results if $order and $order eq 'desc';
print <<EOT;
+---------------------------------------------------------------------
+-----------------+
| Pos | St. | Monk name | XP | Level | Age | XP/Age |
+Posts | XP/Posts |
+---------------------------------------------------------------------
+-----------------+
EOT
my $count = 0;
foreach my $result ( @results ) {
++$count;
if ( $limit and $count > $limit ) {
last if not defined $force_include;
next unless any { $_ eq $result->{'monk'} } @{ $force_incl
+ude };
}
format =
@ @### @#### @<<<<<<<<<<<< @>>>>>> @>>>>>>>>>>>>>>> @>>>>>> @>>>>>>> @
+>>>>>> @>>>>>>>> @
'|', $count, $result->{'rank'}, $result->{'monk'}, $result->{'xp'}, $r
+esult->{'level'}, $result->{'age'}, $result->{'by_age'}, $result->{'p
+osts'}, $result->{'by_posts'}, '|'
.
write;
}
print '+----------------------------------------------------------
+----------------------------+';
}
sub minor_validation {
print_usage() if (
( ! $sort_by or $sort_by !~ /age|posts/ ) or
( $order and $order !~ /asc|desc/ )
);
}
sub print_usage {
say <<"EOT";
Usage: perl $0 --sort_by (age|posts)
Options:
--sort_by, -s: Rank monks by XP/posts or by XP/age
--limit, -l: Limit results to this many
--order, -o: Sort order (asc|desc)
--recent, -r: Limit to monks seen in the last n wee
+ks
--only_include, -i: Skip all monks except this/these one(
+s)
--force_include, -f: Include this/these monk(s) even if -l
+ is set
--min_posts, -m: Exclude monks with fewer than this ma
+ny posts
--no_adjust, -n: Don't deduct 0.5 XP for each day of m
+onkhood
--help, -h: Print this help
EOT
exit;
}
__END__
edit: reduce XP by only 0.5 per day; switched to Time::Piece as DateTime::Format::Strptime has compile problems on Strawberry Perl; switched to format_number() because round() does not provide trailing zeroes; increase XP/Age by two more orders of magnitude, for scale
The way forward always starts with a minimal test.
