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
[download]

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 |
+---------------------------------------------------------------------
+-----------------+
[download]

$ 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 |
+---------------------------------------------------------------------
+-----------------+
[download]

$ 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 |
+---------------------------------------------------------------------
+-----------------+
[download]

$ 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 |
+---------------------------------------------------------------------
+-----------------+
[download]

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__
[download]

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